In trying to figure out some Raw Input API stuff to read the keyboard, I found a PowerBASIC thread which has API declarations that I want to try porting to QB64PE.
This includes some strange stuff - "AS ANY" and "UNION":
I did some googling to understand UNION and AS ANY and how those might be translated into QB64PE:
Those are all VB and VB.NET threads and they get pretty deep into it... In the "as any" thread they analyze what's happening down to the assembly level! My brain hurts!
I just want to know if anyone has any clue how to get the below code working with QB64/PE or could recommend the right syntax to declare a type with a union and what to do about "as any" ? Much appreciated...
Here's all of it:
This includes some strange stuff - "AS ANY" and "UNION":
Code: (Select All)
BYREF pData AS ANY
...
TYPE RID_DEVICE_INFO_KEYBOARD
dwType AS DWORD
dwSubType AS DWORD
dwKeyboardMode AS DWORD
dwNumberOfFunctionKeys AS DWORD
dwNumberOfIndicators AS DWORD
dwNumberOfKeysTotal AS DWORD
END TYPE
UNION RID_DEVICE_INFO_UNION
'mouse AS RID_DEVICE_INFO_MOUSE
keyboard AS RID_DEVICE_INFO_KEYBOARD
'hid AS RID_DEVICE_INFO_HID
END UNION
TYPE RID_DEVICE_INFO
cbSize AS DWORD
dwType AS DWORD
RID_DEVICE_INFO_UNION
END TYPEI did some googling to understand UNION and AS ANY and how those might be translated into QB64PE:
- VB6's Equivelant "As Any" in VB.Net?-VBForums
- VB6 - can we use the 'Any' type?
- Thread: Unions in VB?? Like in C?
- VS 2010 [RESOLVED] Structure as union in VB.NET. Is this declaration valid?-VBForums
- How to convert this C style UNION in a UDT to VB ?-VBForums
- How to: Create a C/C++ Union by Using Attributes (Visual Basic) (09/15/2021)
- [RESOLVED] C Structures, Unions and Pointers in VB6 (Jan 23rd, 2008, 08:12 AM)
- Thread: can we have data types for C structs and union in VB (Jun 28th, 2004, 03:56 AM)
- VB.Net Union Type (3-Feb-06 12:30)
- Union Types · Sorbet
Those are all VB and VB.NET threads and they get pretty deep into it... In the "as any" thread they analyze what's happening down to the assembly level! My brain hurts!
I just want to know if anyone has any clue how to get the below code working with QB64/PE or could recommend the right syntax to declare a type with a union and what to do about "as any" ? Much appreciated...
Here's all of it:
Code: (Select All)
'Raw Keyboard (HID) Input (discussion) - PowerBASIC Peer Support Community
'https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/55985-raw-keyboard-hid-input-discussion#post673309
'
'#6
'Pierre Bellisle
'23 Mar 2014, 11:04 AM
'Thank for sharing Jeremy.
'
'Here's an adaption...
TYPE RID_DEVICE_INFO_KEYBOARD
dwType AS DWORD
dwSubType AS DWORD
dwKeyboardMode AS DWORD
dwNumberOfFunctionKeys AS DWORD
dwNumberOfIndicators AS DWORD
dwNumberOfKeysTotal AS DWORD
END TYPE
UNION RID_DEVICE_INFO_UNION
'mouse AS RID_DEVICE_INFO_MOUSE
keyboard AS RID_DEVICE_INFO_KEYBOARD
'hid AS RID_DEVICE_INFO_HID
END UNION
TYPE RID_DEVICE_INFO
cbSize AS DWORD
dwType AS DWORD
RID_DEVICE_INFO_UNION
END TYPE
TYPE RAWKEYBOARD
MakeCode AS WORD
Flags AS WORD
Reserved AS WORD
VKey AS WORD
Message AS DWORD
ExtraInformation AS DWORD
END TYPE
UNION RAWINPUTUNION
'mouse AS RAWMOUSE
keyboard AS RAWKEYBOARD
'hid AS RAWHID
END UNION
TYPE RAWINPUTHEADER
dwType AS DWORD
dwSize AS DWORD
hDevice AS DWORD
wParam AS LONG
END TYPE
TYPE RAWINPUT
header AS RAWINPUTHEADER
data AS RAWINPUTUNION
END TYPE
TYPE RAWINPUTDEVICELIST
hDevice AS DWORD
dwType AS DWORD
END TYPE
TYPE RAWINPUTDEVICE
usUsagePage AS WORD
usUsage AS WORD
dwFlags AS DWORD
hwndTarget AS DWORD
END TYPE
%Edit = 101 : %WM_CHAR = &H0102???
%LabelInfo = 201 : %WM_MOUSEMOVE = &H0200???
: %WM_APPCOMMAND = &H0319???
%Hid_Left = 33 : %WM_INPUT = &H00FF???
%Hid_Right = 34 : %KL_NAMELENGTH = 9
%Hid_Bottom = 66 : %WM_KEYUP = &H0101???
: %WM_CHAR = &H0102???
%RIDEV_EXINPUTSINK = &H00001000 : %WM_DEADCHAR = &H0103???
%WM_INITDIALOG = &H0110??? : %WM_SYSKEYDOWN = &H0104???
%NULL = 0 : %WM_SYSKEYUP = &H0105???
: %WM_SYSCHAR = &H0106???
%RIDI_DEVICEINFO = &H2000000B??? : %WM_SYSDEADCHAR = &H0107???
%RIM_TYPEKEYBOARD = 1& : %WM_KEYDOWN = &H0100???
%RIM_TYPEMOUSE = 0& : %WM_KEYUP = &H0101???
%RIM_TYPEHID = 2& : %WM_CHAR = &H0102???
%RID_INPUT = &H10000003??? : %WM_DEADCHAR = &H0103???
%RI_KEY_MAKE = 0?? : %WM_SYSKEYDOWN = &H0104???
%RI_KEY_BREAK = 1?? : %WM_SYSKEYUP = &H0105???
%RI_KEY_E0 = 2?? : %WM_SYSCHAR = &H0106???
%RI_KEY_E1 = 4?? : %WM_SYSDEADCHAR = &H0107???
%RI_KEY_TERMSRV_SET_LED = 8?? : %WM_UNICHAR = &H0109???
%RI_KEY_TERMSRV_SHADOW = &H10?? : %WM_NCACTIVATE = &H0086???
: %WM_COMMAND = &H0111???
%VK_LEFT = &H25& : %WM_SIZE = &H0005???
%VK_UP = &H26& : %WM_DESTROY = &H0002???
%VK_RIGHT = &H27& : %WM_NEXTDLGCTL = &H28
%VK_DOWN = &H28& : %WM_SETICON = &H0080???
%VK_PRIOR = &H21& : %WM_APP = &H08000
%VK_NEXT = &H22& : %WS_CAPTION = &H00C00000&
%VK_END = &H23& : %WS_MINIMIZEBOX = &H00020000&
%VK_HOME = &H24& : %WS_SYSMENU = &H00080000&
%VK_INSERT = &H2D& : %HWND_DESKTOP = 0???
%VK_DELETE = &H2E& : %GCL_HICONSM = -34&
%VK_DIVIDE = &H6F& : %GCL_HICON = -14&
%VK_NUMLOCK = &H90& : %ICON_SMALL = 0&
%VK_SCROLL = &H91& : %ICON_BIG = 1&
%VK_CONTROL = &H11& : %SIZE_MINIMIZED = 1
%KEYEVENTF_KEYUP = &H0002???
%EN_CHANGE = &H0300???
%EN_KILLFOCUS = &H0200???
%EN_SETFOCUS = &H0100???
%EM_GETSEL = &H00B0???
%EM_SETSEL = &H00B1???
'Thank to José Roca
DECLARE FUNCTION RegisterRawInputDevices LIB "USER32.DLL" ALIAS "RegisterRawInputDevices"(BYREF pRawInputDevices AS RAWINPUTDEVICE, BYVAL uiNumDevices AS DWORD, BYVAL cbSize AS DWORD) AS LONG
DECLARE FUNCTION GetRawInputDeviceList LIB "USER32.DLL" ALIAS "GetRawInputDeviceList"(BYREF pRawInputDeviceList AS RAWINPUTDEVICELIST, BYREF puiNumDevices AS DWORD, BYVAL cbSize AS DWORD) AS DWORD
DECLARE FUNCTION GetRawInputDeviceInfo LIB "USER32.DLL" ALIAS "GetRawInputDeviceInfoA"(BYVAL hDevice AS DWORD, BYVAL uiCommand AS DWORD, BYREF pData AS ANY, BYREF pcbSize AS DWORD) AS DWORD
DECLARE FUNCTION SendDlgItemMessage LIB "USER32.DLL" ALIAS "SendDlgItemMessageA"(BYVAL hWnd AS DWORD, BYVAL nIDDlgItem AS LONG, BYVAL Msg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION GetRawInputData LIB "USER32.DLL" ALIAS "GetRawInputData"(BYVAL hRawInput AS DWORD, BYVAL uiCommand AS DWORD, BYREF pData AS ANY, BYREF pcbSize AS DWORD, BYVAL cbSizeHeader AS DWORD) AS DWORD
DECLARE FUNCTION GetKeyNameText LIB "USER32.DLL" ALIAS "GetKeyNameTextA"(BYVAL lParam AS LONG, BYREF lpString AS ASCIIZ, BYVAL cchSize AS DWORD) AS LONG
DECLARE FUNCTION MapVirtualKey LIB "USER32.DLL" ALIAS "MapVirtualKeyA"(BYVAL uCode AS DWORD, BYVAL uMapType AS DWORD) AS DWORD
DECLARE FUNCTION GetFocus LIB "USER32.DLL" ALIAS "GetFocus"() AS DWORD
DECLARE FUNCTION GetDlgItem LIB "USER32.DLL" ALIAS "GetDlgItem"(BYVAL HWND AS DWORD, BYVAL nIDDlgItem AS LONG) AS DWORD
DECLARE FUNCTION SendMessage LIB "USER32.DLL" ALIAS "SendMessageA"(BYVAL hWnd AS DWORD, BYVAL Msg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION DestroyIcon LIB "USER32.DLL" ALIAS "DestroyIcon"(BYVAL hIcon AS DWORD) AS LONG
DECLARE FUNCTION PostMessage LIB "USER32.DLL" ALIAS "PostMessageA"(BYVAL hWnd AS DWORD, BYVAL Msg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION SetClassLong LIB "USER32.DLL" ALIAS "SetClassLongA"(BYVAL hWnd AS DWORD, BYVAL nIndex AS LONG, BYVAL dwNewLong AS DWORD) AS DWORD
DECLARE FUNCTION ExtractIconEx LIB "SHELL32.DLL" ALIAS "ExtractIconExA"(BYREF lpszFile AS ASCIIZ, BYVAL nIconIndex AS LONG, BYREF phiconLarge AS DWORD, BYREF phiconSmall AS DWORD, BYVAL nIcons AS DWORD) AS DWORD
DECLARE FUNCTION SetDlgItemText LIB "USER32.DLL" ALIAS "SetDlgItemTextA"(BYVAL hDlg AS LONG, BYVAL nIDDlgItem AS LONG, lpString AS ASCIIZ) AS LONG
DECLARE SUB Keybd_event LIB "USER32.DLL" ALIAS "keybd_event"(BYVAL bVk AS BYTE, BYVAL bScan AS BYTE, BYVAL dwFlags AS DWORD, BYVAL dwExtraInfo AS DWORD)
GLOBAL hDlg AS DWORD
'______________________________________________________________________________
CALLBACK FUNCTION DlgProc
LOCAL RidDeviceInfo AS RID_DEVICE_INFO
LOCAL pRawInput AS RAWINPUT POINTER
LOCAL zKeyName AS ASCIIZ * 50
STATIC CtrlClass AS ASCIIZ * 50
LOCAL sRawInput AS STRING
LOCAL sBuffer AS STRING
LOCAL ScanCode AS DWORD
STATIC hidDevice AS DWORD
STATIC hFocusBak AS DWORD
LOCAL RawInputDevCount AS LONG
LOCAL KeyboardTypeCount AS LONG
LOCAL RawInputDeviceIndex AS LONG
STATIC hidF9 AS LONG
LOCAL ByteCount AS LONG
STATIC SelStart AS LONG
STATIC SelEnd AS LONG
SELECT CASE CBMSG
CASE %WM_INITDIALOG
GetRawInputDeviceList(BYVAL %NULL, RawInputDevCount, SIZEOF(RAWINPUTDEVICELIST)) 'Get raw input device count
DIM RawInputDevList(0 TO RawInputDevCount - 1) AS RAWINPUTDEVICELIST 'Prepare raw input device array
GetRawInputDeviceList(RawInputDevList(0), RawInputDevCount, SIZEOF(RAWINPUTDEVICELIST)) 'Get raw input device
DIM RawInputDev(RawInputDevCount) AS RAWINPUTDEVICE 'Prepare raw input device array
FOR RawInputDeviceIndex = 0 TO RawInputDevCount - 1
GetRawInputDeviceInfo(RawInputDevList(RawInputDeviceIndex).hDevice, %RIDI_DEVICEINFO, RidDeviceInfo, SIZEOF(RID_DEVICE_INFO)) 'Get raw input device info
SELECT CASE RidDeviceInfo.dwtype 'Get raw input device type
CASE %RIM_TYPEKEYBOARD 'Keyboard type
RawInputDev(KeyboardTypeCount).usUsagePage = 1
RawInputDev(KeyboardTypeCount).usUsage = 6
RawInputDev(KeyboardTypeCount).dwFlags = %RIDEV_EXINPUTSINK 'Vista+, receive input in the background
RawInputDev(KeyboardTypeCount).hwndTarget = hDlg
INCR KeyboardTypeCount 'Count of raw keyboard input device
CASE %RIM_TYPEMOUSE 'Mouse raw input device
CASE %RIM_TYPEHID 'Other raw input device, game controllers, joysticks, etc.
END SELECT
NEXT
RegisterRawInputDevices(RawInputDev(0), KeyboardTypeCount, SIZEOF(RAWINPUTDEVICE)) 'Register raw input device(s)
PostMessage(hDlg, %WM_APP, 0, 0)
CASE %WM_INPUT 'Sent to the window that is getting raw input
GetRawInputData(CBLPARAM, %RID_INPUT, BYVAL %NULL, ByteCount, SIZEOF(RAWINPUTHEADER)) 'Get size of raw input buffer
sRawInput = NUL$(ByteCount) 'Set string for hid input
GetRawInputData(CBLPARAM, %RID_INPUT, BYVAL STRPTR(sRawInput), ByteCount, SIZEOF(RAWINPUTHEADER))'Get hid input
pRawInput = STRPTR(sRawInput) 'Set RawInput pointer
sBuffer = "RawInput.Header.hDevice = " & HEX$(@pRawInput.header.hDevice, 8) & $CRLF 'Show handle
sBuffer = sBuffer & "RawInput.Header.dwType = " & CHOOSE$(@pRawInput.header.dwType + 1, _
"RIM_TYPEMOUSE", "RIM_TYPEKEYBOARD", "RIM_TYPEHID") & $CRLF 'Show type
sBuffer = sBuffer & $CRLF
sBuffer = sBuffer & "RawInput.data.Keyboard.vKey =" & STR$(@pRawInput.data.Keyboard.vKey) & _ '
", Character is " & $DQ & CHR$(@pRawInput.data.Keyboard.vKey) & $DQ & $CRLF & $CRLF 'Show char
ScanCode = MapVirtualKey(@pRawInput.data.Keyboard.vKey, 0) 'Create a scan code from vKey to get GetKeyNameText
SELECT CASE @pRawInput.data.Keyboard.vKey
CASE %VK_LEFT, %VK_UP, %VK_RIGHT, %VK_DOWN, %VK_PRIOR, %VK_NEXT, _
%VK_END, %VK_HOME, %VK_INSERT, %VK_DELETE, %VK_DIVIDE, %VK_NUMLOCK
ScanCode = ScanCode OR &H100 'Set extended bit
END SELECT
SHIFT LEFT ScanCode, 16 'Shift left
GetKeyNameText(ScanCode, BYVAL VARPTR(zKeyName), SIZEOF(zKeyName)) 'Get key name like "Tab" or "Esc"
sBuffer = sBuffer & "KeyName " & $DQ & zKeyName & $DQ & $CRLF
sBuffer = sBuffer & $CRLF
sBuffer = sBuffer & "RawInput.data.Keyboard.Message =" & HEX$(@pRawInput.data.Keyboard.Message, 8) 'Show message
SELECT CASE @pRawInput.data.Keyboard.Message
CASE %WM_KEYDOWN : sBuffer = sBuffer & " WM_KEYDOWN" & $CRLF
CASE %WM_KEYUP : sBuffer = sBuffer & " WM_KEYUP" & $CRLF
CASE %WM_SYSKEYDOWN : sBuffer = sBuffer & " WM_SYSKEYDOWN" & $CRLF
CASE %WM_SYSKEYDOWN : sBuffer = sBuffer & " WM_SYSKEYDOWN" & $CRLF
END SELECT
sBuffer = sBuffer & $CRLF
sBuffer = sBuffer & "RawInput.Keyboard.MakeCode = " & HEX$(@pRawInput.data.Keyboard.MakeCode, 8) & $CRLF 'Show make code
sBuffer = sBuffer & "RawInput.data.Keyboard.ExtraInformation = " & _
HEX$(@pRawInput.data.Keyboard.ExtraInformation, 8) & $CRLF 'Show extra info
IF (@pRawInput.data.Keyboard.Flags AND %RI_KEY_BREAK) THEN 'Show flags
sBuffer = sBuffer & "Flag RI_KEY_BREAK" & $CRLF
ELSE
sBuffer = sBuffer & "Flag RI_KEY_MAKE" & $CRLF
END IF
IF (@pRawInput.data.Keyboard.Flags AND %RI_KEY_E0) THEN
sBuffer = sBuffer & "Flag RI_KEY_E0" & $CRLF
END IF
IF (@pRawInput.data.Keyboard.Flags AND %RI_KEY_E1) THEN
sBuffer = sBuffer & "Flag RI_KEY_E1" & $CRLF
END IF
IF (@pRawInput.data.Keyboard.Flags AND %RI_KEY_TERMSRV_SET_LED) THEN
sBuffer = sBuffer & "Flag RI_KEY_TERMSRV_SET_LED" & $CRLF
END IF
IF (@pRawInput.data.Keyboard.Flags AND %RI_KEY_TERMSRV_SHADOW) THEN
sBuffer = sBuffer & "Flag RI_KEY_TERMSRV_SHADOW" & $CRLF
END IF
SetDlgItemText(hDlg, %LabelInfo, BYVAL STRPTR(sBuffer))
CASE %WM_CHAR
CASE %WM_MOUSEMOVE
CASE %WM_APPCOMMAND
CASE %WM_APP
SendDlgItemMessage(hDlg, %Edit, %EM_SETSEL, -2, -2) 'Move caret at the end
Keybd_event(%VK_CONTROL, 0, 0, 0) 'Simulate Control key
Keybd_event(%VK_CONTROL, 0, %KEYEVENTF_KEYUP, 0) 'Simulate Control key
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %Edit
IF HIWRD(CBWPARAM) = %EN_CHANGE THEN
END IF
IF (CBCTLMSG = %EN_KILLFOCUS) THEN
SendMessage(CBLPARAM, %EM_GETSEL, VARPTR(SelStart), VARPTR(SelEnd))
END IF
IF (CBCTLMSG = %EN_SETFOCUS) THEN
SendMessage(CBLPARAM, %EM_SETSEL, SelStart, SelEnd)
END IF
END SELECT
CASE %WM_NCACTIVATE
IF CBWPARAM = 0 THEN 'Application loose focus
hFocusBak = GetFocus()
ELSEIF hFocusBak THEN
SendMessage(hDlg, %WM_NEXTDLGCTL, hFocusBak, 1)
hFocusBak = 0
END IF
END SELECT
END FUNCTION
'______________________________________________________________________________
FUNCTION PBMAIN()
LOCAL hIconBig AS DWORD
LOCAL hIconSmall AS DWORD
DIALOG FONT "Segoe UI", 9
DIALOG NEW %HWND_DESKTOP, "GetRawInputDevice / GetRawInputData", , , 230, 150, _
%WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU, 0 TO hDlg
ExtractIconEx("msctf.dll", 15, BYVAL VARPTR(hIconBig), BYVAL VARPTR(hIconSmall), 1)
SetClassLong(hDlg, %GCL_HICONSM, hIconSmall)
SetClassLong(hDlg, %GCL_HICON, hIconBig)
SendMessage(hDlg, %WM_SETICON, %ICON_SMALL, hIconSmall)
SendMessage(hDlg, %WM_SETICON, %ICON_BIG, hIconBig)
CONTROL ADD TEXTBOX, hDlg, %Edit, "Type also in another app...", 5, 5, 220, 12
CONTROL ADD LABEL, hDlg, %LabelInfo, "GetRawInputDevice / GetRawInputData", 5, 20, 220, 125
DIALOG SHOW MODAL hDlg CALL DlgProc
DestroyIcon(hIconSmall)
DestroyIcon(hIconBig)
END FUNCTION