Public feed #381788

Someone

public text v1 · immutable
Raw Edit
·published 2007-03-05 02:12 UTC
rendered paste body
#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