#COMPILE EXE #DIM ALL %USEMACROS = 1 #INCLUDE "WIN32API.INC" #RESOURCE "dialog2.pbr" %ID_XPOSLABEL = 1001 %ID_YPOSLABEL = 1002 %ID_UPBTN = 1003 %ID_DOWNBTN = 1004 %ID_LEFTBTN = 1005 %ID_RIGHTBTN = 1006 %ID_CHARACTER = 1007 %ID_BACKGROUND = 1008 %ID_INST_LABEL = 1009 GLOBAL hDlg AS DWORD GLOBAL StopKBHook AS LONG GLOBAL hBmp AS LONG GLOBAL ypos AS INTEGER GLOBAL xpos AS INTEGER GLOBAL xposString AS STRING GLOBAL yposString AS STRING GLOBAL KeyStroke AS STRING GLOBAL xpos_ulc AS INTEGER GLOBAL xpos_lrc AS INTEGER GLOBAL ypos_ulc AS INTEGER GLOBAL ypos_lrc AS INTEGER DECLARE CALLBACK FUNCTION DialogProc() FUNCTION PBMAIN () AS LONG yposString = STR$(ypos) xposString = STR$(xpos) GRAPHIC WINDOW "X&Y",100,100,800, 600 TO hDlg GRAPHIC ATTACH hDlg, 0 GRAPHIC BITMAP LOAD "BACKGROUND", 800, 600 TO hBmp GRAPHIC BITMAP LOAD "CHARACTER", 16, 16 TO hBmp GRAPHIC RENDER "BACKGROUND", (0,0)-(800,600) CALL KBHook GRAPHIC SET POS (200,400) GRAPHIC PRINT xposString ; " x "; yposString;" y " GRAPHIC SET POS (200,420) GRAPHIC PRINT KeyStroke GRAPHIC REDRAW xpos_ulc = xpos - 5 ypos_ulc = ypos - 5 xpos_lrc = xpos + 5 ypos_lrc = ypos + 5 GRAPHIC RENDER "CHARACTER", (xpos_ulc,ypos_ulc)-(xpos_lrc,ypos_lrc) END FUNCTION SUB KBHook LOCAL InterceptKey AS LONG LOCAL KeyCode AS LONG LOCAL KeyStroke AS STRING LOCAL LastKey AS STRING LOCAL Msg AS TAGMSG WHILE GetMessage(Msg, %NULL, 0, 0) = TRUE KeyStroke = "" SELECT CASE Msg.message CASE %WM_KEYDOWN, %WM_SYSKEYDOWN IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN KeyCode = Msg.wParam IF KeyCode <> 16 THEN KeyStroke = "SHIFT " GOSUB WhichKey IF LEN(LastKey) > 1 THEN KeyStroke = KeyStroke + LastKey ELSE KeyStroke = LastKey END IF END IF ELSEIF ISTRUE(LOWRD(GetKeyState(%VK_CONTROL)) AND &H8000) THEN KeyCode = Msg.wParam IF KeyCode <> 17 THEN GOSUB WhichKey IF LEN(LastKey) THEN KeyStroke = "CTRL " + LastKey END IF END IF ELSEIF ISTRUE(LOWRD(GetKeyState(%VK_MENU)) AND &H8000) THEN KeyCode = Msg.wParam GOSUB WhichKey IF LEN(LastKey) THEN KeyStroke = "ALT " + LastKey END IF ELSE KeyCode = Msg.wParam GOSUB WhichKey IF LEN(LastKey) THEN KeyStroke = LastKey END IF END IF END SELECT IF KeyStroke <> "" THEN ' This is where you can select which keystrokes to intercept ' and act on, and which keystrokes to pass through to Windows ' CONTROL SET TEXT hDlg, 100, KeyStroke ' ' Optionally pass keystroke through with following code ' ' IF IsDialogMessage(hDlg, Msg) = %FALSE THEN ' TranslateMessage Msg ' DispatchMessage Msg ' END IF ELSEIF IsDialogMessage(hDlg, Msg) = %FALSE THEN TranslateMessage Msg DispatchMessage Msg END IF IF StopKBHook THEN EXIT SUB END IF LOOP WhichKey: ' GOSUB routine used above SELECT CASE KeyCode CASE %VK_LEFT LastKey = "LEFT ARROW" CASE %VK_RIGHT LastKey = "RIGHT ARROW" CASE %VK_DOWN LastKey = "DOWN ARROW" CASE %VK_UP LastKey = "UP ARROW" CASE %VK_HOME LastKey = "HOME" CASE %VK_END LastKey = "END" CASE %VK_INSERT LastKey = "INSERT" CASE %VK_DELETE LastKey = "DELETE" CASE %VK_PGUP LastKey = "PGUP" CASE %VK_PGDN LastKey = "PGDN" CASE %VK_TAB LastKey = "TAB" CASE %VK_RETURN LastKey = "RETURN" CASE %VK_BACK LastKey = "BACKSPACE" CASE %VK_ESCAPE LastKey = "ESCAPE" CASE %VK_F1 LastKey = "F1" CASE %VK_F2 LastKey = "F2" CASE %VK_F3 LastKey = "F3" CASE %VK_F4 LastKey = "F4" CASE %VK_F5 LastKey = "F5" CASE %VK_F6 LastKey = "F6" CASE %VK_F7 LastKey = "F7" CASE %VK_F8 LastKey = "F8" CASE %VK_F9 LastKey = "F9" CASE %VK_F10 LastKey = "F10" CASE %VK_F11 LastKey = "F11" CASE %VK_F12 LastKey = "F12" CASE %VK_PRINT LastKey = "PRINT SCREEN" CASE %VK_SCROLL LastKey = "SCROLL LOCK" CASE %VK_PAUSE LastKey = "PAUSE BREAK" CASE 63, 111 ' ? or o produced by numeric keypad LastKey = CHR$(47) ' / CASE 58, 106 ' : or j produced by numeric keypad LastKey = CHR$(42) ' * CASE 61, 109 ' = or m produced by numeric keypad LastKey = CHR$(45) ' - CASE 59, 107 ' ; or k produced by numeric keypad LastKey = CHR$(43) ' + CASE 110 ' n produced by numeric keypad LastKey = CHR$(46) ' . CASE 96 TO 105 ' produced by numeric keypad IF GetKeyState(%VK_NUMLOCK) THEN KeyCode = KeyCode - 48 ' 0 through 9 END IF LastKey = CHR$(KeyCode) CASE 32 LastKey = "SPACE" CASE 48 TO 57 ' 0 through 9 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN SELECT CASE KeyCode CASE 48 LastKey = CHR$(41) ' ) CASE 49 LastKey = CHR$(33) ' ! CASE 50 LastKey = CHR$(64) ' @ CASE 51 LastKey = CHR$(35) ' # CASE 52 LastKey = CHR$(36) ' $ CASE 53 LastKey = CHR$(37) ' % CASE 54 LastKey = CHR$(94) ' ^ CASE 55 LastKey = CHR$(38) ' & CASE 56 LastKey = CHR$(42) ' * CASE 57 LastKey = CHR$(40) ' ( END SELECT ELSE LastKey = CHR$(KeyCode) END IF CASE 65 TO 90 ' A through Z IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) OR GetKeyState(%VK_CAPITAL) THEN KeyStroke = "" ELSE ' a through z KeyCode = KeyCode + 32 END IF LastKey = CHR$(KeyCode) CASE 186 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN LastKey = CHR$(58) ' : ELSE LastKey = CHR$(59) ' ; END IF CASE 187 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN LastKey = CHR$(43) ' + ELSE LastKey = CHR$(61) ' = END IF CASE 188 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN LastKey = CHR$(60) ' < ELSE LastKey = CHR$(44) ' . END IF CASE 189 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN LastKey = CHR$(95) ' _ ELSE LastKey = CHR$(45) ' - END IF CASE 190 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN LastKey = CHR$(62) ' > ELSE LastKey = CHR$(46) ' , END IF CASE 191 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN LastKey = CHR$(63) ' ? ELSE LastKey = CHR$(47) ' / END IF CASE 192 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN LastKey = CHR$(126) ' ~ ELSE LastKey = CHR$(96) ' ` END IF CASE 219 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN LastKey = CHR$(123) ' { ELSE LastKey = CHR$(91) ' [ END IF CASE 220 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN LastKey = CHR$(124) ' | ELSE LastKey = CHR$(92) ' \ END IF CASE 221 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN LastKey = CHR$(125) ' } ELSE LastKey = CHR$(93) ' ] END IF CASE 222 IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN LastKey = CHR$(34) ' " ELSE LastKey = CHR$(39) ' ' END IF CASE 20, 144, 12 ' CapsLock, NumLock and the "5" on keypad w/numlock off ' Ignore these LastKey = "" CASE 91, 92, 93 ' Windows and Windows Menu keys ' Ignore these LastKey = "" CASE ELSE ' Unknown LastKey = "" END SELECT RETURN END SUB CALLBACK FUNCTION DialogProc() SELECT CASE CBMSG CASE %WM_DESTROY StopKBHook = %TRUE PostQuitMessage 0 FUNCTION = 0 END SELECT END FUNCTION