'be advised that this program runs invisibly in the background.
' hotkey code is public domain, by Michael Calkins. http://www.qb64.net/forum/index.php?topic=9979.0
' png export code is by SMcNeill. http://www.qb64.net/forum/index.php?topic=9999.0
$SCREENHIDE
CONST MOD_SHIFT = 4
' these next two constants determine the hotkey.
' the current example is Shift+A
CONST fsModifiers = MOD_SHIFT ' http://msdn.microsoft.com/en-us/library/ms646309(v=vs.85).aspx
CONST vk = &H41 ' http://msdn.microsoft.com/en-us/library/dd375731(v=vs.85).aspx
CONST mode = 0
'mode 0 makes the thread wait for the hotkey. It will not respond to requests
'to terminate, until it gets a hotkey message. Otherwise, Windows will
'consider it to be not responding.
'mode 1 causes the thread to wake up at 1 second intervals. This makes it
'use some CPU time, but it won't appear to be not responding.
'As $SCREENHIDE is used, you won't have an X to click, so you would probably
'use task manager or process explorer to kill it either way. However, mode
'might make a difference in how much it delays your log off/shutdown time.
CONST WM_HOTKEY = &H0312
CONST PM_REMOVE = 1
CONST WAIT_FAILED = -1
CONST QS_ALLEVENTS = &H04BF
CONST ERROR_ALREADY_EXISTS = &HB7
DECLARE DYNAMIC LIBRARY "kernel32"
FUNCTION GetLastError~& ()
FUNCTION CreateMutexA~%& (BYVAL lpMutexAttributes~%&, BYVAL bInitialOwner&, BYVAL lpName~%&)
END DECLARE
DECLARE DYNAMIC LIBRARY "user32"
FUNCTION RegisterHotKey& (BYVAL hWnd~%&, BYVAL id&, BYVAL fsModifiers~&, BYVAL vk~&)
FUNCTION UnregisterHotKey& (BYVAL hWnd~%&, BYVAL id&)
FUNCTION GetMessageW& (BYVAL lpMsg~%&, BYVAL hWnd~%&, BYVAL wMsgFilterMin~&, BYVAL wMsgFilterMax~&)
FUNCTION PeekMessageW& (BYVAL lpMsg~%&, BYVAL hWnd~%&, BYVAL wMsgFilterMin~&, BYVAL wMsgFilterMax~&, BYVAL wRemoveMsg~&)
FUNCTION MsgWaitForMultipleObjects~& (BYVAL nCount~&, BYVAL pHandles~%&, BYVAL bWaitAll&, BYVAL dwMilliseconds~&, BYVAL dwWakeMask~&)
END DECLARE
TYPE POINT
x AS LONG
y AS LONG
END TYPE
TYPE MSG
hwnd AS _UNSIGNED _OFFSET
message AS _UNSIGNED LONG
wParam AS _UNSIGNED _OFFSET
lParam AS _OFFSET
time AS _UNSIGNED LONG
pt AS POINT
END TYPE
'$Include:'Zlib.BI'
DIM h AS LONG
DIM bRet AS LONG
DIM msg AS MSG
DIM t AS STRING
t = "Global\qb64 hotkey demo" + CHR$(0)
IF 0 = CreateMutexA(0, 0, _OFFSET(t)) THEN showerr "CreateMutexA"
IF ERROR_ALREADY_EXISTS = GetLastError THEN showerr "(Multiple instances?) "
IF 0 = RegisterHotKey(0, 0, fsModifiers, vk) THEN showerr "RegisterHotKey"
IF mode THEN
DO
bRet = GetMessageW(_OFFSET(msg), 0, 0, 0)
SELECT CASE bRet
CASE 0: EXIT DO
CASE -1: showerr "GetMessageW"
CASE ELSE: GOSUB gotamessage
END SELECT
LOOP
ELSE
DO
'use MsgWaitForMultipleObjects instead of _LIMIT
IF WAIT_FAILED = MsgWaitForMultipleObjects(0, 0, 0, 1000, QS_ALLEVENTS) THEN showerr "MsgWaitForMultipleObjects"
IF PeekMessageW(_OFFSET(msg), 0, 0, 0, PM_REMOVE) THEN GOSUB gotamessage
LOOP
END IF
IF 0 = UnregisterHotKey(0, 0) THEN showerr "UnRegisterHotKey"
SYSTEM
gotamessage:
IF WM_HOTKEY = (&HFFFF~& AND msg.message) THEN
h = _SCREENIMAGE
SCREEN h
IF 0 >= PNGExport("delme " + timestamp + ".png", 0) THEN pngerr
SCREEN 0
_FREEIMAGE h
END IF
RETURN
SUB showerr (f AS STRING)
_SCREENSHOW
PRINT f; " failed. Error: 0x" + LCASE$(HEX$(GetLastError))
END
END SUB
SUB pngerr
SCREEN 0
_SCREENSHOW
PRINT "Export failed.": END
END
END SUB
FUNCTION timestamp$
DIM d AS STRING * 10
DIM t AS STRING * 8
DO
d = DATE$
t = TIME$
LOOP WHILE d <> DATE$ ' try to prevent the situation where midnight is crossed between getting the date$ and time$
MID$(t, 3, 1) = " "
MID$(t, 6, 1) = " "
MID$(d, 3, 1) = " "
timestamp = RIGHT$(d, 4) + " " + LEFT$(d, 5) + "--" + t
END FUNCTION
'$Include:'PngExport.BM'
Regards,
Michael
Edit: changed END to SYSTEM in one place.
changed check for PNGExport error.