Posts: 705
Threads: 99
Joined: Apr 2022
Reputation:
13
06-05-2024, 09:35 PM
(This post was last modified: 06-05-2024, 11:03 PM by madscijr.)
(06-01-2024, 01:18 AM)DSMan195276 Wrote: I don't have tons of time at the moment, but to address a couple of the things you mentioned:
You're correct about the `_OFFSET` type. The member you identified (`hDevice`) is a `HANDLE` type which is the same size as a pointer.
Yes `ASCIIZ * 50` would be a 50 byte string, you'll need to check if the 50 includes the NUL byte at the end or not (if it does, then you can use `STRING * 50` for it, if the NUL byte is extra then it's a `STRING * 51`).
The ` bRawData[1]` thing is hard to explain, but basically it's a C concept where the size of the TYPE/struct is not really defined, instead there's an array of unknown length at the end of it. If you read the specs, it says that the size of the `bRawData` array is `dwSizeHid * dwCount`. I assume you then split the `bRawData` bytes up into `dwSizeHid`-sized chunks and each is a HID report or something.
Also, something to keep in mind is the C padding rules. Each type has a required alignment and the C compiler will insert empty space between the members of the struct to make sure each member hits its required alignment. QB64 does not do this, so you have to manually insert extra members for the padding. The majority of those structures are designed such that they don't need any padding, but maybe not all of them. Just trying to get these definitions right has been making my head spin...
If you get a second, does this look remotely like I'm on the right track?
(Above each TYPE defintion, I included the C definition as it appears on Microsoft's site.)
Code: (Select All) ' QB64PE C Libraries
' https://qb64phoenix.com/qb64wiki/index.php/C_Libraries
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RID_DEVICE_INFO_MOUSE structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_mouse
'typedef struct tagRID_DEVICE_INFO_MOUSE {
' DWORD dwId;
' DWORD dwNumberOfButtons;
' DWORD dwSampleRate;
' BOOL fHasHorizontalWheel;
'} RID_DEVICE_INFO_MOUSE, *PRID_DEVICE_INFO_MOUSE;
TYPE RID_DEVICE_INFO_MOUSE
dwId AS _UNSIGNED LONG
dwNumberOfButtons AS _UNSIGNED LONG
dwSampleRate AS _UNSIGNED LONG
fHasHorizontalWheel AS INTEGER
END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RID_DEVICE_INFO_KEYBOARD structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_keyboard
'typedef struct tagRID_DEVICE_INFO_KEYBOARD {
' DWORD dwType;
' DWORD dwSubType;
' DWORD dwKeyboardMode;
' DWORD dwNumberOfFunctionKeys;
' DWORD dwNumberOfIndicators;
' DWORD dwNumberOfKeysTotal;
'} RID_DEVICE_INFO_KEYBOARD, *PRID_DEVICE_INFO_KEYBOARD;
TYPE RID_DEVICE_INFO_KEYBOARD
dwType AS _UNSIGNED LONG ' DWORD
dwSubType AS _UNSIGNED LONG ' DWORD
dwKeyboardMode AS _UNSIGNED LONG ' DWORD
dwNumberOfFunctionKeys AS _UNSIGNED LONG ' DWORD
dwNumberOfIndicators AS _UNSIGNED LONG ' DWORD
dwNumberOfKeysTotal AS _UNSIGNED LONG ' DWORD
END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RID_DEVICE_INFO_HID structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_hid
'typedef struct tagRID_DEVICE_INFO_HID {
' DWORD dwVendorId;
' DWORD dwProductId;
' DWORD dwVersionNumber;
' USHORT usUsagePage;
' USHORT usUsage;
'} RID_DEVICE_INFO_HID, *PRID_DEVICE_INFO_HID;
TYPE RID_DEVICE_INFO_HID
dwVendorId AS _UNSIGNED LONG ' DWORD
dwProductId AS _UNSIGNED LONG ' DWORD
dwVersionNumber AS _UNSIGNED LONG ' DWORD
usUsagePage AS _UNSIGNED INTEGER ' USHORT
usUsage AS _UNSIGNED INTEGER ' USHORT
END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RID_DEVICE_INFO structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info
'typedef struct tagRID_DEVICE_INFO {
' DWORD cbSize;
' DWORD dwType;
' union {
' RID_DEVICE_INFO_MOUSE mouse;
' RID_DEVICE_INFO_KEYBOARD keyboard;
' RID_DEVICE_INFO_HID hid;
' } DUMMYUNIONNAME1;
'} RID_DEVICE_INFO, *PRID_DEVICE_INFO, *LPRID_DEVICE_INFO;
TYPE DUMMYUNIONNAME1
My_RID_DEVICE_INFO_MOUSE AS _OFFSET ' pointer to VAR A1
My_RID_DEVICE_INFO_KEYBOARD AS _OFFSET ' pointer to VAR A2
My_RID_DEVICE_INFO_HID AS _OFFSET ' pointer to VAR A3
END TYPE
TYPE RID_DEVICE_INFO
cbSize AS _UNSIGNED LONG ' DWORD
dwType AS _UNSIGNED LONG ' DWORD
My_DUMMYUNIONNAME1 AS _OFFSET ' pointer to DUMMYUNIONNAME1
END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWKEYBOARD structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawkeyboard
'typedef struct tagRAWKEYBOARD {
' USHORT MakeCode;
' USHORT Flags;
' USHORT Reserved;
' USHORT VKey;
' UINT Message;
' ULONG ExtraInformation;
'} RAWKEYBOARD, *PRAWKEYBOARD, *LPRAWKEYBOARD;
TYPE RAWKEYBOARD
MakeCode AS _UNSIGNED INTEGER ' USHORT
Flags AS _UNSIGNED INTEGER ' USHORT
Reserved AS _UNSIGNED INTEGER ' USHORT
VKey AS _UNSIGNED INTEGER ' USHORT
Message AS _UNSIGNED LONG ' UINT
ExtraInformation AS _UNSIGNED _OFFSET ' ULONG
END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWMOUSE structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawmouse
'typedef struct tagRAWMOUSE {
' USHORT usFlags;
' union {
' ULONG ulButtons;
' struct {
' USHORT usButtonFlags;
' USHORT usButtonData;
' } DUMMYSTRUCTNAME;
' } DUMMYUNIONNAME2;
' ULONG ulRawButtons;
' LONG lLastX;
' LONG lLastY;
' ULONG ulExtraInformation;
'} RAWMOUSE, *PRAWMOUSE, *LPRAWMOUSE;
TYPE DUMMYSTRUCTNAME
usButtonFlags AS _UNSIGNED INTEGER ' USHORT
usButtonData AS _UNSIGNED INTEGER ' USHORT
END TYPE
TYPE DUMMYUNIONNAME2
ulButtons AS _UNSIGNED _OFFSET ' ULONG
My_DUMMYSTRUCTNAME AS _OFFSET ' pointer to DUMMYSTRUCTNAME
END TYPE
TYPE RAWMOUSE
usFlags AS _UNSIGNED INTEGER ' USHORT
My_DUMMYUNIONNAME2 AS _OFFSET ' pointer to DUMMYUNIONNAME2
ulRawButtons AS _UNSIGNED _OFFSET ' ULONG
lLastX AS LONG
lLastY AS LONG
ulExtraInformation AS _UNSIGNED _OFFSET ' ULONG
END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWHID structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawhid
'typedef struct tagRAWHID {
' DWORD dwSizeHid;
' DWORD dwCount;
' BYTE bRawData[1];
'} RAWHID, *PRAWHID, *LPRAWHID;
TYPE RAWHID
dwSizeHid AS _UNSIGNED LONG ' DWORD
dwCount AS _UNSIGNED LONG ' DWORD
bRawData AS _UNSIGNED _BYTE ' bRawData[1] AS BYTE
END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWINPUTHEADER structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputheader
'typedef struct tagRAWINPUTHEADER {
' DWORD dwType;
' DWORD dwSize;
' HANDLE hDevice;
' WPARAM wParam;
'} RAWINPUTHEADER, *PRAWINPUTHEADER, *LPRAWINPUTHEADER;
TYPE RAWINPUTHEADER
dwType AS _UNSIGNED LONG ' DWORD
dwSize AS _UNSIGNED LONG ' DWORD
hDevice AS _UNSIGNED LONG ' DWORD <- should this be _OFFSET ?
wParam AS LONG
END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWINPUT structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinput
'typedef struct tagRAWINPUT {
' RAWINPUTHEADER header;
' union {
' RAWMOUSE mouse;
' RAWKEYBOARD keyboard;
' RAWHID hid;
' } data;
'} RAWINPUT, *PRAWINPUT, *LPRAWINPUT;
TYPE RAWINPUTUNION
mouse AS _OFFSET ' pointer to RAWMOUSE variable
keyboard AS _OFFSET ' pointer to RAWKEYBOARD variable
hid AS _OFFSET ' pointer to RAWHID
END UNION
TYPE RAWINPUT
header AS RAWINPUTHEADER
data AS _OFFSET
END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWINPUTDEVICELIST structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevicelist
'typedef struct tagRAWINPUTDEVICELIST {
' HANDLE hDevice;
' DWORD dwType;
'} RAWINPUTDEVICELIST, *PRAWINPUTDEVICELIST;
TYPE RAWINPUTDEVICELIST
hDevice AS _UNSIGNED LONG ' DWORD <- should this be _OFFSET ?
dwType AS _UNSIGNED LONG ' DWORD
END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWINPUTDEVICE structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevice
'typedef struct tagRAWINPUTDEVICE {
' USHORT usUsagePage;
' USHORT usUsage;
' DWORD dwFlags;
' HWND hwndTarget;
'} RAWINPUTDEVICE, *PRAWINPUTDEVICE, *LPRAWINPUTDEVICE;
TYPE RAWINPUTDEVICE
usUsagePage AS _UNSIGNED INTEGER ' WORD
usUsage AS _UNSIGNED INTEGER ' WORD
dwFlags AS _UNSIGNED LONG ' DWORD
hwndTarget AS _OFFSET ' DWORD
END TYPE
' ================================================================================================================================================================
' BEGIN CONSTANTS
' ================================================================================================================================================================
CONST COLOR_WINDOW = 5
CONST CS_HREDRAW = &H0002
CONST CS_VREDRAW = &H0001
CONST CW_USEDEFAULT = &H80000000
CONST DT_CENTER = &H00000001
CONST Edit = 101
CONST EM_GETSEL = &H00B0
CONST EM_SETSEL = &H00B1
CONST EN_CHANGE = &H0300
CONST EN_KILLFOCUS = &H0200
CONST EN_SETFOCUS = &H0100
CONST GCL_HICON = -14
CONST GCL_HICONSM = -34
CONST Hid_Bottom = 66
CONST Hid_Left = 33
CONST Hid_Right = 34
CONST HWND_DESKTOP = 0
CONST ICON_BIG = 1
CONST ICON_SMALL = 0
CONST IDC_ARROW = 32512
CONST IDI_APPLICATION = 32512
CONST KEYEVENTF_KEYUP = &H0002
CONST KL_NAMELENGTH = 9
CONST LabelInfo = 201
CONST MOUSE_ATTRIBUTES_CHANGED = &H04
CONST MOUSE_MOVE_ABSOLUTE = &H01
CONST MOUSE_MOVE_NOCOALESCE = &H08
CONST MOUSE_MOVE_RELATIVE = &H00
CONST MOUSE_VIRTUAL_DESKTOP = &H02
CONST NULL = 0
CONST RI_KEY_BREAK = 1
CONST RI_KEY_E0 = 2
CONST RI_KEY_E1 = 4
CONST RI_KEY_MAKE = 0
CONST RI_KEY_TERMSRV_SET_LED = 8
CONST RI_KEY_TERMSRV_SHADOW = &H10
CONST RID_INPUT = &H10000003
CONST RIDEV_EXINPUTSINK = &H00001000
CONST RIDI_DEVICEINFO = &H2000000B
CONST RIM_TYPEHID = 2
CONST RIM_TYPEKEYBOARD = 1
CONST RIM_TYPEMOUSE = 0
CONST SIZE_MINIMIZED = 1
CONST SW_SHOW = 5
CONST VK_CONTROL = &H11
CONST VK_DELETE = &H2E
CONST VK_DIVIDE = &H6F
CONST VK_DOWN = &H28
CONST VK_END = &H23
CONST VK_HOME = &H24
CONST VK_INSERT = &H2D
CONST VK_LEFT = &H25
CONST VK_NEXT = &H22
CONST VK_NUMLOCK = &H90
CONST VK_PRIOR = &H21
CONST VK_RIGHT = &H27
CONST VK_SCROLL = &H91
CONST VK_UP = &H26
CONST WM_APP = &H08000
CONST WM_APPCOMMAND = &H0319
CONST WM_CHAR = &H0102
CONST WM_CHAR = &H0102
CONST WM_CHAR = &H0102
CONST WM_COMMAND = &H0111
CONST WM_DEADCHAR = &H0103
CONST WM_DEADCHAR = &H0103
CONST WM_DESTROY = &H0002
CONST WM_INITDIALOG = &H0110
CONST WM_INPUT = &H00FF
CONST WM_KEYDOWN = &H0100
CONST WM_KEYUP = &H0101
CONST WM_KEYUP = &H0101
CONST WM_MOUSEMOVE = &H0200
CONST WM_NCACTIVATE = &H0086
CONST WM_NEXTDLGCTL = &H28
CONST WM_PAINT = &H000F
CONST WM_SETICON = &H0080
CONST WM_SIZE = &H0005
CONST WM_SYSCHAR = &H0106
CONST WM_SYSCHAR = &H0106
CONST WM_SYSDEADCHAR = &H0107
CONST WM_SYSDEADCHAR = &H0107
CONST WM_SYSKEYDOWN = &H0104
CONST WM_SYSKEYDOWN = &H0104
CONST WM_SYSKEYUP = &H0105
CONST WM_SYSKEYUP = &H0105
CONST WM_UNICHAR = &H0109
CONST WS_CAPTION = &H00C00000
CONST WS_CHILD = &H40000000
CONST WS_MAXIMIZEBOX = &H00010000
CONST WS_MINIMIZEBOX = &H00020000
CONST WS_OVERLAPPED = &H00000000
CONST WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
CONST WS_SYSMENU = &H00080000
CONST WS_THICKFRAME = &H00040000
CONST WS_VISIBLE = &H10000000
' ================================================================================================================================================================
' END CONSTANTS
' ================================================================================================================================================================
' Thank to José Roca
DECLARE FUNCTION RegisterRawInputDevices LIB "USER32.DLL" ALIAS "RegisterRawInputDevices"( _
BYREF pRawInputDevices AS RAWINPUTDEVICE, _
BYVAL uiNumDevices AS _UNSIGNED LONG, _ ' DWORD
BYVAL cbSize AS _UNSIGNED LONG _ ' DWORD
) AS LONG
DECLARE FUNCTION GetRawInputDeviceList LIB "USER32.DLL" ALIAS "GetRawInputDeviceList"( _
BYREF pRawInputDeviceList AS RAWINPUTDEVICELIST, _
BYREF puiNumDevices AS _UNSIGNED LONG, _ ' DWORD
BYVAL cbSize AS _UNSIGNED LONG _ ' DWORD
) AS _UNSIGNED LONG ' DWORD
DECLARE FUNCTION GetRawInputDeviceInfo LIB "USER32.DLL" ALIAS "GetRawInputDeviceInfoA"( _
BYVAL hDevice AS _UNSIGNED LONG, _ ' DWORD <- should this be _OFFSET?
BYVAL uiCommand AS _UNSIGNED LONG, _ ' DWORD
BYREF pData AS _OFFSET, _ ' ANY
BYREF pcbSize AS _UNSIGNED LONG _ ' DWORD
) AS _UNSIGNED LONG ' DWORD
DECLARE FUNCTION SendDlgItemMessage LIB "USER32.DLL" ALIAS "SendDlgItemMessageA"( _
BYVAL hWnd AS _OFFSET, _ ' DWORD
BYVAL nIDDlgItem AS LONG, _
BYVAL Msg AS _UNSIGNED LONG, _ ' DWORD
BYVAL wParam AS _UNSIGNED LONG, _ ' DWORD
BYVAL lParam AS LONG _
) AS LONG
DECLARE FUNCTION GetRawInputData LIB "USER32.DLL" ALIAS "GetRawInputData"( _
BYVAL hRawInput AS _UNSIGNED LONG, _ ' DWORD
BYVAL uiCommand AS _UNSIGNED LONG, _ ' DWORD
BYREF pData AS _OFFSET, _ ' ANY
BYREF pcbSize AS _UNSIGNED LONG, _ ' DWORD
BYVAL cbSizeHeader AS _UNSIGNED LONG _ ' DWORD
) AS _UNSIGNED LONG ' DWORD
DECLARE FUNCTION GetKeyNameText LIB "USER32.DLL" ALIAS "GetKeyNameTextA"( _
BYVAL lParam AS LONG, _
BYREF lpString AS STRING, _ ' ASCIIZ = NULL-terminated string
BYVAL cchSize AS _UNSIGNED LONG _ ' DWORD
) AS LONG
DECLARE FUNCTION MapVirtualKey LIB "USER32.DLL" ALIAS "MapVirtualKeyA"( _
BYVAL uCode AS _UNSIGNED LONG, _ ' DWORD
BYVAL uMapType AS _UNSIGNED LONG _ ' DWORD
) AS _UNSIGNED LONG ' DWORD
DECLARE FUNCTION GetFocus LIB "USER32.DLL" ALIAS "GetFocus"( _
) AS _UNSIGNED LONG ' DWORD
DECLARE FUNCTION GetDlgItem LIB "USER32.DLL" ALIAS "GetDlgItem"( _
BYVAL HWND AS _OFFSET, _ ' DWORD
BYVAL nIDDlgItem AS LONG _
) AS _UNSIGNED LONG ' DWORD
DECLARE FUNCTION SendMessage LIB "USER32.DLL" ALIAS "SendMessageA"( _
BYVAL hWnd AS _OFFSET, _ ' DWORD
BYVAL Msg AS _UNSIGNED LONG, _ ' DWORD
BYVAL wParam AS _UNSIGNED LONG, _ ' DWORD
BYVAL lParam AS LONG _
) AS LONG
DECLARE FUNCTION DestroyIcon LIB "USER32.DLL" ALIAS "DestroyIcon"( _
BYVAL hIcon AS _UNSIGNED LONG _ ' DWORD
) AS LONG
DECLARE FUNCTION PostMessage LIB "USER32.DLL" ALIAS "PostMessageA"( _
BYVAL hWnd AS _OFFSET, _ ' DWORD
BYVAL Msg AS _UNSIGNED LONG, _ ' DWORD
BYVAL wParam AS _UNSIGNED LONG, _ ' DWORD
BYVAL lParam AS LONG _
) AS LONG
DECLARE FUNCTION SetClassLong LIB "USER32.DLL" ALIAS "SetClassLongA"( _
BYVAL hWnd AS _OFFSET, _ ' DWORD
BYVAL nIndex AS LONG, _
BYVAL dwNewLong AS _UNSIGNED LONG _ ' DWORD
) AS DWORD
DECLARE FUNCTION ExtractIconEx LIB "SHELL32.DLL" ALIAS "ExtractIconExA"( _
BYREF lpszFile AS STRING, _ ' ASCIIZ = NULL-terminated string
BYVAL nIconIndex AS LONG, _
BYREF phiconLarge AS _UNSIGNED LONG, _ ' DWORD
BYREF phiconSmall AS _UNSIGNED LONG, _ ' DWORD
BYVAL nIcons AS _UNSIGNED LONG _ ' DWORD
) AS _UNSIGNED LONG ' DWORD
DECLARE FUNCTION SetDlgItemText LIB "USER32.DLL" ALIAS "SetDlgItemTextA"( _
BYVAL hDlg AS LONG, _
BYVAL nIDDlgItem AS LONG, _
lpString AS STRING _ ' ASCIIZ = NULL-terminated string
) AS LONG
DECLARE SUB Keybd_event LIB "USER32.DLL" ALIAS "keybd_event"( _
BYVAL bVk AS BYTE, _
BYVAL bScan AS BYTE, _
BYVAL dwFlags AS _UNSIGNED LONG, _ ' DWORD
BYVAL dwExtraInfo AS _UNSIGNED LONG _ ' DWORD
)
GLOBAL hDlg AS _UNSIGNED LONG ' DWORD
CALLBACK FUNCTION DlgProc
LOCAL RidDeviceInfo AS RID_DEVICE_INFO
LOCAL pRawInput AS RAWINPUT POINTER
LOCAL zKeyName AS STRING ' ASCIIZ * 50 = NULL-terminated string
STATIC CtrlClass AS STRING ' ASCIIZ * 50 = NULL-terminated string
LOCAL sRawInput AS STRING
LOCAL sBuffer AS STRING
LOCAL ScanCode AS _UNSIGNED LONG ' DWORD
STATIC hidDevice AS _UNSIGNED LONG ' DWORD
STATIC hFocusBak AS _UNSIGNED LONG ' 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) & chr$(13) & chr$(10) ' $CRLF 'Show handle
sBuffer = sBuffer & "RawInput.Header.dwType = " & CHOOSE$(@pRawInput.header.dwType + 1, _
"RIM_TYPEMOUSE", "RIM_TYPEKEYBOARD", "RIM_TYPEHID") & chr$(13) & chr$(10) ' $CRLF 'Show type
sBuffer = sBuffer & chr$(13) & chr$(10) ' $CRLF
sBuffer = sBuffer & "RawInput.data.Keyboard.vKey =" & STR$(@pRawInput.data.Keyboard.vKey) & _ '
", Character is " & $DQ & CHR$(@pRawInput.data.Keyboard.vKey) & $DQ & chr$(13) & chr$(10) & chr$(13) & chr$(10) ' $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 & chr$(13) & chr$(10) ' $CRLF
sBuffer = sBuffer & chr$(13) & chr$(10) ' $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" & chr$(13) & chr$(10) ' $CRLF
CASE %WM_KEYUP : sBuffer = sBuffer & " WM_KEYUP" & chr$(13) & chr$(10) ' $CRLF
CASE %WM_SYSKEYDOWN : sBuffer = sBuffer & " WM_SYSKEYDOWN" & chr$(13) & chr$(10) ' $CRLF
CASE %WM_SYSKEYDOWN : sBuffer = sBuffer & " WM_SYSKEYDOWN" & chr$(13) & chr$(10) ' $CRLF
END SELECT
sBuffer = sBuffer & chr$(13) & chr$(10) ' $CRLF
sBuffer = sBuffer & "RawInput.Keyboard.MakeCode = " & HEX$(@pRawInput.data.Keyboard.MakeCode, 8) & chr$(13) & chr$(10) ' $CRLF 'Show make code
sBuffer = sBuffer & "RawInput.data.Keyboard.ExtraInformation = " & _
HEX$(@pRawInput.data.Keyboard.ExtraInformation, 8) & chr$(13) & chr$(10) ' $CRLF 'Show extra info
IF (@pRawInput.data.Keyboard.Flags AND %RI_KEY_BREAK) THEN 'Show flags
sBuffer = sBuffer & "Flag RI_KEY_BREAK" & chr$(13) & chr$(10) ' $CRLF
ELSE
sBuffer = sBuffer & "Flag RI_KEY_MAKE" & chr$(13) & chr$(10) ' $CRLF
END IF
IF (@pRawInput.data.Keyboard.Flags AND %RI_KEY_E0) THEN
sBuffer = sBuffer & "Flag RI_KEY_E0" & chr$(13) & chr$(10) ' $CRLF
END IF
IF (@pRawInput.data.Keyboard.Flags AND %RI_KEY_E1) THEN
sBuffer = sBuffer & "Flag RI_KEY_E1" & chr$(13) & chr$(10) ' $CRLF
END IF
IF (@pRawInput.data.Keyboard.Flags AND %RI_KEY_TERMSRV_SET_LED) THEN
sBuffer = sBuffer & "Flag RI_KEY_TERMSRV_SET_LED" & chr$(13) & chr$(10) ' $CRLF
END IF
IF (@pRawInput.data.Keyboard.Flags AND %RI_KEY_TERMSRV_SHADOW) THEN
sBuffer = sBuffer & "Flag RI_KEY_TERMSRV_SHADOW" & chr$(13) & chr$(10) ' $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 _UNSIGNED LONG
LOCAL hIconSmall AS _UNSIGNED LONG
' Dialog Boxes 03/12/2023
' https://learn.microsoft.com/en-us/windows/win32/api/_dlgbox/
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 ' PBMAIN
Posts: 314
Threads: 11
Joined: Apr 2022
Reputation:
44
The union usage in TYPEs like `RID_DEVICE_INFO` and `RAWMOUSE` are not correct, there's no `_OFFSET` involved. The union represents memory in the struct itself, not a pointer to memory elsewhere. You should probably just declare it as a fixed STRING member (`dummy AS STRING * 250`) where the length of the string the size of the union. Then you can use `_MEM()` on that member and use `_MEMGET` to copy that data at the location of the STRING into a variable of the proper type.
You're correct that `hDevice` in `RAWINPUTDEVICeLIST` should be an `_OFFSET` to correspond with the `HANDLE` type. I would refer to this page on the C types and what they correspond too.
The `RAWHID` and `bRawData` is ok, but just recognize the `TYPE` is not the real size of the data. When you use it you'll have to use `_MEMNEW()` to actually create it, and then you can `_MEMGET` from that memory to read the `RAWHID` header and then the `bRawData` itself (which will go past the end of the `RAWHID` TYPE).
`RAWMOUSE` probably also has padding between the `usFlags` and the union. The union starts with a `ULONG`, which requires 4 byte alignment, but the `USHORT` leaves the struct on a 2-byte boundary, so you need 2 bytes of padding to get proper alignment for the `ULONG`. `ulRawButtons` probably also requires padding before it.
Posts: 705
Threads: 99
Joined: Apr 2022
Reputation:
13
06-05-2024, 11:05 PM
(This post was last modified: 06-05-2024, 11:07 PM by madscijr.)
(06-05-2024, 10:16 PM)DSMan195276 Wrote: The union usage in TYPEs like `RID_DEVICE_INFO` and `RAWMOUSE` are not correct, there's no `_OFFSET` involved. The union represents memory in the struct itself, not a pointer to memory elsewhere. You should probably just declare it as a fixed STRING member (`dummy AS STRING * 250`) where the length of the string the size of the union. Then you can use `_MEM()` on that member and use `_MEMGET` to copy that data at the location of the STRING into a variable of the proper type.
You're correct that `hDevice` in `RAWINPUTDEVICeLIST` should be an `_OFFSET` to correspond with the `HANDLE` type. I would refer to this page on the C types and what they correspond too.
The `RAWHID` and `bRawData` is ok, but just recognize the `TYPE` is not the real size of the data. When you use it you'll have to use `_MEMNEW()` to actually create it, and then you can `_MEMGET` from that memory to read the `RAWHID` header and then the `bRawData` itself (which will go past the end of the `RAWHID` TYPE).
`RAWMOUSE` probably also has padding between the `usFlags` and the union. The union starts with a `ULONG`, which requires 4 byte alignment, but the `USHORT` leaves the struct on a 2-byte boundary, so you need 2 bytes of padding to get proper alignment for the `ULONG`. `ulRawButtons` probably also requires padding before it. Thanks for that info... I dug up Spriggsy's old code, and see he had already got a lot of those definitions working in QB64PE with the multi mouse, so I merged in those definitions.
It seems the code is almost complete - so close! (Full code below.) However now I'm getting an incorrect # of arguments on line 749, but that same line wasn't giving errors before. There must be some other syntax error but it's eluding me.
Argh... Enough computers for today! 
Thanks again!
Code: (Select All) Option Explicit
_Title "multikey"
$NoPrefix
$Console:Only
Console Off
' READS MULTIPLE KEYBOARDS PLUGGED INTO ONE COMPUTER AS SEPERATE DEVICES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CONSTANTS PART 3
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Const FALSE = 0
Const TRUE = Not FALSE
' MIN/MAX VALUES FOR MOUSE TEST
Const cMinX = 2
Const cMaxX = 79
Const cMinY = 16
Const cMaxY = 24
Const cMinWheel = 0
Const cMaxWheel = 255
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END CONSTANTS PART 3
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ================================================================================================================================================================
' BEGIN API CONSTANTS
' ================================================================================================================================================================
Const COLOR_WINDOW = 5
Const CS_HREDRAW = &H0002
Const CS_VREDRAW = &H0001
Const CW_USEDEFAULT = &H80000000
Const DT_CENTER = &H00000001
Const Edit = 101
Const EM_GETSEL = &H00B0
Const EM_SETSEL = &H00B1
Const EN_CHANGE = &H0300
Const EN_KILLFOCUS = &H0200
Const EN_SETFOCUS = &H0100
Const GCL_HICON = -14
Const GCL_HICONSM = -34
Const Hid_Bottom = 66
Const Hid_Left = 33
Const Hid_Right = 34
Const HWND_DESKTOP = 0
Const ICON_BIG = 1
Const ICON_SMALL = 0
Const IDC_ARROW = 32512
Const IDI_APPLICATION = 32512
Const KEYEVENTF_KEYUP = &H0002
Const KL_NAMELENGTH = 9
Const LabelInfo = 201
Const MOUSE_ATTRIBUTES_CHANGED = &H04
Const MOUSE_MOVE_ABSOLUTE = &H01
Const MOUSE_MOVE_NOCOALESCE = &H08
Const MOUSE_MOVE_RELATIVE = &H00
Const MOUSE_VIRTUAL_DESKTOP = &H02
Const NULL = 0
Const RI_KEY_BREAK = 1
Const RI_KEY_E0 = 2
Const RI_KEY_E1 = 4
Const RI_KEY_MAKE = 0
Const RI_KEY_TERMSRV_SET_LED = 8
Const RI_KEY_TERMSRV_SHADOW = &H10
Const RID_INPUT = &H10000003
Const RIDEV_EXINPUTSINK = &H00001000
Const RIDI_DEVICEINFO = &H2000000B
Const RIM_TYPEHID = 2
Const RIM_TYPEKEYBOARD = 1
Const RIM_TYPEMOUSE = 0
Const SIZE_MINIMIZED = 1
Const SW_SHOW = 5
Const VK_CONTROL = &H11
Const VK_DELETE = &H2E
Const VK_DIVIDE = &H6F
Const VK_DOWN = &H28
Const VK_END = &H23
Const VK_HOME = &H24
Const VK_INSERT = &H2D
Const VK_LEFT = &H25
Const VK_NEXT = &H22
Const VK_NUMLOCK = &H90
Const VK_PRIOR = &H21
Const VK_RIGHT = &H27
Const VK_SCROLL = &H91
Const VK_UP = &H26
Const WM_APP = &H08000
Const WM_APPCOMMAND = &H0319
Const WM_CHAR = &H0102
Const WM_COMMAND = &H0111
Const WM_DEADCHAR = &H0103
Const WM_DESTROY = &H0002
Const WM_INITDIALOG = &H0110
Const WM_INPUT = &H00FF
Const WM_KEYDOWN = &H0100
Const WM_KEYUP = &H0101
Const WM_MOUSEMOVE = &H0200
Const WM_NCACTIVATE = &H0086
Const WM_NEXTDLGCTL = &H28
Const WM_PAINT = &H000F
Const WM_SETICON = &H0080
Const WM_SIZE = &H0005
Const WM_SYSCHAR = &H0106
Const WM_SYSDEADCHAR = &H0107
Const WM_SYSKEYDOWN = &H0104
Const WM_SYSKEYUP = &H0105
Const WM_UNICHAR = &H0109
Const WS_CAPTION = &H00C00000
Const WS_CHILD = &H40000000
Const WS_MAXIMIZEBOX = &H00010000
Const WS_MINIMIZEBOX = &H00020000
Const WS_OVERLAPPED = &H00000000
'CONST WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Const WS_SYSMENU = &H00080000
Const WS_THICKFRAME = &H00040000
Const WS_VISIBLE = &H10000000
' ================================================================================================================================================================
' END API CONSTANTS
' ================================================================================================================================================================
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN RAW INPUT TYPES PART 1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Type RAWINPUTDEVICE
As Unsigned Integer usUsagePage, usUsage
As Unsigned Long dwFlags
As Offset hwndTarget
End Type
Type RAWINPUTDEVICELIST
As Offset hDevice
As Unsigned Long dwType
$If 64BIT Then
As String * 4 alignment
$End If
End Type
Type POINT
As Long x, y
End Type
Type MSG
As Offset hwnd
As Unsigned Long message
As Unsigned Offset wParam
As Offset lParam
As Long time
As POINT pt
As Long lPrivate
End Type
Type WNDCLASSEX
As Unsigned Long cbSize, style
As Offset lpfnWndProc
As Long cbClsExtra, cbWndExtra
As Offset hInstance, hIcon, hCursor, hbrBackground, lpszMenuName, lpszClassName, hIconSm
End Type
Type RECT
As Long left, top, right, bottom
End Type
Type PAINTSTRUCT
As Offset hdc
As Long fErase
$If 64BIT Then
As String * 4 alignment
$End If
As RECT rcPaint
As Long fRestore, fIncUpdate
As String * 32 rgbReserved
End Type
Type RAWINPUTHEADER
As Unsigned Long dwType, dwSize
As Offset hDevice
As Unsigned Offset wParam
End Type
Type RAWMOUSE
As Unsigned Integer usFlags
$If 64BIT Then
As String * 2 alignment
$End If
'As Unsigned Long ulButtons 'commented out because I'm creating this value using MAKELONG
As Unsigned Integer usButtonFlags, usButtonData
As Unsigned Long ulRawButtons
As Long lLastX, lLastY
As Unsigned Long ulExtraInformation
End Type
Type RAWINPUT
As RAWINPUTHEADER header
As RAWMOUSE mouse
End Type
' UDT TO HOLD THE INFO FOR EACH MOUSE
Type InfoType
ID As String ' mouse device ID
c As String ' cursor character
x As Integer ' screen x position
y As Integer ' screen y position
wheel As Integer ' mouse wheel value
LeftDown As Integer ' tracks left mouse button state, TRUE=down
MiddleDown As Integer ' tracks middle mouse button state, TRUE=down
RightDown As Integer ' tracks right mouse button state, TRUE=down
LeftCount As Integer ' counts left clicks
MiddleCount As Integer ' counts middle clicks
RightCount As Integer ' counts right clicks
End Type ' InfoType
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END RAW INPUT TYPES PART 1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN RAW INPUT TYPES PART 2
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' QB64PE C Libraries
' https://qb64phoenix.com/qb64wiki/index.php/C_Libraries
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RID_DEVICE_INFO_MOUSE structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_mouse
'typedef struct tagRID_DEVICE_INFO_MOUSE {
' DWORD dwId;
' DWORD dwNumberOfButtons;
' DWORD dwSampleRate;
' BOOL fHasHorizontalWheel;
'} RID_DEVICE_INFO_MOUSE, *PRID_DEVICE_INFO_MOUSE;
Type RID_DEVICE_INFO_MOUSE
dwId As _Unsigned Long
dwNumberOfButtons As _Unsigned Long
dwSampleRate As _Unsigned Long
fHasHorizontalWheel As Integer
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RID_DEVICE_INFO_KEYBOARD structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_keyboard
'typedef struct tagRID_DEVICE_INFO_KEYBOARD {
' DWORD dwType;
' DWORD dwSubType;
' DWORD dwKeyboardMode;
' DWORD dwNumberOfFunctionKeys;
' DWORD dwNumberOfIndicators;
' DWORD dwNumberOfKeysTotal;
'} RID_DEVICE_INFO_KEYBOARD, *PRID_DEVICE_INFO_KEYBOARD;
Type RID_DEVICE_INFO_KEYBOARD
dwType As _Unsigned Long ' DWORD
dwSubType As _Unsigned Long ' DWORD
dwKeyboardMode As _Unsigned Long ' DWORD
dwNumberOfFunctionKeys As _Unsigned Long ' DWORD
dwNumberOfIndicators As _Unsigned Long ' DWORD
dwNumberOfKeysTotal As _Unsigned Long ' DWORD
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RID_DEVICE_INFO_HID structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_hid
'typedef struct tagRID_DEVICE_INFO_HID {
' DWORD dwVendorId;
' DWORD dwProductId;
' DWORD dwVersionNumber;
' USHORT usUsagePage;
' USHORT usUsage;
'} RID_DEVICE_INFO_HID, *PRID_DEVICE_INFO_HID;
Type RID_DEVICE_INFO_HID
dwVendorId As _Unsigned Long ' DWORD
dwProductId As _Unsigned Long ' DWORD
dwVersionNumber As _Unsigned Long ' DWORD
usUsagePage As _Unsigned Integer ' USHORT
usUsage As _Unsigned Integer ' USHORT
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RID_DEVICE_INFO structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info
'typedef struct tagRID_DEVICE_INFO {
' DWORD cbSize;
' DWORD dwType;
' union {
' RID_DEVICE_INFO_MOUSE mouse;
' RID_DEVICE_INFO_KEYBOARD keyboard;
' RID_DEVICE_INFO_HID hid;
' } DUMMYUNIONNAME1;
'} RID_DEVICE_INFO, *PRID_DEVICE_INFO, *LPRID_DEVICE_INFO;
Type DUMMYUNIONNAME1
My_RID_DEVICE_INFO_MOUSE As _Offset ' pointer to VAR A1
My_RID_DEVICE_INFO_KEYBOARD As _Offset ' pointer to VAR A2
My_RID_DEVICE_INFO_HID As _Offset ' pointer to VAR A3
End Type
Type RID_DEVICE_INFO
cbSize As _Unsigned Long ' DWORD
dwType As _Unsigned Long ' DWORD
My_DUMMYUNIONNAME1 As _Offset ' pointer to DUMMYUNIONNAME1
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWKEYBOARD structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawkeyboard
'typedef struct tagRAWKEYBOARD {
' USHORT MakeCode;
' USHORT Flags;
' USHORT Reserved;
' USHORT VKey;
' UINT Message;
' ULONG ExtraInformation;
'} RAWKEYBOARD, *PRAWKEYBOARD, *LPRAWKEYBOARD;
Type RAWKEYBOARD
MakeCode As _Unsigned Integer ' USHORT
Flags As _Unsigned Integer ' USHORT
Reserved As _Unsigned Integer ' USHORT
VKey As _Unsigned Integer ' USHORT
Message As _Unsigned Long ' UINT
ExtraInformation As _Unsigned _Offset ' ULONG
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Spriggsy already figured this one out:
'RAWMOUSE structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawmouse
'typedef struct tagRAWMOUSE {
' USHORT usFlags;
' union {
' ULONG ulButtons;
' struct {
' USHORT usButtonFlags;
' USHORT usButtonData;
' } DUMMYSTRUCTNAME;
' } DUMMYUNIONNAME2;
' ULONG ulRawButtons;
' LONG lLastX;
' LONG lLastY;
' ULONG ulExtraInformation;
'} RAWMOUSE, *PRAWMOUSE, *LPRAWMOUSE;
'TYPE DUMMYSTRUCTNAME
' usButtonFlags AS _UNSIGNED INTEGER ' USHORT
' usButtonData AS _UNSIGNED INTEGER ' USHORT
'END TYPE
'TYPE DUMMYUNIONNAME2
' ulButtons AS _UNSIGNED _OFFSET ' ULONG
' My_DUMMYSTRUCTNAME AS _OFFSET ' pointer to DUMMYSTRUCTNAME
'END TYPE
'TYPE RAWMOUSE
' usFlags AS _UNSIGNED INTEGER ' USHORT
' My_DUMMYUNIONNAME2 AS _OFFSET ' pointer to DUMMYUNIONNAME2
' ulRawButtons AS _UNSIGNED _OFFSET ' ULONG
' lLastX AS LONG
' lLastY AS LONG
' ulExtraInformation AS _UNSIGNED _OFFSET ' ULONG
'END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWHID structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawhid
'typedef struct tagRAWHID {
' DWORD dwSizeHid;
' DWORD dwCount;
' BYTE bRawData[1];
'} RAWHID, *PRAWHID, *LPRAWHID;
Type RAWHID
dwSizeHid As _Unsigned Long ' DWORD
dwCount As _Unsigned Long ' DWORD
bRawData As _Unsigned _Byte ' bRawData[1] AS BYTE
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Spriggsy already figured this one out:
'RAWINPUTHEADER structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputheader
'typedef struct tagRAWINPUTHEADER {
' DWORD dwType;
' DWORD dwSize;
' HANDLE hDevice;
' WPARAM wParam;
'} RAWINPUTHEADER, *PRAWINPUTHEADER, *LPRAWINPUTHEADER;
'TYPE RAWINPUTHEADER
' dwType AS _UNSIGNED LONG ' DWORD
' dwSize AS _UNSIGNED LONG ' DWORD
' hDevice AS _UNSIGNED LONG ' DWORD <- should this be _OFFSET ?
' wParam AS LONG
'END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Spriggsy already figured this one out:
'RAWINPUT structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinput
'typedef struct tagRAWINPUT {
' RAWINPUTHEADER header;
' union {
' RAWMOUSE mouse;
' RAWKEYBOARD keyboard;
' RAWHID hid;
' } data;
'} RAWINPUT, *PRAWINPUT, *LPRAWINPUT;
'TYPE RAWINPUTUNION
' mouse AS _OFFSET ' pointer to RAWMOUSE variable
' keyboard AS _OFFSET ' pointer to RAWKEYBOARD variable
' hid AS _OFFSET ' pointer to RAWHID
'END TYPE
'TYPE RAWINPUT
' header AS RAWINPUTHEADER
' data AS _OFFSET
'END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Spriggsy already figured this one out:
'RAWINPUTDEVICELIST structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevicelist
'typedef struct tagRAWINPUTDEVICELIST {
' HANDLE hDevice;
' DWORD dwType;
'} RAWINPUTDEVICELIST, *PRAWINPUTDEVICELIST;
'TYPE RAWINPUTDEVICELIST
' hDevice AS _UNSIGNED LONG ' DWORD <- should this be _OFFSET ?
' dwType AS _UNSIGNED LONG ' DWORD
'END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Spriggsy already figured this one out:
'RAWINPUTDEVICE structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevice
'typedef struct tagRAWINPUTDEVICE {
' USHORT usUsagePage;
' USHORT usUsage;
' DWORD dwFlags;
' HWND hwndTarget;
'} RAWINPUTDEVICE, *PRAWINPUTDEVICE, *LPRAWINPUTDEVICE;
'TYPE RAWINPUTDEVICE
' usUsagePage AS _UNSIGNED INTEGER ' WORD
' usUsage AS _UNSIGNED INTEGER ' WORD
' dwFlags AS _UNSIGNED LONG ' DWORD
' hwndTarget AS _OFFSET ' DWORD
'END TYPE
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END RAW INPUT TYPES PART 2
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN API DECLARATIONS PART 1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Declare CustomType Library
Function GetRawInputDeviceList~& (ByVal pRawInputDeviceList As Offset, Byval puiNumDevices As Offset, Byval cbSize As Unsigned Long)
Sub GetRawInputDeviceList (ByVal pRawInputDeviceList As Offset, Byval puiNumDevices As Offset, Byval cbSize As Unsigned Long)
Function RegisterRawInputDevices& (ByVal pRawInputDevices As Offset, Byval uiNumDevices As Unsigned Long, Byval cbSize As Unsigned Long)
Function GetModuleHandle%& (ByVal lpModulename As Offset)
Function LoadIcon%& (ByVal hInstance As Offset, Byval lpIconName As Offset)
Function LoadCursor%& (ByVal hInstance As Offset, Byval lpCursorName As Offset)
Function RegisterClassEx~% (ByVal wndclassex As Offset)
Function CreateWindowEx%& (ByVal dwExStyle As Unsigned Long, Byval lpClassName As Offset, Byval lpWindowName As Offset, Byval dwStyle As Unsigned Long, Byval x As Long, Byval y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As Offset, Byval hMenu As Offset, Byval hInstance As Offset, Byval lpParam As Offset)
Sub ShowWindow (ByVal hWnd As Offset, Byval nCmdShow As Long)
Sub UpdateWindow (ByVal hWnd As Offset)
Function GetMessage& (ByVal lpMsg As Offset, Byval hWnd As Offset, Byval wMsgFilterMin As Unsigned Long, Byval wMsgFilterMax As Unsigned Long)
Sub TranslateMessage (ByVal lpMsg As Offset)
Sub DispatchMessage (ByVal lpMsg As Offset)
Sub PostQuitMessage (ByVal nExitCode As Long)
Function DefWindowProc%& (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
Sub GetRawInputData (ByVal hRawInput As Offset, Byval uiCommand As Unsigned Long, Byval pData As Offset, Byval pcbSize As Offset, Byval cbSizeHeader As Unsigned Long)
Function GetRawInputData~& (ByVal hRawInput As Offset, Byval uiCommand As Unsigned Long, Byval pData As Offset, Byval pcbSize As Offset, Byval cbSizeHeader As Unsigned Long)
Sub InvalidateRect (ByVal hWnd As Offset, Byval lpRect As Offset, Byval bErase As Long)
Sub SendMessage (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
Function BeginPaint%& (ByVal hWnd As Offset, Byval lpPaint As Offset)
Sub GetClientRect (ByVal hWnd As Offset, Byval lpRect As Offset)
Sub DrawText (ByVal hdc As Offset, Byval lpchText As Offset, Byval cchText As Long, Byval lprc As Offset, Byval format As Unsigned Long)
Sub OffsetRect (ByVal lprc As Offset, Byval dx As Long, Byval dy As Long)
Sub EndPaint (ByVal hWnd As Offset, Byval lpPaint As Offset)
End Declare
' Header file "makeint.h" must be in same folder as this program.
Declare CustomType Library ".\makeint"
Function MAKEINTRESOURCE%& Alias "MAKEINTRSC" (ByVal i As _Offset)
End Declare
Declare Library
Function MAKELPARAM%& (ByVal l As Integer, Byval h As Integer)
Function MAKELONG~& (ByVal l As Unsigned Integer, Byval h As Unsigned Integer)
End Declare
$If 64BIT Then
Declare Library ".\internal\c\c_compiler\x86_64-w64-mingw32\include\windowsx"
$Else
Declare Library ".\internal\c\c_compiler\i686-w64-mingw32\include\windowsx"
$End If
Function GET_Y_LPARAM& (ByVal lp As Offset)
Function GET_X_LPARAM& (ByVal lp As Offset)
End Declare
' Header file "winproc.h" must be in same folder as this program.
Declare Library ".\winproc"
Function WindowProc%& ()
End Declare
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END API DECLARATIONS PART 1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN API DECLARATIONS PART 2
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Thank to José Roca
DECLARE FUNCTION RegisterRawInputDevices LIB "USER32.DLL" ALIAS "RegisterRawInputDevices"( _
BYREF pRawInputDevices AS RAWINPUTDEVICE, _
BYVAL uiNumDevices AS _UNSIGNED LONG, _
BYVAL cbSize AS _UNSIGNED LONG _
) AS LONG
DECLARE FUNCTION GetRawInputDeviceList LIB "USER32.DLL" ALIAS "GetRawInputDeviceList"( _
BYREF pRawInputDeviceList AS RAWINPUTDEVICELIST, _
BYREF puiNumDevices AS _UNSIGNED LONG, _
BYVAL cbSize AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION GetRawInputDeviceInfo LIB "USER32.DLL" ALIAS "GetRawInputDeviceInfoA"( _
BYVAL hDevice AS _UNSIGNED LONG, _
BYVAL uiCommand AS _UNSIGNED LONG, _
BYREF pData AS _OFFSET, _
BYREF pcbSize AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION SendDlgItemMessage LIB "USER32.DLL" ALIAS "SendDlgItemMessageA"( _
BYVAL hWnd AS _OFFSET, _
BYVAL nIDDlgItem AS LONG, _
BYVAL Msg AS _UNSIGNED LONG, _
BYVAL wParam AS _UNSIGNED LONG, _
BYVAL lParam AS LONG _
) AS LONG
DECLARE FUNCTION GetRawInputData LIB "USER32.DLL" ALIAS "GetRawInputData"( _
BYVAL hRawInput AS _UNSIGNED LONG, _
BYVAL uiCommand AS _UNSIGNED LONG, _
BYREF pData AS _OFFSET, _
BYREF pcbSize AS _UNSIGNED LONG, _
BYVAL cbSizeHeader AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION GetKeyNameText LIB "USER32.DLL" ALIAS "GetKeyNameTextA"( _
BYVAL lParam AS LONG, _
BYREF lpString AS STRING, _
BYVAL cchSize AS _UNSIGNED LONG _
) AS LONG
DECLARE FUNCTION MapVirtualKey LIB "USER32.DLL" ALIAS "MapVirtualKeyA"( _
BYVAL uCode AS _UNSIGNED LONG, _
BYVAL uMapType AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION GetFocus LIB "USER32.DLL" ALIAS "GetFocus"( _
) AS _UNSIGNED LONG
DECLARE FUNCTION GetDlgItem LIB "USER32.DLL" ALIAS "GetDlgItem"( _
BYVAL HWND AS _OFFSET, _
BYVAL nIDDlgItem AS LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION SendMessage LIB "USER32.DLL" ALIAS "SendMessageA"( _
BYVAL hWnd AS _OFFSET, _
BYVAL Msg AS _UNSIGNED LONG, _
BYVAL wParam AS _UNSIGNED LONG, _
BYVAL lParam AS LONG _
) AS LONG
DECLARE FUNCTION DestroyIcon LIB "USER32.DLL" ALIAS "DestroyIcon"( _
BYVAL hIcon AS _UNSIGNED LONG _
) AS LONG
DECLARE FUNCTION PostMessage LIB "USER32.DLL" ALIAS "PostMessageA"( _
BYVAL hWnd AS _OFFSET, _
BYVAL Msg AS _UNSIGNED LONG, _
BYVAL wParam AS _UNSIGNED LONG, _
BYVAL lParam AS LONG _
) AS LONG
DECLARE FUNCTION SetClassLong LIB "USER32.DLL" ALIAS "SetClassLongA"( _
BYVAL hWnd AS _OFFSET, _
BYVAL nIndex AS LONG, _
BYVAL dwNewLong AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION ExtractIconEx LIB "SHELL32.DLL" ALIAS "ExtractIconExA"( _
BYREF lpszFile AS STRING, _
BYVAL nIconIndex AS LONG, _
BYREF phiconLarge AS _UNSIGNED LONG, _
BYREF phiconSmall AS _UNSIGNED LONG, _
BYVAL nIcons AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION SetDlgItemText LIB "USER32.DLL" ALIAS "SetDlgItemTextA"( _
BYVAL hDlg AS LONG, _
BYVAL nIDDlgItem AS LONG, _
lpString AS STRING _
) AS LONG
DECLARE SUB Keybd_event LIB "USER32.DLL" ALIAS "keybd_event"( _
BYVAL bVk AS BYTE, _
BYVAL bScan AS BYTE, _
BYVAL dwFlags AS _UNSIGNED LONG, _
BYVAL dwExtraInfo AS _UNSIGNED LONG _
)
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END API DECLARATIONS PART 2
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL VARIABLES PART 1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' RAW INPUT VARIABLES
Dim Shared mousemessage As String
Dim Shared rawinputdevices As String
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL VARIABLES PART 1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL VARIABLES PART 2
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Shared hDlg As _Unsigned Long ' DWORD
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL VARIABLES PART 2
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL VARIABLES PART 3
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bDebug As Integer: m_bDebug = FALSE
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
' MOUSE TEST VARIABLES
Dim Shared arrInfo(8) As InfoType ' STORES INFO FOR EACH MOUSE
'Dim Shared arrRawMouseID(8) As Long ' device IDs for mice connected to system (guessing this would be a string, dunno)
Dim Shared iMouseCount As Integer ' # OF MICE ATTACHED
Dim Shared arrScreen(1 To 80, 1 To 25) As String ' STORES TEXT FOR SCREEN
Dim Shared iMinX As Long
Dim Shared iMaxX As Long
Dim Shared iMinY As Long
Dim Shared iMaxY As Long
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL VARIABLES PART 3
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' EXECUTION STARTS HERE!
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
iMinX = 0
iMaxX = 3583
iMinY = 0
iMaxY = 8202
System Val(Str$(WinMain))
System ' return control to the operating system
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DATA
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' MOUSE CURSORS (JUST SOME LETTERS)
CData:
Data A,b,C,D,E,f,G,H
' DEFAULT/INTIAL X COORDINATE OF EACH CURSOR ON SCREEN
XData:
Data 5,15,25,35,45,55,65,75
' DEFAULT/INTIAL Y COORDINATE OF EACH CURSOR ON SCREEN
YData:
Data 17,17,19,19,21,21,23,23
' DEFAULT/INITIAL VALUE OF EACH SCROLL WHEEL
WData:
Data 224,192,160,128,96,64,32,0
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DATA
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN RAW INPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' I'M GUESSING THIS FUNCTION WILL ACCOMPLISH THE SAME AS:
' CONST WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
' ???
Function WS_OVERLAPPEDWINDOW% (MyVar&)
MyVar& = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
End Function
' /////////////////////////////////////////////////////////////////////////////
' Runs first
Function WinMain~%& ()
Dim As Offset hwndMain, hInst
Dim As MSG msg
Dim As WNDCLASSEX wndclass
Dim As String szMainWndClass
Dim As String szWinTitle
Dim As Unsigned Integer reg
' =============================================================================
' SET UP WINDOW
'DEBUG: TRY FULL SCREEN <- PROGRAM CRASHES!
'_FullScreen _SquarePixels
hInst = GetModuleHandle(0)
szMainWndClass = "WinTestWin" + Chr$(0)
szWinTitle = "Hello" + Chr$(0)
wndclass.lpszClassName = Offset(szMainWndClass)
wndclass.cbSize = Len(wndclass)
wndclass.style = CS_HREDRAW Or CS_VREDRAW
wndclass.lpfnWndProc = WindowProc
wndclass.hInstance = hInst 'GetModuleHandle(0) will return the hInstance of this EXE
wndclass.hIcon = LoadIcon(0, MAKEINTRESOURCE(IDI_APPLICATION))
wndclass.hIconSm = LoadIcon(0, MAKEINTRESOURCE(IDI_APPLICATION))
wndclass.hCursor = LoadCursor(0, MAKEINTRESOURCE(IDC_ARROW))
wndclass.hbrBackground = COLOR_WINDOW + 1
reg = RegisterClassEx(Offset(wndclass)) 'I prefer to use the output of RegisterClassEx rather than the window name
'DEBUG: SUBSTITUTE _WindowHandle
'Function CreateWindowEx%& (ByVal dwExStyle As Unsigned Long, Byval lpClassName As Offset, Byval lpWindowName As Offset, Byval dwStyle As Unsigned Long, Byval x As Long, Byval y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As Offset, Byval hMenu As Offset, Byval hInstance As Offset, Byval lpParam As Offset)
hwndMain = CreateWindowEx(0, MAKELPARAM(reg, 0), Offset(szWinTitle), WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, hInst, 0)
'hwndMain = _WindowHandle
'DEBUG: SUBSTITUTE _WindowHandle
ShowWindow hwndMain, SW_SHOW
'ShowWindow _WindowHandle, SW_SHOW
'DEBUG: SUBSTITUTE _WindowHandle
UpdateWindow hwndMain
'UpdateWindow _WindowHandle
' =============================================================================
' INITIALIZE RAW INPUT
InitRawInput
InitMouseTest 'TODO: SAVE_MOUSE_INFO
' =============================================================================
' BEGIN MAIN LOOP
' =============================================================================
While GetMessage(Offset(msg), 0, 0, 0)
TranslateMessage Offset(msg)
DispatchMessage Offset(msg)
Wend
' =============================================================================
' END MAIN LOOP
' =============================================================================
' RETURN A VALUE
WinMain = msg.wParam
End Function ' WinMain
' /////////////////////////////////////////////////////////////////////////////
' Handles main window events
Function MainWndProc%& (hwnd As Offset, nMsg As Unsigned Long, wParam As Unsigned Offset, lParam As Offset)
' EVENT HANDLER VARIABLES PART 1
Static As Offset hwndButton
Static As Long cx, cy
Dim As Offset hdc
Dim As PAINTSTRUCT ps
Dim As RECT rc
Dim As MEM lpb
Dim As Unsigned Long dwSize
Dim As RAWINPUT raw
Dim As Long tmpx, tmpy
Static As Long maxx
Dim As RAWINPUTHEADER rih
' TEMP VARIABLES FOR DISPLAYING FORMATTED VALUES TO SCREEN
Dim strNextID As String
Dim iIndex As Integer
Dim iRowOffset As Integer
Dim iLen As Integer
Dim sCount As String
Dim sX As String
Dim sY As String
Dim sWheel As String
Dim sLeftDown As String
Dim sMiddleDown As String
Dim sRightDown As String
Dim sLeftCount As String
Dim sMiddleCount As String
Dim sRightCount As String
Dim sNext As String
Dim iNewX As Integer
Dim iNewY As Integer
Dim iDX As Integer
Dim iDY As Integer
' EVENT HANDLER VARIABLES PART 2
DIM RidDeviceInfo AS RID_DEVICE_INFO
DIM pRawInput AS _OFFSET ' RAWINPUT POINTER
DIM zKeyName AS STRING ' ASCIIZ * 50 = NULL-terminated string
STATIC CtrlClass AS STRING ' ASCIIZ * 50 = NULL-terminated string
DIM sRawInput AS STRING
DIM sBuffer AS STRING
DIM ScanCode AS _UNSIGNED LONG ' DWORD
STATIC hidDevice AS _UNSIGNED LONG ' DWORD
STATIC hFocusBak AS _UNSIGNED LONG ' DWORD
DIM RawInputDevCount AS LONG
DIM KeyboardTypeCount AS LONG
DIM RawInputDeviceIndex AS LONG
STATIC hidF9 AS LONG
DIM ByteCount AS LONG
STATIC SelStart AS LONG
STATIC SelEnd AS LONG
DIM vbCrLf As String : vbCrLf = chr$(13) + chr$(10)
DIM vbCr As String : vbCr = chr$(13)
DIM vbLf As String : vbLf = chr$(10)
' HANDLE EVENTS
Select Case nMsg
Case WM_DESTROY
PostQuitMessage 0
MainWndProc = 0
Exit Function
Case WM_INPUT
GetRawInputData lParam, RID_INPUT, 0, Offset(dwSize), Len(rih)
' KEYBOARD VERSION:
'GetRawInputData(CBLPARAM, %RID_INPUT, BYVAL %NULL, ByteCount, SIZEOF(RAWINPUTHEADER)) 'Get size of raw input buffer
lpb = MemNew(dwSize)
If lpb.SIZE = 0 Then
MainWndProc = 0
Exit Function
End If
If GetRawInputData(lParam, RID_INPUT, lpb.OFFSET, Offset(dwSize), Len(rih)) <> dwSize Then
Print "GetRawInputData doesn't return correct size!"
End If
MemGet lpb, lpb.OFFSET, raw
If raw.header.dwType = RIM_TYPEMOUSE Then
' TEMPORARILY DISABLE MOUSE
IF TRUE=FALSE THEN
tmpx = raw.mouse.lLastX
tmpy = raw.mouse.lLastY
maxx = tmpx
' UPDATE RANGE OF MOUSE COORDINATES
If GET_X_LPARAM(lParam) < iMinX Then iMinX = GET_X_LPARAM(lParam)
If GET_X_LPARAM(lParam) > iMaxX Then iMaxX = GET_X_LPARAM(lParam)
If GET_Y_LPARAM(lParam) < iMinY Then iMinY = GET_Y_LPARAM(lParam)
If GET_Y_LPARAM(lParam) > iMaxY Then iMaxY = GET_Y_LPARAM(lParam)
' IDENTIFY WHICH MOUSE IT IS
strNextID = _Trim$(Str$(raw.header.hDevice))
iIndex = GetMouseIndex%(strNextID)
If iIndex >= LBound(arrInfo) Then
If iIndex <= UBound(arrInfo) Then
' =============================================================================
' UPDATE ABSOLUTE POSITION
' DOESN'T WORK, MOVES ALL OVER THE PLACE:
'' METHOD #1: SCALE MOUSE POSITION TO 80X25 POSITION
'iNewX = GET_X_LPARAM(lParam)
'iNewY = GET_Y_LPARAM(lParam)
'arrInfo(iIndex).x = iNewX
'arrInfo(iIndex).y = iNewY
' WORKS BUT NOT THAT ACCURATE:
' METHOD #2: INCREMENT/DECREMENT DELTA
If raw.mouse.lLastX < 0 Then
arrInfo(iIndex).x = arrInfo(iIndex).x - 1
ElseIf raw.mouse.lLastX > 0 Then
arrInfo(iIndex).x = arrInfo(iIndex).x + 1
End If
If raw.mouse.lLastY < 0 Then
arrInfo(iIndex).y = arrInfo(iIndex).y - 1
ElseIf raw.mouse.lLastY > 0 Then
arrInfo(iIndex).y = arrInfo(iIndex).y + 1
End If
' =============================================================================
' left button = 1 when down, 2 when released
If ((raw.mouse.usButtonFlags And 1) = 1) Then
arrInfo(iIndex).LeftDown = TRUE
ElseIf ((raw.mouse.usButtonFlags And 2) = 2) Then
arrInfo(iIndex).LeftDown = FALSE
End If
' =============================================================================
' middle button = 16 when down, 32 when released
If ((raw.mouse.usButtonFlags And 16) = 16) Then
arrInfo(iIndex).MiddleDown = TRUE
ElseIf ((raw.mouse.usButtonFlags And 32) = 32) Then
arrInfo(iIndex).MiddleDown = FALSE
End If
' =============================================================================
' right button = 4 when down, 8 when released
If ((raw.mouse.usButtonFlags And 4) = 4) Then
arrInfo(iIndex).RightDown = TRUE
ElseIf ((raw.mouse.usButtonFlags And 8) = 8) Then
arrInfo(iIndex).RightDown = FALSE
End If
' =============================================================================
' scroll wheel = ???
'Hex$(raw.mouse.usButtonFlags)
'arrInfo(iIndex).wheel = ???
End If
End If
' ================================================================================================================================================================
' BEGIN DRAW SCREEN
' ================================================================================================================================================================
ClearText
WriteText 1, 1, "1. PLUG 1-8 MICE INTO THE COMPUTER"
WriteText 2, 1, "2. USE MICE TO POSITION LETTERS ON SCREEN"
WriteText 3, 1, "3. PRESS <ESC> TO QUIT"
WriteText 4, 1, "--------------------------------------------------------------------------------"
WriteText 5, 1, "# X Y Wheel LeftDown MiddleDown RightDown LeftCount MiddleCount RightCount "
WriteText 6, 1, "--------------------------------------------------------------------------------"
' NOTE: LEAVE THE NEXT 8 LINES FREE (ROWS 8-15)
' TO DISPLAY TEST VALUES FOR UPTO 8 MICE
' DRAW BORDER AROUND PLAYING FIELD
DrawTextLine cMinX - 1, cMinY - 1, cMinX - 1, cMaxY + 1, "#"
DrawTextLine cMinX - 1, cMinY - 1, cMaxX + 1, cMinY - 1, "#"
DrawTextLine cMaxX + 1, cMaxY + 1, cMaxX + 1, cMinY - 1, "#"
DrawTextLine cMaxX + 1, cMaxY + 1, cMinX - 1, cMaxY + 1, "#"
' GET INPUT AND MOVE PLAYERS
iRowOffset = 0
For iIndex = LBound(arrInfo) To UBound(arrInfo)
' CHECK BOUNDARIES
If arrInfo(iIndex).x < cMinX Then arrInfo(iIndex).x = cMinX
If arrInfo(iIndex).x > cMaxX Then arrInfo(iIndex).x = cMaxX
If arrInfo(iIndex).y < cMinY Then arrInfo(iIndex).y = cMinY
If arrInfo(iIndex).y > cMaxY Then arrInfo(iIndex).y = cMaxY
' PLOT CURSOR
WriteText arrInfo(iIndex).y, arrInfo(iIndex).x, arrInfo(iIndex).c
' DISPLAY VARIABLES
iLen = 3: sCount = Left$(LTrim$(RTrim$(Str$(iRowOffset + 1))) + String$(iLen, " "), iLen)
iLen = 3: sX = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).x))) + String$(iLen, " "), iLen)
iLen = 3: sY = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).y))) + String$(iLen, " "), iLen)
iLen = 6: sWheel = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).wheel))) + String$(iLen, " "), iLen)
iLen = 9: sLeftDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).LeftDown))) + String$(iLen, " "), iLen)
iLen = 11: sMiddleDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).MiddleDown))) + String$(iLen, " "), iLen)
iLen = 10: sRightDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).RightDown))) + String$(iLen, " "), iLen)
iLen = 10: sLeftCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).LeftCount))) + String$(iLen, " "), iLen)
iLen = 12: sMiddleCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).MiddleCount))) + String$(iLen, " "), iLen)
iLen = 11: sRightCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).RightCount))) + String$(iLen, " "), iLen)
'sNext = sCount + sX + sY + sWheel + sLeftDown + sMiddleDown + sRightDown + sLeftCount + sMiddleCount + sRightCount
WriteText 6 + iRowOffset, 1, sCount + sX + sY + sWheel + sLeftDown + sMiddleDown + sRightDown + sLeftCount + sMiddleCount + sRightCount
iRowOffset = iRowOffset + 1
Next iIndex
' UPDATE mousemessage WITH PLAYING FIELD
mousemessage = ScreenToString$
InvalidateRect hwnd, 0, -1
SendMessage hwnd, WM_PAINT, 0, 0
MainWndProc = 0
' ================================================================================================================================================================
' END DRAW SCREEN
' ================================================================================================================================================================
END IF ' temporarily disable mouse
ElseIf raw.header.dwType = RIM_TYPEHID Then
' DO NOTHING
ElseIf raw.header.dwType = RIM_TYPEKEYBOARD Then
' ****************************************************************************************************************************************************************
' BEGIN PROCESS KEYBOARD INPUT HERE
' ****************************************************************************************************************************************************************
' this isn't yet 100% converted from PowerBASIC
' we can probably dedupe some of the variables
' that are already defined for the mouse code
'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 = ""
sBuffer = sBuffer + "RawInput.Header.hDevice = " + _Trim$(Str$(raw.header.hDevice, 8)) + vbCrLf ' Show handle
sBuffer = sBuffer + "RawInput.Header.dwType = " + "RIM_TYPEKEYBOARD" + vbCrLf ' raw.header.dwType
sBuffer = sBuffer + "RawInput.data.Keyboard.vKey = " + _Trim$(Str$(raw.data.Keyboard.vKey)) + vbCrLf
sBuffer = sBuffer + "Character = " + chr$(34) + CHR$(raw.data.Keyboard.vKey) + chr$(34) + vbCrLf ' Show char
ScanCode = MapVirtualKey(raw.data.Keyboard.vKey, 0) ' Create a scan code from vKey to get GetKeyNameText
SELECT CASE raw.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 = " + chr$(34) + zKeyName + vbCrLf
sBuffer = sBuffer + "RawInput.data.Keyboard.Message = " + _Trim$(Str$(raw.data.Keyboard.Message, 8)) + vbCrLf ' Show message
SELECT CASE raw.data.Keyboard.Message
CASE WM_KEYDOWN:
sBuffer = sBuffer + "WM_KEYDOWN" + vbCrLf
CASE WM_KEYUP:
sBuffer = sBuffer + "WM_KEYUP" + vbCrLf
CASE WM_SYSKEYDOWN:
sBuffer = sBuffer + "WM_SYSKEYDOWN" + vbCrLf
CASE WM_SYSKEYDOWN:
sBuffer = sBuffer + "WM_SYSKEYDOWN" + vbCrLf
END SELECT
sBuffer = sBuffer + "RawInput.Keyboard.MakeCode = " + _Trim$(Str$(raw.data.Keyboard.MakeCode, 8) + vbCrLf ' Show make code
sBuffer = sBuffer + "RawInput.data.Keyboard.ExtraInformation = " + _Trim$(Str$(raw.data.Keyboard.ExtraInformation, 8) + vbCrLf ' Show extra info
IF (raw.data.Keyboard.Flags AND RI_KEY_BREAK) THEN ' Show flags
sBuffer = sBuffer + "Flag RI_KEY_BREAK" + vbCrLf
ELSE
sBuffer = sBuffer + "Flag RI_KEY_MAKE" + vbCrLf
END IF
IF (raw.data.Keyboard.Flags AND RI_KEY_E0) THEN
sBuffer = sBuffer + "Flag RI_KEY_E0" + vbCrLf
END IF
IF (raw.data.Keyboard.Flags AND RI_KEY_E1) THEN
sBuffer = sBuffer + "Flag RI_KEY_E1" + vbCrLf
END IF
IF (raw.data.Keyboard.Flags AND RI_KEY_TERMSRV_SET_LED) THEN
sBuffer = sBuffer + "Flag RI_KEY_TERMSRV_SET_LED" + vbCrLf
END IF
IF (raw.data.Keyboard.Flags AND RI_KEY_TERMSRV_SHADOW) THEN
sBuffer = sBuffer + "Flag RI_KEY_TERMSRV_SHADOW" + vbCrLf
END IF
' ================================================================================================================================================================
' BEGIN DRAW SCREEN
' ================================================================================================================================================================
ClearText
WriteText 1, 1, sBuffer
' UPDATE mousemessage WITH PLAYING FIELD
mousemessage = ScreenToString$
InvalidateRect hwnd, 0, -1
SendMessage hwnd, WM_PAINT, 0, 0
MainWndProc = 0
' ================================================================================================================================================================
' END DRAW SCREEN
' ================================================================================================================================================================
' ****************************************************************************************************************************************************************
' END PROCESS KEYBOARD INPUT HERE
' ****************************************************************************************************************************************************************
End If
' FINISHUP WM_INPUT
MemFree lpb
MainWndProc = 0
Exit Function
Case WM_MOUSEMOVE
' SAVE RANGE OF MOUSE COORDINATES
If GET_X_LPARAM(lParam) < iMinX Then iMinX = GET_X_LPARAM(lParam)
If GET_X_LPARAM(lParam) > iMaxX Then iMaxX = GET_X_LPARAM(lParam)
If GET_Y_LPARAM(lParam) < iMinY Then iMinY = GET_Y_LPARAM(lParam)
If GET_Y_LPARAM(lParam) > iMaxY Then iMaxY = GET_Y_LPARAM(lParam)
' IDENTIFY WHICH MOUSE IT IS
strNextID = _Trim$(Str$(raw.header.hDevice))
iIndex = GetMouseIndex%(strNextID)
If iIndex >= LBound(arrInfo) Then
If iIndex <= UBound(arrInfo) Then
' =============================================================================
' UPDATE ABSOLUTE POSITION
' DOESN'T WORK, MOVES ALL OVER THE PLACE:
'' METHOD #1: SCALE MOUSE POSITION TO 80X25 POSITION
''iNewX = ( (GET_X_LPARAM(lParam) + 1) * 80) \ 1520
'iNewX = ( (GET_X_LPARAM(lParam) + 1) * 80) \ (iMaxX+1)
''iNewY = ( (GET_Y_LPARAM(lParam) + 1) * 25) \ 782
'iNewY = ( (GET_Y_LPARAM(lParam) + 1) * 25) \ (iMaxY+1)
'arrInfo(iIndex).x = iNewX
'arrInfo(iIndex).y = iNewY
End If
End If
InvalidateRect hwnd, 0, -1
SendMessage hwnd, WM_PAINT, 0, 0
MainWndProc = 0
Exit Function
Case WM_PAINT
'Q: HOW DO WE GET THIS TO WORK WITH REGULAR QB64 WINDOW?
'hdc = BeginPaint(_WindowHandle, Offset(ps))
hdc = BeginPaint(hwnd, Offset(ps))
'Q: HOW DO WE GET THIS TO WORK WITH REGULAR QB64 WINDOW?
GetClientRect hwnd, Offset(rc)
'GetClientRect _WindowHandle, Offset(rc)
DrawText hdc, Offset(mousemessage), Len(mousemessage), Offset(rc), DT_CENTER
OffsetRect Offset(rc), 0, 200
EndPaint hwnd, Offset(ps)
'EndPaint _WindowHandle, Offset(ps)
MainWndProc = 0
Exit Function
' ****************************************************************************************************************************************************************
' BEGIN EVENTS FOR PART 2
' ****************************************************************************************************************************************************************
' this isn't yet 100% converted from PowerBASIC
' we can probably dedupe some of the variables
' that are already defined for the mouse code
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_CHAR
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 EVENTS FOR PART 2
' ****************************************************************************************************************************************************************
Case Else
MainWndProc = DefWindowProc(hwnd, nMsg, wParam, lParam)
'MainWndProc = DefWindowProc(_WindowHandle, nMsg, wParam, lParam)
End Select
End Function ' MainWndProc
' /////////////////////////////////////////////////////////////////////////////
' Initializes raw input stuff
Sub InitRawInput ()
Dim As RAWINPUTDEVICE Rid(0 To 49)
Dim As Unsigned Long nDevices
Dim As RAWINPUTDEVICELIST RawInputDeviceList
Dim As MEM pRawInputDeviceList
ReDim As RAWINPUTDEVICELIST rawdevs(-1)
Dim As Unsigned Long x
Dim strNextID As String
If GetRawInputDeviceList(0, Offset(nDevices), Len(RawInputDeviceList)) <> 0 Then
Exit Sub
End If
pRawInputDeviceList = MemNew(Len(RawInputDeviceList) * nDevices)
GetRawInputDeviceList pRawInputDeviceList.OFFSET, Offset(nDevices), Len(RawInputDeviceList)
' This small block of commented code proves that we've got the device list
ReDim As RAWINPUTDEVICELIST rawdevs(0 To nDevices - 1)
MemGet pRawInputDeviceList, pRawInputDeviceList.OFFSET, rawdevs()
' GET MOUSE INFO
iMouseCount = 0
rawinputdevices = "Number of raw input devices:" + Str$(nDevices) + Chr$(13)
For x = 0 To UBound(rawdevs)
rawinputdevices = rawinputdevices + Str$(rawdevs(x).hDevice) + ":" + Str$(rawdevs(x).dwType) + Chr$(13)
' Is it a mouse?
If rawdevs(x).dwType = 0 Then
iMouseCount = iMouseCount + 1
strNextID = _Trim$(Str$(rawdevs(x).hDevice))
arrInfo(iMouseCount - 1).ID = strNextID
End If
Next x
rawinputdevices = rawinputdevices + Chr$(0)
MemFree pRawInputDeviceList
Rid(0).usUsagePage = &H01
Rid(0).usUsage = &H02
Rid(0).dwFlags = 0
Rid(0).hwndTarget = 0
'Rid(0).hwndTarget = _WindowHandle
If RegisterRawInputDevices(Offset(Rid()), 1, Len(Rid(0))) = 0 Then
mousemessage = "RawInput init failed" + Chr$(0)
End If
End Sub ' InitRawInput
' /////////////////////////////////////////////////////////////////////////////
' DON'T KNOW WHAT THIS DOES
FUNCTION PBMAIN()
LOCAL hIconBig AS _UNSIGNED LONG
LOCAL hIconSmall AS _UNSIGNED LONG
' Dialog Boxes 03/12/2023
' https://learn.microsoft.com/en-us/windows/win32/api/_dlgbox/
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 ' PBMAIN
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END RAW INPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN MOUSE TEST FUNCTIONS #1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Initialize mouse test stuff
'TODO: SAVE_MOUSE_INFO
Sub InitMouseTest
Dim iIndex As Integer
Dim iLoop As Integer
' FOR NOW ONLY SUPPORT UPTO 8 MICE
If (iMouseCount > 8) Then iMouseCount = 8
' INITIALIZE CURSORS, MOUSE STATE, ETC.
Restore CData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrInfo(iIndex).c
arrInfo(iIndex).LeftDown = FALSE
arrInfo(iIndex).MiddleDown = FALSE
arrInfo(iIndex).RightDown = FALSE
arrInfo(iIndex).LeftCount = 0
arrInfo(iIndex).MiddleCount = 0
arrInfo(iIndex).RightCount = 0
Next iLoop
' INITIALIZE X COORDINATES
Restore XData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrInfo(iIndex).x
Next iLoop
' INITIALIZE Y COORDINATES
Restore YData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrInfo(iIndex).y
Next iLoop
' INITIALIZE SCROLL WHEEL
Restore WData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrInfo(iIndex).wheel
Next iLoop
End Sub ' InitMouseTest
' /////////////////////////////////////////////////////////////////////////////
' Finds position in array arrInfo where .ID = MouseID
Function GetMouseIndex% (MouseID As String)
Dim iLoop As Integer
Dim iIndex%
iIndex% = LBound(arrInfo) - 1
For iLoop = LBound(arrInfo) To UBound(arrInfo)
If arrInfo(iLoop).ID = MouseID Then
iIndex% = iLoop
Exit For
Else
' not it
End If
Next iLoop
GetMouseIndex% = iIndex%
End Function ' GetMouseIndex%
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END MOUSE TEST FUNCTIONS #1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN TEST OUTPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Clears global array arrScreen
Sub ClearText
Dim iColNum As Integer
Dim iRowNum As Integer
For iColNum = LBound(arrScreen, 1) To UBound(arrScreen, 1)
For iRowNum = LBound(arrScreen, 2) To UBound(arrScreen, 2)
arrScreen(iColNum, iRowNum) = " "
Next iRowNum
Next iColNum
End Sub ' ClearText
' /////////////////////////////////////////////////////////////////////////////
' Plots string MyString to position (iX, iY) in global array arrScreen.
Sub WriteText (iRow As Integer, iColumn As Integer, MyString As String)
Dim iPos As Integer
Dim iLoop As Integer
If iColumn > 0 And iColumn < 81 Then
If iRow > 0 And iRow < 26 Then
For iLoop = 1 To Len(MyString)
iPos = iColumn + (iLoop - 1)
If iPos < 81 Then
arrScreen(iPos, iRow) = Mid$(MyString, iLoop, 1)
Else
Exit For
End If
Next iLoop
End If
End If
End Sub ' WriteText
' /////////////////////////////////////////////////////////////////////////////
' Converts global array arrScreen to a string.
Function ScreenToString$
Dim sResult As String
Dim iColNum As Integer
Dim iRowNum As Integer
sResult = ""
For iRowNum = LBound(arrScreen, 2) To UBound(arrScreen, 2)
For iColNum = LBound(arrScreen, 1) To UBound(arrScreen, 1)
sResult = sResult + arrScreen(iColNum, iRowNum)
Next iColNum
sResult = sResult + Chr$(13)
Next iRowNum
ScreenToString$ = sResult
End Function ' ScreenToString$
' /////////////////////////////////////////////////////////////////////////////
' based on code from:
' Qbasic Programs - Download free bas source code
' http://www.thedubber.altervista.org/qbsrc.htm
Sub DrawTextLine (y%, x%, y2%, x2%, c$)
Dim i%
Dim steep%
Dim e%
Dim sx%
Dim dx%
Dim sy%
Dim dy%
i% = 0: steep% = 0: e% = 0
If (x2% - x%) > 0 Then sx% = 1: Else sx% = -1
dx% = Abs(x2% - x%)
If (y2% - y%) > 0 Then sy% = 1: Else sy% = -1
dy% = Abs(y2% - y%)
If (dy% > dx%) Then
steep% = 1
Swap x%, y%
Swap dx%, dy%
Swap sx%, sy%
End If
e% = 2 * dy% - dx%
For i% = 0 To dx% - 1
If steep% = 1 Then
''PSET (y%, x%), c%:
'Locate y%, x% : Print c$;
WriteText y%, x%, c$
Else
''PSET (x%, y%), c%
'Locate x%, y% : Print c$;
WriteText x%, y%, c$
End If
While e% >= 0
y% = y% + sy%: e% = e% - 2 * dx%
Wend
x% = x% + sx%: e% = e% + 2 * dy%
Next
''PSET (x2%, y2%), c%
'Locate x2%, y2% : Print c$;
WriteText x2%, y2%, c$
End Sub ' DrawTextLine
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END TEST OUTPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN handle MEM for any type
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' QB64 GPT Just Rewrote My Code
' https://qb64phoenix.com/forum/showthread.php?tid=2728
' And the revisions QB64 GPT made (after minor changes and me asking it to redo some syntax errors):
' It separated out a lot of processing out to separate subs.
' It is quite impressive how little input I had to give it to fix its mistakes.
' The code actually worked just as well as it did before the changes, which blows my mind.
' It actually even listened to me when I told it that it would need to cast an OFFSET type by using VAL(STR$(var)).
' To be fair, I had to tell it "ByRef" was invalid and a couple of other things.
' I also had to declare "y" each time it was used. But the last iteration only required me to declare "y".
' I think that is a decent enough result. Too bad I can't get it to be this good every time.
' 1) This is the paid version of GPT4. I am on the plus plan, so whatever that one has.
' 2) I think I deleted the session. Sorry. I only used it for as long as I needed it.
' 3) I don't know what the hard limit is. It's in "tokens", which I have no idea how those are calculated.
' I got a pretty large source code from one output and it can take a lot of input. I would just say it can handle quite a bit.
' The GPT I used was one I trained using the Wiki, sample code, etc. At the time, it used GPT4.
' Custom GPTs now use 4o. I will probably need to republish it to take advantage of 4o for it.
' I guess training is the wrong word. A custom GPT has a "knowledge base".
' You can have a maximum of 20 files.
' It can use those files to create an answer. Even a zip folder can be used.
' It will basically only use the knowledge base when specifically asked. Otherwise, it is using whatever it already had in its model.
' As for testing code and such, you can create "actions" for your GPT that allow it to do things outside of ChatGPT, including REST API.
' So if dbox ever made a REST API for QBJS, you could definitely have it write QBJS code and then ask it to run it.
Sub anyArg (args() As _MEM)
Dim As _Unsigned Integer x, y
Dim As _Unsigned _Offset z
Dim As _Unsigned Long size, elementsize
For x = LBound(args) To UBound(args)
If _MemExists(args(x)) Then
z = 0
size = Val(Str$(args(x).SIZE))
elementsize = Val(Str$(args(x).ELEMENTSIZE))
If _ReadBit(args(x).TYPE, 7) And _ReadBit(args(x).TYPE, 13) = 0 Then
HandleNumericType args(x), size, elementsize, z
ElseIf _ReadBit(args(x).TYPE, 8) Then
HandleFloatingType args(x), size, elementsize, z
ElseIf _ReadBit(args(x).TYPE, 9) Then
HandleStringType args(x), size, elementsize
ElseIf _ReadBit(args(x).TYPE, 13) And _ReadBit(args(x).TYPE, 7) Then
HandleOffsetType args(x), size, elementsize, z
ElseIf args(x).TYPE = 0 And args(x).SIZE > 0 Then
HandleSoundType args(x)
ElseIf _ReadBit(args(x).TYPE, 14) Then
Print args(x).SIZE, "MEM"
' TODO: Handle other types if necessary
End If
If _ReadBit(args(x).TYPE, 11) Then
Screen args(x).IMAGE
End If
End If
Next
End Sub ' anyArg
' Subroutines for handling specific types
Sub HandleNumericType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)
If _ReadBit(arg.TYPE, 10) Then
If _ReadBit(arg.TYPE, 16) Then
Select Case elementsize
Case 1
Dim As _Unsigned _Byte unsignedbytearray(1 To (size / elementsize))
ProcessArray_UByte unsignedbytearray(), arg, size, elementsize, z, "UBYTE ARRAY"
Case 2
Dim As _Unsigned Integer unsignedintarray(1 To (size / elementsize))
ProcessArray_UInteger unsignedintarray(), arg, size, elementsize, z, "USHORT ARRAY"
Case 4
Dim As _Unsigned Long unsignedlongarray(1 To (size / elementsize))
ProcessArray_ULong unsignedlongarray(), arg, size, elementsize, z, "ULONG ARRAY"
Case 8
Dim As _Unsigned _Integer64 unsignedint64array(1 To (size / elementsize))
ProcessArray_UInt64 unsignedint64array(), arg, size, elementsize, z, "UINT64 ARRAY"
End Select
Else
PrintSingleValue arg, size, elementsize
End If
Else
If _ReadBit(arg.TYPE, 16) Then
Select Case elementsize
Case 1
Dim As _Byte bytearray(1 To (size / elementsize))
ProcessArray_Byte bytearray(), arg, size, elementsize, z, "BYTE ARRAY"
Case 2
Dim As Integer intarray(1 To (size / elementsize))
ProcessArray_Integer intarray(), arg, size, elementsize, z, "SHORT ARRAY"
Case 4
Dim As Long longarray(1 To (size / elementsize))
ProcessArray_Long longarray(), arg, size, elementsize, z, "LONG ARRAY"
Case 8
Dim As _Integer64 int64array(1 To (size / elementsize))
ProcessArray_Int64 int64array(), arg, size, elementsize, z, "INT64 ARRAY"
End Select
Else
PrintSingleValue arg, size, elementsize
End If
End If
End Sub ' HandleNumericType
Sub HandleFloatingType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)
If _ReadBit(arg.TYPE, 16) Then
Select Case elementsize
Case 4
Dim As Single singlearray(1 To (size / elementsize))
ProcessArray_Single singlearray(), arg, size, elementsize, z, "SINGLE ARRAY"
Case 8
Dim As Double doublearray(1 To (size / elementsize))
ProcessArray_Double doublearray(), arg, size, elementsize, z, "DOUBLE ARRAY"
Case 32
Dim As _Float floatarray(1 To (size / elementsize))
ProcessArray_Float floatarray(), arg, size, elementsize, z, "FLOAT ARRAY"
End Select
Else
Select Case size
Case 4
Print _MemGet(arg, arg.OFFSET, Single), "SINGLE"
Case 8
Print _MemGet(arg, arg.OFFSET, Double), "DOUBLE"
Case 32
Print _MemGet(arg, arg.OFFSET, _Float), "FLOAT"
End Select
End If
End Sub ' HandleFloatingType
Sub HandleStringType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long)
If _ReadBit(arg.TYPE, 16) Then
Dim As String stringarray(1 To (size / elementsize))
Dim As _Unsigned Long y
For y = LBound(stringarray) To UBound(stringarray)
stringarray(y) = Space$(elementsize)
_MemGet arg, (arg.OFFSET) + (y * elementsize - elementsize), stringarray(y)
Print stringarray(y), "STRING ARRAY"
Next
Else
Dim As String stringtest: stringtest = Space$(elementsize)
_MemGet arg, arg.OFFSET, stringtest
Print stringtest
End If
End Sub ' HandleStringType
Sub HandleOffsetType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)
If _ReadBit(arg.TYPE, 10) Then
If _ReadBit(arg.TYPE, 16) Then
Dim As _Unsigned _Offset unsignedoffsetarray(1 To (size / elementsize))
ProcessArray_UOffset unsignedoffsetarray(), arg, size, elementsize, z, "ULONG_PTR ARRAY"
Else
Print _MemGet(arg, arg.OFFSET, _Unsigned _Offset), "ULONG_PTR"
End If
Else
If _ReadBit(arg.TYPE, 16) Then
Dim As _Offset offsetarray(1 To (size / elementsize))
ProcessArray_Offset offsetarray(), arg, size, elementsize, z, "LONG_PTR ARRAY"
Else
Print _MemGet(arg, arg.OFFSET, _Offset), "LONG_PTR"
End If
End If
End Sub ' HandleOffsetType
Sub HandleSoundType (arg As _MEM)
If Not _SndPlaying(arg.SOUND) Then
_SndPlay (arg.SOUND)
End If
Print "SOUND", arg.SIZE, arg.ELEMENTSIZE
End Sub ' HandleSoundType
' Subroutines for processing arrays
Sub ProcessArray_UByte (unsignedbytearray() As _Unsigned _Byte, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(unsignedbytearray) To UBound(unsignedbytearray)
_MemGet arg, arg.OFFSET + z, unsignedbytearray(y)
z = z + elementsize
Print unsignedbytearray(y), typeName
Next
End Sub ' ProcessArray_UByte
Sub ProcessArray_UInteger (unsignedintarray() As _Unsigned Integer, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(unsignedintarray) To UBound(unsignedintarray)
_MemGet arg, arg.OFFSET + z, unsignedintarray(y)
z = z + elementsize
Print unsignedintarray(y), typeName
Next
End Sub ' ProcessArray_UInteger
Sub ProcessArray_ULong (unsignedlongarray() As _Unsigned Long, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(unsignedlongarray) To UBound(unsignedlongarray)
_MemGet arg, arg.OFFSET + z, unsignedlongarray(y)
z = z + elementsize
Print unsignedlongarray(y), typeName
Next
End Sub ' ProcessArray_ULong
Sub ProcessArray_UInt64 (unsignedint64array() As _Unsigned _Integer64, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(unsignedint64array) To UBound(unsignedint64array)
_MemGet arg, arg.OFFSET + z, unsignedint64array(y)
z = z + elementsize
Print unsignedint64array(y), typeName
Next
End Sub ' ProcessArray_UInt64
Sub ProcessArray_Byte (bytearray() As _Byte, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(bytearray) To UBound(bytearray)
_MemGet arg, arg.OFFSET + z, bytearray(y)
z = z + elementsize
Print bytearray(y), typeName
Next
End Sub ' ProcessArray_Byte
Sub ProcessArray_Integer (intarray() As Integer, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(intarray) To UBound(intarray)
_MemGet arg, arg.OFFSET + z, intarray(y)
z = z + elementsize
Print intarray(y), typeName
Next
End Sub ' ProcessArray_Integer
Sub ProcessArray_Long (longarray() As Long, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(longarray) To UBound(longarray)
_MemGet arg, arg.OFFSET + z, longarray(y)
z = z + elementsize
Print longarray(y), typeName
Next
End Sub ' ProcessArray_Long
Sub ProcessArray_Int64 (int64array() As _Integer64, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(int64array) To UBound(int64array)
_MemGet arg, arg.OFFSET + z, int64array(y)
z = z + elementsize
Print int64array(y), typeName
Next
End Sub ' ProcessArray_Int64
Sub ProcessArray_Single (singlearray() As Single, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(singlearray) To UBound(singlearray)
_MemGet arg, arg.OFFSET + z, singlearray(y)
z = z + elementsize
Print singlearray(y), typeName
Next
End Sub ' ProcessArray_Single
Sub ProcessArray_Double (doublearray() As Double, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(doublearray) To UBound(doublearray)
_MemGet arg, arg.OFFSET + z, doublearray(y)
z = z + elementsize
Print doublearray(y), typeName
Next
End Sub ' ProcessArray_Double
Sub ProcessArray_Float (floatarray() As _Float, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(floatarray) To UBound(floatarray)
_MemGet arg, arg.OFFSET + z, floatarray(y)
z = z + elementsize / 2
Print floatarray(y), typeName
Next
End Sub ' ProcessArray_Float
Sub ProcessArray_UOffset (unsignedoffsetarray() As _Unsigned _Offset, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(unsignedoffsetarray) To UBound(unsignedoffsetarray)
_MemGet arg, arg.OFFSET + z, unsignedoffsetarray(y)
z = z + elementsize
Print unsignedoffsetarray(y), typeName
Next
End Sub ' ProcessArray_UOffset
Sub ProcessArray_Offset (offsetarray() As _Offset, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(offsetarray) To UBound(offsetarray)
_MemGet arg, arg.OFFSET + z, offsetarray(y)
z = z + elementsize
Print offsetarray(y), typeName
Next
End Sub ' ProcessArray_Offset
Sub PrintSingleValue (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long)
Select Case size
Case 1
Print _MemGet(arg, arg.OFFSET, _Byte), "BYTE"
Case 2
Print _MemGet(arg, arg.OFFSET, Integer), "SHORT"
Case 4
Print _MemGet(arg, arg.OFFSET, Long), "LONG"
Case 8
Print _MemGet(arg, arg.OFFSET, _Integer64), "INT64"
End Select
End Sub ' PrintSingleValue
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END handle MEM for any type
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Posts: 705
Threads: 99
Joined: Apr 2022
Reputation:
13
(06-05-2024, 10:16 PM)DSMan195276 Wrote: The union usage in TYPEs like `RID_DEVICE_INFO` and `RAWMOUSE` are not correct, there's no `_OFFSET` involved. The union represents memory in the struct itself, not a pointer to memory elsewhere. You should probably just declare it as a fixed STRING member (`dummy AS STRING * 250`) where the length of the string the size of the union. Then you can use `_MEM()` on that member and use `_MEMGET` to copy that data at the location of the STRING into a variable of the proper type.
You're correct that `hDevice` in `RAWINPUTDEVICeLIST` should be an `_OFFSET` to correspond with the `HANDLE` type. I would refer to this page on the C types and what they correspond too.
The `RAWHID` and `bRawData` is ok, but just recognize the `TYPE` is not the real size of the data. When you use it you'll have to use `_MEMNEW()` to actually create it, and then you can `_MEMGET` from that memory to read the `RAWHID` header and then the `bRawData` itself (which will go past the end of the `RAWHID` TYPE).
`RAWMOUSE` probably also has padding between the `usFlags` and the union. The union starts with a `ULONG`, which requires 4 byte alignment, but the `USHORT` leaves the struct on a 2-byte boundary, so you need 2 bytes of padding to get proper alignment for the `ULONG`. `ulRawButtons` probably also requires padding before it.
The Microsoft documentation on the RAWINPUT type is:
Code: (Select All) RAWINPUT structure (winuser.h)
https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinput
typedef struct tagRAWINPUT {
RAWINPUTHEADER header;
union {
RAWMOUSE mouse;
RAWKEYBOARD keyboard;
RAWHID hid;
} data;
} RAWINPUT, *PRAWINPUT, *LPRAWINPUT;
For making the mouse work, Spriggsy's defined the above type as:
Code: (Select All) Type RAWINPUT
As RAWINPUTHEADER header
As RAWMOUSE mouse
End Type
and it works.
I don't see any of the UNIONed type being hidden in _OFFSET, or any "padding" or MEMGET or any of that stuff happening to access the members of that type.
I don't see any of that funny stuff, but it still works. How? Why?
Code: (Select All) Option Explicit
_Title "multimouse"
$NoPrefix
$Console:Only
Console Off
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CONSTANTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Const FALSE = 0
Const TRUE = Not FALSE
Const CS_HREDRAW = &H0002
Const CS_VREDRAW = &H0001
Const IDI_APPLICATION = 32512
Const IDC_ARROW = 32512
Const COLOR_WINDOW = 5
Const WS_OVERLAPPED = &H00000000
Const WS_CAPTION = &H00C00000
Const WS_SYSMENU = &H00080000
Const WS_THICKFRAME = &H00040000
Const WS_MINIMIZEBOX = &H00020000
Const WS_MAXIMIZEBOX = &H00010000
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Const CW_USEDEFAULT = &H80000000
Const WM_DESTROY = &H0002
Const WM_INPUT = &H00FF
Const SW_SHOW = 5
Const RID_INPUT = &H10000003
Const RIM_TYPEMOUSE = 0
Const MOUSE_MOVE_RELATIVE = &H00
Const MOUSE_MOVE_ABSOLUTE = &H01
Const MOUSE_VIRTUAL_DESKTOP = &H02
Const MOUSE_ATTRIBUTES_CHANGED = &H04
Const MOUSE_MOVE_NOCOALESCE = &H08
Const WM_MOUSEMOVE = &H0200
Const WM_PAINT = &H000F
Const DT_CENTER = &H00000001
' MIN/MAX VALUES FOR MOUSE TEST
Const cMinX = 2
Const cMaxX = 79
Const cMinY = 16
Const cMaxY = 24
Const cMinWheel = 0
Const cMaxWheel = 255
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END CONSTANTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN UDTs
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Type RAWINPUTDEVICE
As Unsigned Integer usUsagePage, usUsage
As Unsigned Long dwFlags
As Offset hwndTarget
End Type
Type RAWINPUTDEVICELIST
As Offset hDevice
As Unsigned Long dwType
$If 64BIT Then
As String * 4 alignment
$End If
End Type
Type POINT
As Long x, y
End Type
Type MSG
As Offset hwnd
As Unsigned Long message
As Unsigned Offset wParam
As Offset lParam
As Long time
As POINT pt
As Long lPrivate
End Type
Type WNDCLASSEX
As Unsigned Long cbSize, style
As Offset lpfnWndProc
As Long cbClsExtra, cbWndExtra
As Offset hInstance, hIcon, hCursor, hbrBackground, lpszMenuName, lpszClassName, hIconSm
End Type
Type RECT
As Long left, top, right, bottom
End Type
Type PAINTSTRUCT
As Offset hdc
As Long fErase
$If 64BIT Then
As String * 4 alignment
$End If
As RECT rcPaint
As Long fRestore, fIncUpdate
As String * 32 rgbReserved
End Type
Type RAWINPUTHEADER
As Unsigned Long dwType, dwSize
As Offset hDevice
As Unsigned Offset wParam
End Type
Type RAWMOUSE
As Unsigned Integer usFlags
$If 64BIT Then
As String * 2 alignment
$End If
'As Unsigned Long ulButtons 'commented out because I'm creating this value using MAKELONG
As Unsigned Integer usButtonFlags, usButtonData
As Unsigned Long ulRawButtons
As Long lLastX, lLastY
As Unsigned Long ulExtraInformation
End Type
Type RAWINPUT
As RAWINPUTHEADER header
As RAWMOUSE mouse
End Type
' UDT TO HOLD THE INFO FOR EACH MOUSE
Type InfoType
ID As String ' mouse device ID
c As String ' cursor character
x As Integer ' screen x position
y As Integer ' screen y position
wheel As Integer ' mouse wheel value
LeftDown As Integer ' tracks left mouse button state, TRUE=down
MiddleDown As Integer ' tracks middle mouse button state, TRUE=down
RightDown As Integer ' tracks right mouse button state, TRUE=down
LeftCount As Integer ' counts left clicks
MiddleCount As Integer ' counts middle clicks
RightCount As Integer ' counts right clicks
End Type ' InfoType
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END UDTs
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN API DECLARATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Declare CustomType Library
Function GetRawInputDeviceList~& (ByVal pRawInputDeviceList As Offset, Byval puiNumDevices As Offset, Byval cbSize As Unsigned Long)
Sub GetRawInputDeviceList (ByVal pRawInputDeviceList As Offset, Byval puiNumDevices As Offset, Byval cbSize As Unsigned Long)
Function RegisterRawInputDevices& (ByVal pRawInputDevices As Offset, Byval uiNumDevices As Unsigned Long, Byval cbSize As Unsigned Long)
Function GetModuleHandle%& (ByVal lpModulename As Offset)
Function LoadIcon%& (ByVal hInstance As Offset, Byval lpIconName As Offset)
Function LoadCursor%& (ByVal hInstance As Offset, Byval lpCursorName As Offset)
Function RegisterClassEx~% (ByVal wndclassex As Offset)
Function CreateWindowEx%& (ByVal dwExStyle As Unsigned Long, Byval lpClassName As Offset, Byval lpWindowName As Offset, Byval dwStyle As Unsigned Long, Byval x As Long, Byval y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As Offset, Byval hMenu As Offset, Byval hInstance As Offset, Byval lpParam As Offset)
Sub ShowWindow (ByVal hWnd As Offset, Byval nCmdShow As Long)
Sub UpdateWindow (ByVal hWnd As Offset)
Function GetMessage& (ByVal lpMsg As Offset, Byval hWnd As Offset, Byval wMsgFilterMin As Unsigned Long, Byval wMsgFilterMax As Unsigned Long)
Sub TranslateMessage (ByVal lpMsg As Offset)
Sub DispatchMessage (ByVal lpMsg As Offset)
Sub PostQuitMessage (ByVal nExitCode As Long)
Function DefWindowProc%& (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
Sub GetRawInputData (ByVal hRawInput As Offset, Byval uiCommand As Unsigned Long, Byval pData As Offset, Byval pcbSize As Offset, Byval cbSizeHeader As Unsigned Long)
Function GetRawInputData~& (ByVal hRawInput As Offset, Byval uiCommand As Unsigned Long, Byval pData As Offset, Byval pcbSize As Offset, Byval cbSizeHeader As Unsigned Long)
Sub InvalidateRect (ByVal hWnd As Offset, Byval lpRect As Offset, Byval bErase As Long)
Sub SendMessage (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
Function BeginPaint%& (ByVal hWnd As Offset, Byval lpPaint As Offset)
Sub GetClientRect (ByVal hWnd As Offset, Byval lpRect As Offset)
Sub DrawText (ByVal hdc As Offset, Byval lpchText As Offset, Byval cchText As Long, Byval lprc As Offset, Byval format As Unsigned Long)
Sub OffsetRect (ByVal lprc As Offset, Byval dx As Long, Byval dy As Long)
Sub EndPaint (ByVal hWnd As Offset, Byval lpPaint As Offset)
End Declare
' Header file "makeint.h" must be in same folder as this program.
Declare CustomType Library ".\makeint"
Function MAKEINTRESOURCE%& Alias "MAKEINTRSC" (ByVal i As _Offset)
End Declare
Declare Library
Function MAKELPARAM%& (ByVal l As Integer, Byval h As Integer)
Function MAKELONG~& (ByVal l As Unsigned Integer, Byval h As Unsigned Integer)
End Declare
$If 64BIT Then
Declare Library ".\internal\c\c_compiler\x86_64-w64-mingw32\include\windowsx"
$Else
Declare Library ".\internal\c\c_compiler\i686-w64-mingw32\include\windowsx"
$End If
Function GET_Y_LPARAM& (ByVal lp As Offset)
Function GET_X_LPARAM& (ByVal lp As Offset)
End Declare
' Header file "winproc.h" must be in same folder as this program.
Declare Library ".\winproc"
Function WindowProc%& ()
End Declare
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END API DECLARATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL VARIABLES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bDebug As Integer: m_bDebug = FALSE
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
' RAW INPUT VARIABLES
Dim Shared mousemessage As String
Dim Shared rawinputdevices As String
' MOUSE TEST VARIABLES
Dim Shared arrInfo(8) As InfoType ' STORES INFO FOR EACH MOUSE
'Dim Shared arrRawMouseID(8) As Long ' device IDs for mice connected to system (guessing this would be a string, dunno)
Dim Shared iMouseCount As Integer ' # OF MICE ATTACHED
Dim Shared arrScreen(1 To 80, 1 To 25) As String ' STORES TEXT FOR SCREEN
Dim Shared iMinX As Long
Dim Shared iMaxX As Long
Dim Shared iMinY As Long
Dim Shared iMaxY As Long
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL VARIABLES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' EXECUTION STARTS HERE!
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
iMinX = 0
iMaxX = 3583
iMinY = 0
iMaxY = 8202
System Val(Str$(WinMain))
System ' return control to the operating system
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DATA
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' MOUSE CURSORS (JUST SOME LETTERS)
CData:
Data A,b,C,D,E,f,G,H
' DEFAULT/INTIAL X COORDINATE OF EACH CURSOR ON SCREEN
XData:
Data 5,15,25,35,45,55,65,75
' DEFAULT/INTIAL Y COORDINATE OF EACH CURSOR ON SCREEN
YData:
Data 17,17,19,19,21,21,23,23
' DEFAULT/INITIAL VALUE OF EACH SCROLL WHEEL
WData:
Data 224,192,160,128,96,64,32,0
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DATA
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN RAW INPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Runs first
Function WinMain~%& ()
Dim As Offset hwndMain, hInst
Dim As MSG msg
Dim As WNDCLASSEX wndclass
Dim As String szMainWndClass
Dim As String szWinTitle
Dim As Unsigned Integer reg
' =============================================================================
' SET UP WINDOW
hInst = GetModuleHandle(0)
szMainWndClass = "WinTestWin" + Chr$(0)
szWinTitle = "Hello" + Chr$(0)
wndclass.lpszClassName = Offset(szMainWndClass)
wndclass.cbSize = Len(wndclass)
wndclass.style = CS_HREDRAW Or CS_VREDRAW
wndclass.lpfnWndProc = WindowProc
wndclass.hInstance = hInst 'GetModuleHandle(0) will return the hInstance of this EXE
wndclass.hIcon = LoadIcon(0, MAKEINTRESOURCE(IDI_APPLICATION))
wndclass.hIconSm = LoadIcon(0, MAKEINTRESOURCE(IDI_APPLICATION))
wndclass.hCursor = LoadCursor(0, MAKEINTRESOURCE(IDC_ARROW))
wndclass.hbrBackground = COLOR_WINDOW + 1
reg = RegisterClassEx(Offset(wndclass)) 'I prefer to use the output of RegisterClassEx rather than the window name
hwndMain = CreateWindowEx(0, MAKELPARAM(reg, 0), Offset(szWinTitle), WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, hInst, 0)
ShowWindow hwndMain, SW_SHOW
UpdateWindow hwndMain
' =============================================================================
' INITIALIZE RAW INPUT
InitRawInput
InitMouseTest 'TODO: SAVE_MOUSE_INFO
' =============================================================================
' BEGIN MAIN LOOP
' =============================================================================
While GetMessage(Offset(msg), 0, 0, 0)
TranslateMessage Offset(msg)
DispatchMessage Offset(msg)
Wend
' =============================================================================
' END MAIN LOOP
' =============================================================================
' RETURN A VALUE
WinMain = msg.wParam
End Function ' WinMain
' /////////////////////////////////////////////////////////////////////////////
' Handles main window events
Function MainWndProc%& (hwnd As Offset, nMsg As Unsigned Long, wParam As Unsigned Offset, lParam As Offset)
Static As Offset hwndButton
Static As Long cx, cy
Dim As Offset hdc
Dim As PAINTSTRUCT ps
Dim As RECT rc
Dim As MEM lpb
Dim As Unsigned Long dwSize
Dim As RAWINPUT raw
Dim As Long tmpx, tmpy
Static As Long maxx
Dim As RAWINPUTHEADER rih
' TEMP VARIABLES FOR DISPLAYING FORMATTED VALUES TO SCREEN
Dim strNextID As String
Dim iIndex As Integer
Dim iRowOffset As Integer
Dim iLen As Integer
Dim sCount As String
Dim sX As String
Dim sY As String
Dim sWheel As String
Dim sLeftDown As String
Dim sMiddleDown As String
Dim sRightDown As String
Dim sLeftCount As String
Dim sMiddleCount As String
Dim sRightCount As String
Dim sNext As String
Dim iNewX As Integer
Dim iNewY As Integer
Dim iDX As Integer
Dim iDY As Integer
' HANDLE EVENTS
Select Case nMsg
Case WM_DESTROY
PostQuitMessage 0
MainWndProc = 0
Exit Function
Case WM_INPUT
GetRawInputData lParam, RID_INPUT, 0, Offset(dwSize), Len(rih)
lpb = MemNew(dwSize)
If lpb.SIZE = 0 Then
MainWndProc = 0
Exit Function
End If
If GetRawInputData(lParam, RID_INPUT, lpb.OFFSET, Offset(dwSize), Len(rih)) <> dwSize Then
Print "GetRawInputData doesn't return correct size!"
End If
MemGet lpb, lpb.OFFSET, raw
If raw.header.dwType = RIM_TYPEMOUSE Then
tmpx = raw.mouse.lLastX
tmpy = raw.mouse.lLastY
maxx = tmpx
' UPDATE RANGE OF MOUSE COORDINATES
If GET_X_LPARAM(lParam) < iMinX Then iMinX = GET_X_LPARAM(lParam)
If GET_X_LPARAM(lParam) > iMaxX Then iMaxX = GET_X_LPARAM(lParam)
If GET_Y_LPARAM(lParam) < iMinY Then iMinY = GET_Y_LPARAM(lParam)
If GET_Y_LPARAM(lParam) > iMaxY Then iMaxY = GET_Y_LPARAM(lParam)
' IDENTIFY WHICH MOUSE IT IS
strNextID = _Trim$(Str$(raw.header.hDevice))
iIndex = GetMouseIndex%(strNextID)
If iIndex >= LBound(arrInfo) Then
If iIndex <= UBound(arrInfo) Then
' =============================================================================
' UPDATE ABSOLUTE POSITION
' DOESN'T WORK, MOVES ALL OVER THE PLACE:
'' METHOD #1: SCALE MOUSE POSITION TO 80X25 POSITION
'iNewX = GET_X_LPARAM(lParam)
'iNewY = GET_Y_LPARAM(lParam)
'arrInfo(iIndex).x = iNewX
'arrInfo(iIndex).y = iNewY
' WORKS BUT NOT THAT ACCURATE:
' METHOD #2: INCREMENT/DECREMENT DELTA
If raw.mouse.lLastX < 0 Then
arrInfo(iIndex).x = arrInfo(iIndex).x - 1
ElseIf raw.mouse.lLastX > 0 Then
arrInfo(iIndex).x = arrInfo(iIndex).x + 1
End If
If raw.mouse.lLastY < 0 Then
arrInfo(iIndex).y = arrInfo(iIndex).y - 1
ElseIf raw.mouse.lLastY > 0 Then
arrInfo(iIndex).y = arrInfo(iIndex).y + 1
End If
' =============================================================================
' left button = 1 when down, 2 when released
If ((raw.mouse.usButtonFlags And 1) = 1) Then
arrInfo(iIndex).LeftDown = TRUE
ElseIf ((raw.mouse.usButtonFlags And 2) = 2) Then
arrInfo(iIndex).LeftDown = FALSE
End If
' =============================================================================
' middle button = 16 when down, 32 when released
If ((raw.mouse.usButtonFlags And 16) = 16) Then
arrInfo(iIndex).MiddleDown = TRUE
ElseIf ((raw.mouse.usButtonFlags And 32) = 32) Then
arrInfo(iIndex).MiddleDown = FALSE
End If
' =============================================================================
' right button = 4 when down, 8 when released
If ((raw.mouse.usButtonFlags And 4) = 4) Then
arrInfo(iIndex).RightDown = TRUE
ElseIf ((raw.mouse.usButtonFlags And 8) = 8) Then
arrInfo(iIndex).RightDown = FALSE
End If
' =============================================================================
' scroll wheel = ???
'Hex$(raw.mouse.usButtonFlags)
'arrInfo(iIndex).wheel = ???
End If
End If
' ================================================================================================================================================================
' BEGIN DRAW SCREEN
' ================================================================================================================================================================
ClearText
WriteText 1, 1, "1. PLUG 1-8 MICE INTO THE COMPUTER"
WriteText 2, 1, "2. USE MICE TO POSITION LETTERS ON SCREEN"
WriteText 3, 1, "3. PRESS <ESC> TO QUIT"
WriteText 4, 1, "--------------------------------------------------------------------------------"
WriteText 5, 1, "# X Y Wheel LeftDown MiddleDown RightDown LeftCount MiddleCount RightCount "
WriteText 6, 1, "--------------------------------------------------------------------------------"
' NOTE: LEAVE THE NEXT 8 LINES FREE (ROWS 8-15)
' TO DISPLAY TEST VALUES FOR UPTO 8 MICE
' DRAW BORDER AROUND PLAYING FIELD
DrawTextLine cMinX - 1, cMinY - 1, cMinX - 1, cMaxY + 1, "#"
DrawTextLine cMinX - 1, cMinY - 1, cMaxX + 1, cMinY - 1, "#"
DrawTextLine cMaxX + 1, cMaxY + 1, cMaxX + 1, cMinY - 1, "#"
DrawTextLine cMaxX + 1, cMaxY + 1, cMinX - 1, cMaxY + 1, "#"
' GET INPUT AND MOVE PLAYERS
iRowOffset = 0
For iIndex = LBound(arrInfo) To UBound(arrInfo)
' CHECK BOUNDARIES
If arrInfo(iIndex).x < cMinX Then arrInfo(iIndex).x = cMinX
If arrInfo(iIndex).x > cMaxX Then arrInfo(iIndex).x = cMaxX
If arrInfo(iIndex).y < cMinY Then arrInfo(iIndex).y = cMinY
If arrInfo(iIndex).y > cMaxY Then arrInfo(iIndex).y = cMaxY
' PLOT CURSOR
WriteText arrInfo(iIndex).y, arrInfo(iIndex).x, arrInfo(iIndex).c
' DISPLAY VARIABLES
iLen = 3: sCount = Left$(LTrim$(RTrim$(Str$(iRowOffset + 1))) + String$(iLen, " "), iLen)
iLen = 3: sX = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).x))) + String$(iLen, " "), iLen)
iLen = 3: sY = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).y))) + String$(iLen, " "), iLen)
iLen = 6: sWheel = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).wheel))) + String$(iLen, " "), iLen)
iLen = 9: sLeftDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).LeftDown))) + String$(iLen, " "), iLen)
iLen = 11: sMiddleDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).MiddleDown))) + String$(iLen, " "), iLen)
iLen = 10: sRightDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).RightDown))) + String$(iLen, " "), iLen)
iLen = 10: sLeftCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).LeftCount))) + String$(iLen, " "), iLen)
iLen = 12: sMiddleCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).MiddleCount))) + String$(iLen, " "), iLen)
iLen = 11: sRightCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).RightCount))) + String$(iLen, " "), iLen)
'sNext = sCount + sX + sY + sWheel + sLeftDown + sMiddleDown + sRightDown + sLeftCount + sMiddleCount + sRightCount
WriteText 6 + iRowOffset, 1, sCount + sX + sY + sWheel + sLeftDown + sMiddleDown + sRightDown + sLeftCount + sMiddleCount + sRightCount
iRowOffset = iRowOffset + 1
Next iIndex
' UPDATE mousemessage WITH PLAYING FIELD
mousemessage = ScreenToString$
' ================================================================================================================================================================
' END DRAW SCREEN
' ================================================================================================================================================================
InvalidateRect hwnd, 0, -1
SendMessage hwnd, WM_PAINT, 0, 0
MainWndProc = 0
End If
MemFree lpb
MainWndProc = 0
Exit Function
Case WM_MOUSEMOVE
' SAVE RANGE OF MOUSE COORDINATES
If GET_X_LPARAM(lParam) < iMinX Then iMinX = GET_X_LPARAM(lParam)
If GET_X_LPARAM(lParam) > iMaxX Then iMaxX = GET_X_LPARAM(lParam)
If GET_Y_LPARAM(lParam) < iMinY Then iMinY = GET_Y_LPARAM(lParam)
If GET_Y_LPARAM(lParam) > iMaxY Then iMaxY = GET_Y_LPARAM(lParam)
' IDENTIFY WHICH MOUSE IT IS
strNextID = _Trim$(Str$(raw.header.hDevice))
iIndex = GetMouseIndex%(strNextID)
If iIndex >= LBound(arrInfo) Then
If iIndex <= UBound(arrInfo) Then
' =============================================================================
' DOESN'T WORK, MOVES ALL OVER THE PLACE:
'
' UPDATE ABSOLUTE POSITION
'' METHOD #1: SCALE MOUSE POSITION TO 80X25 POSITION
''iNewX = ( (GET_X_LPARAM(lParam) + 1) * 80) \ 1520
'iNewX = ( (GET_X_LPARAM(lParam) + 1) * 80) \ (iMaxX+1)
''iNewY = ( (GET_Y_LPARAM(lParam) + 1) * 25) \ 782
'iNewY = ( (GET_Y_LPARAM(lParam) + 1) * 25) \ (iMaxY+1)
'arrInfo(iIndex).x = iNewX
'arrInfo(iIndex).y = iNewY
End If
End If
InvalidateRect hwnd, 0, -1
SendMessage hwnd, WM_PAINT, 0, 0
MainWndProc = 0
Exit Function
Case WM_PAINT
'Q: HOW DO WE GET THIS TO WORK WITH REGULAR QB64 WINDOW?
'hdc = BeginPaint(_WindowHandle, Offset(ps))
hdc = BeginPaint(hwnd, Offset(ps))
'Q: HOW DO WE GET THIS TO WORK WITH REGULAR QB64 WINDOW?
'GetClientRect _WindowHandle, Offset(rc)
GetClientRect hwnd, Offset(rc)
DrawText hdc, Offset(mousemessage), Len(mousemessage), Offset(rc), DT_CENTER
OffsetRect Offset(rc), 0, 200
'EndPaint _WindowHandle, Offset(ps)
EndPaint hwnd, Offset(ps)
MainWndProc = 0
Exit Function
Case Else
'MainWndProc = DefWindowProc(_WindowHandle, nMsg, wParam, lParam)
MainWndProc = DefWindowProc(hwnd, nMsg, wParam, lParam)
End Select
End Function ' MainWndProc
' /////////////////////////////////////////////////////////////////////////////
' Initializes raw input stuff
Sub InitRawInput ()
Dim As RAWINPUTDEVICE Rid(0 To 49)
Dim As Unsigned Long nDevices
Dim As RAWINPUTDEVICELIST RawInputDeviceList
Dim As MEM pRawInputDeviceList
ReDim As RAWINPUTDEVICELIST rawdevs(-1)
Dim As Unsigned Long x
Dim strNextID As String
If GetRawInputDeviceList(0, Offset(nDevices), Len(RawInputDeviceList)) <> 0 Then
Exit Sub
End If
pRawInputDeviceList = MemNew(Len(RawInputDeviceList) * nDevices)
GetRawInputDeviceList pRawInputDeviceList.OFFSET, Offset(nDevices), Len(RawInputDeviceList)
' This small block of commented code proves that we've got the device list
ReDim As RAWINPUTDEVICELIST rawdevs(0 To nDevices - 1)
MemGet pRawInputDeviceList, pRawInputDeviceList.OFFSET, rawdevs()
' GET MOUSE INFO
iMouseCount = 0
rawinputdevices = "Number of raw input devices:" + Str$(nDevices) + Chr$(13)
For x = 0 To UBound(rawdevs)
rawinputdevices = rawinputdevices + Str$(rawdevs(x).hDevice) + ":" + Str$(rawdevs(x).dwType) + Chr$(13)
' Is it a mouse?
If rawdevs(x).dwType = 0 Then
iMouseCount = iMouseCount + 1
strNextID = _Trim$(Str$(rawdevs(x).hDevice))
arrInfo(iMouseCount - 1).ID = strNextID
End If
Next x
rawinputdevices = rawinputdevices + Chr$(0)
MemFree pRawInputDeviceList
Rid(0).usUsagePage = &H01
Rid(0).usUsage = &H02
Rid(0).dwFlags = 0
Rid(0).hwndTarget = 0
'Rid(0).hwndTarget = _WindowHandle
If RegisterRawInputDevices(Offset(Rid()), 1, Len(Rid(0))) = 0 Then
mousemessage = "RawInput init failed" + Chr$(0)
End If
End Sub ' InitRawInput
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END RAW INPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN MOUSE TEST FUNCTIONS #1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Initialize mouse test stuff
'TODO: SAVE_MOUSE_INFO
Sub InitMouseTest
Dim iIndex As Integer
Dim iLoop As Integer
' FOR NOW ONLY SUPPORT UPTO 8 MICE
If (iMouseCount > 8) Then iMouseCount = 8
' INITIALIZE CURSORS, MOUSE STATE, ETC.
Restore CData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrInfo(iIndex).c
arrInfo(iIndex).LeftDown = FALSE
arrInfo(iIndex).MiddleDown = FALSE
arrInfo(iIndex).RightDown = FALSE
arrInfo(iIndex).LeftCount = 0
arrInfo(iIndex).MiddleCount = 0
arrInfo(iIndex).RightCount = 0
Next iLoop
' INITIALIZE X COORDINATES
Restore XData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrInfo(iIndex).x
Next iLoop
' INITIALIZE Y COORDINATES
Restore YData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrInfo(iIndex).y
Next iLoop
' INITIALIZE SCROLL WHEEL
Restore WData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrInfo(iIndex).wheel
Next iLoop
End Sub ' InitMouseTest
' /////////////////////////////////////////////////////////////////////////////
' Finds position in array arrInfo where .ID = MouseID
Function GetMouseIndex% (MouseID As String)
Dim iLoop As Integer
Dim iIndex%
iIndex% = LBound(arrInfo) - 1
For iLoop = LBound(arrInfo) To UBound(arrInfo)
If arrInfo(iLoop).ID = MouseID Then
iIndex% = iLoop
Exit For
Else
' not it
End If
Next iLoop
GetMouseIndex% = iIndex%
End Function ' GetMouseIndex%
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END MOUSE TEST FUNCTIONS #1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN TEST OUTPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Clears global array arrScreen
Sub ClearText
Dim iColNum As Integer
Dim iRowNum As Integer
For iColNum = LBound(arrScreen, 1) To UBound(arrScreen, 1)
For iRowNum = LBound(arrScreen, 2) To UBound(arrScreen, 2)
arrScreen(iColNum, iRowNum) = " "
Next iRowNum
Next iColNum
End Sub ' ClearText
' /////////////////////////////////////////////////////////////////////////////
' Plots string MyString to position (iX, iY) in global array arrScreen.
Sub WriteText (iRow As Integer, iColumn As Integer, MyString As String)
Dim iPos As Integer
Dim iLoop As Integer
If iColumn > 0 And iColumn < 81 Then
If iRow > 0 And iRow < 26 Then
For iLoop = 1 To Len(MyString)
iPos = iColumn + (iLoop - 1)
If iPos < 81 Then
arrScreen(iPos, iRow) = Mid$(MyString, iLoop, 1)
Else
Exit For
End If
Next iLoop
End If
End If
End Sub ' WriteText
' /////////////////////////////////////////////////////////////////////////////
' Converts global array arrScreen to a string.
Function ScreenToString$
Dim sResult As String
Dim iColNum As Integer
Dim iRowNum As Integer
sResult = ""
For iRowNum = LBound(arrScreen, 2) To UBound(arrScreen, 2)
For iColNum = LBound(arrScreen, 1) To UBound(arrScreen, 1)
sResult = sResult + arrScreen(iColNum, iRowNum)
Next iColNum
sResult = sResult + Chr$(13)
Next iRowNum
ScreenToString$ = sResult
End Function ' ScreenToString$
' /////////////////////////////////////////////////////////////////////////////
' based on code from:
' Qbasic Programs - Download free bas source code
' http://www.thedubber.altervista.org/qbsrc.htm
Sub DrawTextLine (y%, x%, y2%, x2%, c$)
Dim i%
Dim steep%
Dim e%
Dim sx%
Dim dx%
Dim sy%
Dim dy%
i% = 0: steep% = 0: e% = 0
If (x2% - x%) > 0 Then sx% = 1: Else sx% = -1
dx% = Abs(x2% - x%)
If (y2% - y%) > 0 Then sy% = 1: Else sy% = -1
dy% = Abs(y2% - y%)
If (dy% > dx%) Then
steep% = 1
Swap x%, y%
Swap dx%, dy%
Swap sx%, sy%
End If
e% = 2 * dy% - dx%
For i% = 0 To dx% - 1
If steep% = 1 Then
''PSET (y%, x%), c%:
'Locate y%, x% : Print c$;
WriteText y%, x%, c$
Else
''PSET (x%, y%), c%
'Locate x%, y% : Print c$;
WriteText x%, y%, c$
End If
While e% >= 0
y% = y% + sy%: e% = e% - 2 * dx%
Wend
x% = x% + sx%: e% = e% + 2 * dy%
Next
''PSET (x2%, y2%), c%
'Locate x2%, y2% : Print c$;
WriteText x2%, y2%, c$
End Sub ' DrawTextLine
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END TEST OUTPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Posts: 3,802
Threads: 173
Joined: Apr 2022
Reputation:
196
so is a union different than math / logic version of the name? ie a set with no repeating elements
b = b + ...
Posts: 314
Threads: 11
Joined: Apr 2022
Reputation:
44
(06-06-2024, 03:15 AM)madscijr Wrote: I don't see any of the UNIONed type being hidden in _OFFSET, or any "padding" or MEMGET or any of that stuff happening to access the members of that type.
I don't see any of that funny stuff, but it still works. How? Why? Well that has a lot to do with what you're trying to do with these APIs. The APIs can return any of RAWMOUSE, RAWHID, and RAWKEYBOARD responses, that's the purpose of the union. If you only care about the RAWMOUSE ones (that's the case for the program you posted), then you can ignore the `union` and just pretend it's a `RAWMOUSE` struct (since that's the only one of the union members you would use anyway). If you want to be able to process all three of RAWMOUSE, RAWHID, and RAWKEYBOARD then the union issues come into play.
Also, the code does having padding inserted, that's the `Aiignment` members in the TYPEs `RAWINPUTDEVICELIST`, `PAINTSTRUCT`, and `RAWMOUSE` have padding added (though I'm not entirely sure `RAWMOUSE` is correct, I think that padding is also needed for 32-bit).
(06-06-2024, 01:56 PM)bplus Wrote: so is a union different than math / logic version of the name? ie a set with no repeating elements Yes, they're not related 
Posts: 719
Threads: 28
Joined: Apr 2022
Reputation:
38
Be sure to use sizeof() and OFFSETOF() in C to check struct sizes and padding.
Tread on those who tread on you
Posts: 705
Threads: 99
Joined: Apr 2022
Reputation:
13
(06-06-2024, 02:09 PM)DSMan195276 Wrote: (06-06-2024, 03:15 AM)madscijr Wrote: I don't see any of the UNIONed type being hidden in _OFFSET, or any "padding" or MEMGET or any of that stuff happening to access the members of that type.
I don't see any of that funny stuff, but it still works. How? Why? Well that has a lot to do with what you're trying to do with these APIs. The APIs can return any of RAWMOUSE, RAWHID, and RAWKEYBOARD responses, that's the purpose of the union. If you only care about the RAWMOUSE ones (that's the case for the program you posted), then you can ignore the `union` and just pretend it's a `RAWMOUSE` struct (since that's the only one of the union members you would use anyway). If you want to be able to process all three of RAWMOUSE, RAWHID, and RAWKEYBOARD then the union issues come into play.
Also, the code does having padding inserted, that's the `Aiignment` members in the TYPEs `RAWINPUTDEVICELIST`, `PAINTSTRUCT`, and `RAWMOUSE` have padding added (though I'm not entirely sure `RAWMOUSE` is correct, I think that padding is also needed for 32-bit). Hmm, ok. Maybe I can fudge it to not need the unions, because I really don't want to have to get into the low-level MEM stuff. That stuff is WAY too low-level for me. All I know is the mouse API routines work, and I was able to get the mouse stuff working. If I can limp across the finish line with the rest of the API functions for keyboard, I'm good!
Posts: 705
Threads: 99
Joined: Apr 2022
Reputation:
13
06-06-2024, 02:55 PM
(This post was last modified: 06-06-2024, 03:07 PM by madscijr.)
(06-06-2024, 02:36 PM)SpriggsySpriggs Wrote: Be sure to use sizeof() and OFFSETOF() in C to check struct sizes and padding. Spriggsy, you're the only one I know of that has actually got this API stuff working.
I added the code for keyboard to your mouse program and think it's 95% there,
it's just these damn API types with unions which DSMan195276 graciously tried to explain.
However my monkey's brain really struggles with stuff that's lower level than BASIC.
If you're feeling charitable, would you give this a look? Pretty please with a side of real maple syrup?
Just search for "needs fixing"...
Code: (Select All) ' SEARCH FOR "NEEDS FIXING"
' *****************************************************************************
' NOTE: The following header files must be in same folder as this program:
' "makeint.h"
' "winproc.h"
' *****************************************************************************
Option Explicit
_Title "multimouse"
$NoPrefix
$Console:Only
Console Off
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CONSTANTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Const FALSE = 0
Const TRUE = Not FALSE
' MIN/MAX VALUES FOR MOUSE TEST
Const cMinX = 2
Const cMaxX = 79
Const cMinY = 16
Const cMaxY = 24
Const cMinWheel = 0
Const cMaxWheel = 255
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END CONSTANTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ================================================================================================================================================================
' BEGIN API CONSTANTS
' ================================================================================================================================================================
Const COLOR_WINDOW = 5
Const CS_HREDRAW = &H0002
Const CS_VREDRAW = &H0001
Const CW_USEDEFAULT = &H80000000
Const DT_CENTER = &H00000001
Const Edit = 101
Const EM_GETSEL = &H00B0
Const EM_SETSEL = &H00B1
Const EN_CHANGE = &H0300
Const EN_KILLFOCUS = &H0200
Const EN_SETFOCUS = &H0100
Const GCL_HICON = -14
Const GCL_HICONSM = -34
Const Hid_Bottom = 66
Const Hid_Left = 33
Const Hid_Right = 34
Const HWND_DESKTOP = 0
Const ICON_BIG = 1
Const ICON_SMALL = 0
Const IDC_ARROW = 32512
Const IDI_APPLICATION = 32512
Const KEYEVENTF_KEYUP = &H0002
Const KL_NAMELENGTH = 9
Const LabelInfo = 201
Const MOUSE_ATTRIBUTES_CHANGED = &H04
Const MOUSE_MOVE_ABSOLUTE = &H01
Const MOUSE_MOVE_NOCOALESCE = &H08
Const MOUSE_MOVE_RELATIVE = &H00
Const MOUSE_VIRTUAL_DESKTOP = &H02
Const NULL = 0
Const RI_KEY_BREAK = 1
Const RI_KEY_E0 = 2
Const RI_KEY_E1 = 4
Const RI_KEY_MAKE = 0
Const RI_KEY_TERMSRV_SET_LED = 8
Const RI_KEY_TERMSRV_SHADOW = &H10
Const RID_INPUT = &H10000003
Const RIDEV_EXINPUTSINK = &H00001000
Const RIDI_DEVICEINFO = &H2000000B
Const RIM_TYPEMOUSE = 0
Const RIM_TYPEKEYBOARD = 1
Const RIM_TYPEHID = 2
Const SIZE_MINIMIZED = 1
Const SW_SHOW = 5
Const VK_CONTROL = &H11
Const VK_DELETE = &H2E
Const VK_DIVIDE = &H6F
Const VK_DOWN = &H28
Const VK_END = &H23
Const VK_HOME = &H24
Const VK_INSERT = &H2D
Const VK_LEFT = &H25
Const VK_NEXT = &H22
Const VK_NUMLOCK = &H90
Const VK_PRIOR = &H21
Const VK_RIGHT = &H27
Const VK_SCROLL = &H91
Const VK_UP = &H26
Const WM_APP = &H08000
Const WM_APPCOMMAND = &H0319
Const WM_CHAR = &H0102
Const WM_COMMAND = &H0111
Const WM_DEADCHAR = &H0103
Const WM_DESTROY = &H0002
Const WM_INITDIALOG = &H0110
Const WM_INPUT = &H00FF
Const WM_KEYDOWN = &H0100
Const WM_KEYUP = &H0101
Const WM_MOUSEMOVE = &H0200
Const WM_NCACTIVATE = &H0086
Const WM_NEXTDLGCTL = &H28
Const WM_PAINT = &H000F
Const WM_SETICON = &H0080
Const WM_SIZE = &H0005
Const WM_SYSCHAR = &H0106
Const WM_SYSDEADCHAR = &H0107
Const WM_SYSKEYDOWN = &H0104
Const WM_SYSKEYUP = &H0105
Const WM_UNICHAR = &H0109
Const WS_CAPTION = &H00C00000
Const WS_CHILD = &H40000000
Const WS_MAXIMIZEBOX = &H00010000
Const WS_MINIMIZEBOX = &H00020000
Const WS_OVERLAPPED = &H00000000
' NEEDS FIXING?
' NOT SURE HOW TO DO THIS IN QB64/PE, FOR NOW MADE IT A FUNCTION:
'CONST WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Const WS_SYSMENU = &H00080000
Const WS_THICKFRAME = &H00040000
Const WS_VISIBLE = &H10000000
' ================================================================================================================================================================
' END API CONSTANTS
' ================================================================================================================================================================
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN RAW INPUT TYPES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' *****************************************************************************
' FOR TYPE CONVERSION SEE: "QB64PE C Libraries" at:
' https://qb64phoenix.com/qb64wiki/index.php/C_Libraries
' *****************************************************************************
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWINPUTDEVICE structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevice
'typedef struct tagRAWINPUTDEVICE {
' USHORT usUsagePage;
' USHORT usUsage;
' DWORD dwFlags;
' HWND hwndTarget;
'} RAWINPUTDEVICE, *PRAWINPUTDEVICE, *LPRAWINPUTDEVICE;
' Spriggsy's version:
Type RAWINPUTDEVICE
As Unsigned Integer usUsagePage, usUsage
As Unsigned Long dwFlags
As Offset hwndTarget
End Type
' ^^^ Should "Unsigned Integer" be "_UNSIGNED INTEGER"
' and "Unsigned Long" be "_UNSIGNED LONG"
' and "Offset" be "_OFFSET" like this?:
'
'TYPE RAWINPUTDEVICE
' usUsagePage AS _UNSIGNED INTEGER ' WORD
' usUsage AS _UNSIGNED INTEGER ' WORD
' dwFlags AS _UNSIGNED LONG ' DWORD
' hwndTarget AS _OFFSET ' DWORD
'END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWINPUTDEVICELIST structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevicelist
'typedef struct tagRAWINPUTDEVICELIST {
' HANDLE hDevice;
' DWORD dwType;
'} RAWINPUTDEVICELIST, *PRAWINPUTDEVICELIST;
' Spriggsy's version:
Type RAWINPUTDEVICELIST
As Offset hDevice
As Unsigned Long dwType
$If 64BIT Then
As String * 4 alignment
$End If
End Type
' Probably better than what I thought:
'TYPE RAWINPUTDEVICELIST
' hDevice AS _UNSIGNED LONG ' DWORD <- should this be _OFFSET ?
' dwType AS _UNSIGNED LONG ' DWORD
'END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'POINT structure (windef.h)
'https://learn.microsoft.com/en-us/windows/win32/api/windef/ns-windef-point
'typedef struct tagPOINT {
' LONG x;
' LONG y;
'} POINT, *PPOINT, *NPPOINT, *LPPOINT;
Type POINT
As Long x, y
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'MSG structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-msg
'typedef struct tagMSG {
' HWND hwnd;
' UINT message;
' WPARAM wParam;
' LPARAM lParam;
' DWORD time;
' POINT pt;
' DWORD lPrivate;
'} MSG, *PMSG, *NPMSG, *LPMSG;
Type MSG
As Offset hwnd
As Unsigned Long message
As Unsigned Offset wParam
As Offset lParam
As Long time
As POINT pt
As Long lPrivate
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'WNDCLASSEXA structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-wndclassexa
'typedef struct tagWNDCLASSEXA {
' UINT cbSize;
' UINT style;
' WNDPROC lpfnWndProc;
' int cbClsExtra;
' int cbWndExtra;
' HINSTANCE hInstance;
' HICON hIcon;
' HCURSOR hCursor;
' HBRUSH hbrBackground;
' LPCSTR lpszMenuName;
' LPCSTR lpszClassName;
' HICON hIconSm;
'} WNDCLASSEXA, *PWNDCLASSEXA, *NPWNDCLASSEXA, *LPWNDCLASSEXA;
Type WNDCLASSEX
As Unsigned Long cbSize, style
As Offset lpfnWndProc
As Long cbClsExtra, cbWndExtra
As Offset hInstance, hIcon, hCursor, hbrBackground, lpszMenuName, lpszClassName, hIconSm
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RECT structure (windef.h)
'https://learn.microsoft.com/en-us/windows/win32/api/windef/ns-windef-rect
'typedef struct tagRECT {
' LONG left;
' LONG top;
' LONG right;
' LONG bottom;
'} RECT, *PRECT, *NPRECT, *LPRECT;
Type RECT
As Long left, top, right, bottom
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'PAINTSTRUCT structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-paintstruct
'typedef struct tagPAINTSTRUCT {
' HDC hdc;
' BOOL fErase;
' RECT rcPaint;
' BOOL fRestore;
' BOOL fIncUpdate;
' BYTE rgbReserved[32];
'} PAINTSTRUCT, *PPAINTSTRUCT, *NPPAINTSTRUCT, *LPPAINTSTRUCT;
Type PAINTSTRUCT
As Offset hdc
As Long fErase
$If 64BIT Then
As String * 4 alignment
$End If
As RECT rcPaint
As Long fRestore, fIncUpdate
As String * 32 rgbReserved
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWINPUTHEADER structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputheader
'typedef struct tagRAWINPUTHEADER {
' DWORD dwType;
' DWORD dwSize;
' HANDLE hDevice;
' WPARAM wParam;
'} RAWINPUTHEADER, *PRAWINPUTHEADER, *LPRAWINPUTHEADER;
' Spriggsy's version:
Type RAWINPUTHEADER
As Unsigned Long dwType, dwSize
As Offset hDevice
As Unsigned Offset wParam
End Type
' ^^^ Doesn't match the types I expected, should it be these?:
'TYPE RAWINPUTHEADER
' dwType AS _UNSIGNED LONG ' DWORD
' dwSize AS _UNSIGNED LONG ' DWORD
' hDevice AS _UNSIGNED LONG ' DWORD <- should this be _OFFSET ?
' wParam AS LONG
'END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWMOUSE structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawmouse
'typedef struct tagRAWMOUSE {
' USHORT usFlags;
' union {
' ULONG ulButtons;
' struct {
' USHORT usButtonFlags;
' USHORT usButtonData;
' } DUMMYSTRUCTNAME;
' } DUMMYUNIONNAME2;
' ULONG ulRawButtons;
' LONG lLastX;
' LONG lLastY;
' ULONG ulExtraInformation;
'} RAWMOUSE, *PRAWMOUSE, *LPRAWMOUSE;
' Spriggsy's simplified version:
Type RAWMOUSE
As Unsigned Integer usFlags
$If 64BIT Then
As String * 2 alignment
$End If
'As Unsigned Long ulButtons 'commented out because I'm creating this value using MAKELONG
As Unsigned Integer usButtonFlags, usButtonData
As Unsigned Long ulRawButtons
As Long lLastX, lLastY
As Unsigned Long ulExtraInformation
End Type
' ^^^ NEEDS FIXING?
' should be something like this maybe?:
'TYPE DUMMYSTRUCTNAME
' usButtonFlags AS _UNSIGNED INTEGER ' USHORT
' usButtonData AS _UNSIGNED INTEGER ' USHORT
'END TYPE
'TYPE DUMMYUNIONNAME2
' ulButtons AS _UNSIGNED _OFFSET ' ULONG
' My_DUMMYSTRUCTNAME AS _OFFSET ' pointer to DUMMYSTRUCTNAME
'END TYPE
'TYPE RAWMOUSE
' usFlags AS _UNSIGNED INTEGER ' USHORT
' My_DUMMYUNIONNAME2 AS _OFFSET ' pointer to DUMMYUNIONNAME2
' ulRawButtons AS _UNSIGNED _OFFSET ' ULONG
' lLastX AS LONG
' lLastY AS LONG
' ulExtraInformation AS _UNSIGNED _OFFSET ' ULONG
'END TYPE
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWKEYBOARD structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawkeyboard
'typedef struct tagRAWKEYBOARD {
' USHORT MakeCode;
' USHORT Flags;
' USHORT Reserved;
' USHORT VKey;
' UINT Message;
' ULONG ExtraInformation;
'} RAWKEYBOARD, *PRAWKEYBOARD, *LPRAWKEYBOARD;
Type RAWKEYBOARD
MakeCode As _Unsigned Integer ' USHORT
Flags As _Unsigned Integer ' USHORT
Reserved As _Unsigned Integer ' USHORT
VKey As _Unsigned Integer ' USHORT
Message As _Unsigned Long ' UINT
ExtraInformation As _Unsigned _Offset ' ULONG
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' NEEDS FIXING:
'RAWINPUT structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinput
'typedef struct tagRAWINPUT {
' RAWINPUTHEADER header;
' union {
' RAWMOUSE mouse;
' RAWKEYBOARD keyboard;
' RAWHID hid;
' } data;
'} RAWINPUT, *PRAWINPUT, *LPRAWINPUT;
' Spriggsy's simplified version:
Type RAWINPUT
As RAWINPUTHEADER header
As RAWMOUSE mouse
'As RAWKEYBOARD keyboard <- ADDING THIS CAUSES THE PROGRAM TO CRASH ON MOUSE INPUT
End Type
' should be something like this maybe?:
'TYPE RAWINPUT
' header AS RAWINPUTHEADER
' data AS _OFFSET
'END TYPE
' with data pointing to this union:
'TYPE RAWINPUTUNION
' mouse AS _OFFSET ' pointer to RAWMOUSE variable
' keyboard AS _OFFSET ' pointer to RAWKEYBOARD variable
' hid AS _OFFSET ' pointer to RAWHID
'END TYPE
' ***** ^^^ WHEN THIS IS FIXED AND WE HAVE data NEED TO REPLACE ALL *****
' RawInput.keyboard.vKey
' WITH
' RawInput.data.Keyboard.vKey
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RID_DEVICE_INFO_MOUSE structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_mouse
'typedef struct tagRID_DEVICE_INFO_MOUSE {
' DWORD dwId;
' DWORD dwNumberOfButtons;
' DWORD dwSampleRate;
' BOOL fHasHorizontalWheel;
'} RID_DEVICE_INFO_MOUSE, *PRID_DEVICE_INFO_MOUSE;
Type RID_DEVICE_INFO_MOUSE
dwId As _Unsigned Long
dwNumberOfButtons As _Unsigned Long
dwSampleRate As _Unsigned Long
fHasHorizontalWheel As Integer
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RID_DEVICE_INFO_KEYBOARD structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_keyboard
'typedef struct tagRID_DEVICE_INFO_KEYBOARD {
' DWORD dwType;
' DWORD dwSubType;
' DWORD dwKeyboardMode;
' DWORD dwNumberOfFunctionKeys;
' DWORD dwNumberOfIndicators;
' DWORD dwNumberOfKeysTotal;
'} RID_DEVICE_INFO_KEYBOARD, *PRID_DEVICE_INFO_KEYBOARD;
Type RID_DEVICE_INFO_KEYBOARD
dwType As _Unsigned Long ' DWORD
dwSubType As _Unsigned Long ' DWORD
dwKeyboardMode As _Unsigned Long ' DWORD
dwNumberOfFunctionKeys As _Unsigned Long ' DWORD
dwNumberOfIndicators As _Unsigned Long ' DWORD
dwNumberOfKeysTotal As _Unsigned Long ' DWORD
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RID_DEVICE_INFO_HID structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_hid
'typedef struct tagRID_DEVICE_INFO_HID {
' DWORD dwVendorId;
' DWORD dwProductId;
' DWORD dwVersionNumber;
' USHORT usUsagePage;
' USHORT usUsage;
'} RID_DEVICE_INFO_HID, *PRID_DEVICE_INFO_HID;
Type RID_DEVICE_INFO_HID
dwVendorId As _Unsigned Long ' DWORD
dwProductId As _Unsigned Long ' DWORD
dwVersionNumber As _Unsigned Long ' DWORD
usUsagePage As _Unsigned Integer ' USHORT
usUsage As _Unsigned Integer ' USHORT
End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' NEEDS FIXING:
'RID_DEVICE_INFO structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info
'typedef struct tagRID_DEVICE_INFO {
' DWORD cbSize;
' DWORD dwType;
' union {
' RID_DEVICE_INFO_MOUSE mouse;
' RID_DEVICE_INFO_KEYBOARD keyboard;
' RID_DEVICE_INFO_HID hid;
' } DUMMYUNIONNAME1;
'} RID_DEVICE_INFO, *PRID_DEVICE_INFO, *LPRID_DEVICE_INFO;
' ^^^ NOT SURE HOW TO DEFINE THIS, SHOULD IT BE SOMETHING LIKE THIS?:
'Type DUMMYUNIONNAME1
' My_RID_DEVICE_INFO_MOUSE As _Offset ' pointer to VAR A1
' My_RID_DEVICE_INFO_KEYBOARD As _Offset ' pointer to VAR A2
' My_RID_DEVICE_INFO_HID As _Offset ' pointer to VAR A3
'End Type
'Type RID_DEVICE_INFO
' cbSize As _Unsigned Long ' DWORD
' dwType As _Unsigned Long ' DWORD
' My_DUMMYUNIONNAME1 As _Offset ' pointer to DUMMYUNIONNAME1
'End Type
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'RAWHID structure (winuser.h)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawhid
'typedef struct tagRAWHID {
' DWORD dwSizeHid;
' DWORD dwCount;
' BYTE bRawData[1];
'} RAWHID, *PRAWHID, *LPRAWHID;
Type RAWHID
dwSizeHid As _Unsigned Long ' DWORD
dwCount As _Unsigned Long ' DWORD
bRawData As _Unsigned _Byte ' bRawData[1] AS BYTE
End Type
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END RAW INPUT TYPES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CUSTOM TYPES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' UDT TO HOLD THE INFO FOR EACH MOUSE
Type MouseInfoType
'UpdateCount As Integer ' if this value changes we know a value changed
ID As String ' mouse device ID
c As String ' cursor character
x As Integer ' screen x position
y As Integer ' screen y position
'dx As Integer ' mouse x movement -1=left, 1=right, 0=none
'dy As Integer ' mouse y movement -1=up , 1=down , 0=none
wheel As Integer ' mouse wheel value
LeftDown As Integer ' tracks left mouse button state, TRUE=down
MiddleDown As Integer ' tracks middle mouse button state, TRUE=down
RightDown As Integer ' tracks right mouse button state, TRUE=down
LeftCount As Integer ' counts left clicks
MiddleCount As Integer ' counts middle clicks
RightCount As Integer ' counts right clicks
'positionX as long ' for absolute position of mouse from raw input api
'positionY as long ' for absolute position of mouse from raw input api
End Type ' MouseInfoType
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END CUSTOM TYPES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN API DECLARATIONS PART 1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Declare CustomType Library
Function GetRawInputDeviceList~& (ByVal pRawInputDeviceList As Offset, Byval puiNumDevices As Offset, Byval cbSize As Unsigned Long)
Sub GetRawInputDeviceList (ByVal pRawInputDeviceList As Offset, Byval puiNumDevices As Offset, Byval cbSize As Unsigned Long)
Function RegisterRawInputDevices& (ByVal pRawInputDevices As Offset, Byval uiNumDevices As Unsigned Long, Byval cbSize As Unsigned Long)
Function GetModuleHandle%& (ByVal lpModulename As Offset)
Function LoadIcon%& (ByVal hInstance As Offset, Byval lpIconName As Offset)
Function LoadCursor%& (ByVal hInstance As Offset, Byval lpCursorName As Offset)
Function RegisterClassEx~% (ByVal wndclassex As Offset)
Function CreateWindowEx%& (ByVal dwExStyle As Unsigned Long, Byval lpClassName As Offset, Byval lpWindowName As Offset, Byval dwStyle As Unsigned Long, Byval x As Long, Byval y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As Offset, Byval hMenu As Offset, Byval hInstance As Offset, Byval lpParam As Offset)
Sub ShowWindow (ByVal hWnd As Offset, Byval nCmdShow As Long)
Sub UpdateWindow (ByVal hWnd As Offset)
Function GetMessage& (ByVal lpMsg As Offset, Byval hWnd As Offset, Byval wMsgFilterMin As Unsigned Long, Byval wMsgFilterMax As Unsigned Long)
Sub TranslateMessage (ByVal lpMsg As Offset)
Sub DispatchMessage (ByVal lpMsg As Offset)
Sub PostQuitMessage (ByVal nExitCode As Long)
Function DefWindowProc%& (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
Sub GetRawInputData (ByVal hRawInput As Offset, Byval uiCommand As Unsigned Long, Byval pData As Offset, Byval pcbSize As Offset, Byval cbSizeHeader As Unsigned Long)
Function GetRawInputData~& (ByVal hRawInput As Offset, Byval uiCommand As Unsigned Long, Byval pData As Offset, Byval pcbSize As Offset, Byval cbSizeHeader As Unsigned Long)
Sub InvalidateRect (ByVal hWnd As Offset, Byval lpRect As Offset, Byval bErase As Long)
Sub SendMessage (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
Function BeginPaint%& (ByVal hWnd As Offset, Byval lpPaint As Offset)
Sub GetClientRect (ByVal hWnd As Offset, Byval lpRect As Offset)
Sub DrawText (ByVal hdc As Offset, Byval lpchText As Offset, Byval cchText As Long, Byval lprc As Offset, Byval format As Unsigned Long)
Sub OffsetRect (ByVal lprc As Offset, Byval dx As Long, Byval dy As Long)
Sub EndPaint (ByVal hWnd As Offset, Byval lpPaint As Offset)
End Declare
' Header file "makeint.h" must be in same folder as this program.
Declare CustomType Library ".\makeint"
Function MAKEINTRESOURCE%& Alias "MAKEINTRSC" (ByVal i As _Offset)
End Declare
Declare Library
Function MAKELPARAM%& (ByVal l As Integer, Byval h As Integer)
Function MAKELONG~& (ByVal l As Unsigned Integer, Byval h As Unsigned Integer)
End Declare
$If 64BIT Then
Declare Library ".\internal\c\c_compiler\x86_64-w64-mingw32\include\windowsx"
$Else
Declare Library ".\internal\c\c_compiler\i686-w64-mingw32\include\windowsx"
$End If
Function GET_Y_LPARAM& (ByVal lp As Offset)
Function GET_X_LPARAM& (ByVal lp As Offset)
End Declare
' Header file "winproc.h" must be in same folder as this program.
Declare Library ".\winproc"
Function WindowProc%& ()
End Declare
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END API DECLARATIONS PART 1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN API DECLARATIONS PART 2
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Thank to José Roca
DECLARE FUNCTION RegisterRawInputDevices LIB "USER32.DLL" ALIAS "RegisterRawInputDevices"( _
BYREF pRawInputDevices AS RAWINPUTDEVICE, _
BYVAL uiNumDevices AS _UNSIGNED LONG, _
BYVAL cbSize AS _UNSIGNED LONG _
) AS LONG
DECLARE FUNCTION GetRawInputDeviceList LIB "USER32.DLL" ALIAS "GetRawInputDeviceList"( _
BYREF pRawInputDeviceList AS RAWINPUTDEVICELIST, _
BYREF puiNumDevices AS _UNSIGNED LONG, _
BYVAL cbSize AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION GetRawInputDeviceInfo LIB "USER32.DLL" ALIAS "GetRawInputDeviceInfoA"( _
BYVAL hDevice AS _UNSIGNED LONG, _
BYVAL uiCommand AS _UNSIGNED LONG, _
BYREF pData AS _OFFSET, _
BYREF pcbSize AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION SendDlgItemMessage LIB "USER32.DLL" ALIAS "SendDlgItemMessageA"( _
BYVAL hWnd AS _OFFSET, _
BYVAL nIDDlgItem AS LONG, _
BYVAL Msg AS _UNSIGNED LONG, _
BYVAL wParam AS _UNSIGNED LONG, _
BYVAL lParam AS LONG _
) AS LONG
DECLARE FUNCTION GetRawInputData LIB "USER32.DLL" ALIAS "GetRawInputData"( _
BYVAL hRawInput AS _UNSIGNED LONG, _
BYVAL uiCommand AS _UNSIGNED LONG, _
BYREF pData AS _OFFSET, _
BYREF pcbSize AS _UNSIGNED LONG, _
BYVAL cbSizeHeader AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION GetKeyNameText LIB "USER32.DLL" ALIAS "GetKeyNameTextA"( _
BYVAL lParam AS LONG, _
BYREF lpString AS STRING, _
BYVAL cchSize AS _UNSIGNED LONG _
) AS LONG
DECLARE FUNCTION MapVirtualKey LIB "USER32.DLL" ALIAS "MapVirtualKeyA"( _
BYVAL uCode AS _UNSIGNED LONG, _
BYVAL uMapType AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION GetFocus LIB "USER32.DLL" ALIAS "GetFocus"( _
) AS _UNSIGNED LONG
DECLARE FUNCTION GetDlgItem LIB "USER32.DLL" ALIAS "GetDlgItem"( _
BYVAL HWND AS _OFFSET, _
BYVAL nIDDlgItem AS LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION SendMessage LIB "USER32.DLL" ALIAS "SendMessageA"( _
BYVAL hWnd AS _OFFSET, _
BYVAL Msg AS _UNSIGNED LONG, _
BYVAL wParam AS _UNSIGNED LONG, _
BYVAL lParam AS LONG _
) AS LONG
DECLARE FUNCTION DestroyIcon LIB "USER32.DLL" ALIAS "DestroyIcon"( _
BYVAL hIcon AS _UNSIGNED LONG _
) AS LONG
DECLARE FUNCTION PostMessage LIB "USER32.DLL" ALIAS "PostMessageA"( _
BYVAL hWnd AS _OFFSET, _
BYVAL Msg AS _UNSIGNED LONG, _
BYVAL wParam AS _UNSIGNED LONG, _
BYVAL lParam AS LONG _
) AS LONG
DECLARE FUNCTION SetClassLong LIB "USER32.DLL" ALIAS "SetClassLongA"( _
BYVAL hWnd AS _OFFSET, _
BYVAL nIndex AS LONG, _
BYVAL dwNewLong AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION ExtractIconEx LIB "SHELL32.DLL" ALIAS "ExtractIconExA"( _
BYREF lpszFile AS STRING, _
BYVAL nIconIndex AS LONG, _
BYREF phiconLarge AS _UNSIGNED LONG, _
BYREF phiconSmall AS _UNSIGNED LONG, _
BYVAL nIcons AS _UNSIGNED LONG _
) AS _UNSIGNED LONG
DECLARE FUNCTION SetDlgItemText LIB "USER32.DLL" ALIAS "SetDlgItemTextA"( _
BYVAL hDlg AS LONG, _
BYVAL nIDDlgItem AS LONG, _
lpString AS STRING _
) AS LONG
DECLARE SUB Keybd_event LIB "USER32.DLL" ALIAS "keybd_event"( _
BYVAL bVk AS BYTE, _
BYVAL bScan AS BYTE, _
BYVAL dwFlags AS _UNSIGNED LONG, _
BYVAL dwExtraInfo AS _UNSIGNED LONG _
)
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END API DECLARATIONS PART 2
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL VARIABLES PART 1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' RAW INPUT VARIABLES
Dim Shared mousemessage As String
Dim Shared rawinputdevices As String
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL VARIABLES PART 1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL VARIABLES PART 2
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Shared hDlg As _Unsigned Long ' DWORD
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL VARIABLES PART 2
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL VARIABLES PART 3
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bDebug As Integer: m_bDebug = FALSE
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
' MOUSE TEST VARIABLES
Dim Shared arrMouse(8) As MouseInfoType ' STORES INFO FOR EACH MOUSE
Dim Shared iMouseCount As Integer ' # OF MICE ATTACHED
Dim Shared iMinX As Long
Dim Shared iMaxX As Long
Dim Shared iMinY As Long
Dim Shared iMaxY As Long
' KEYBOARD TEST VARIABLES
Dim Shared arrKeyIndex(8) As String ' STORES KEYBOARD ID
Dim Shared arrLastKeyDown(8) As Integer ' STORES LAST KEY PRESSED
Dim Shared arrKeyboard(8, 0 To 255) As Integer ' STORES KEY STATE FOR KEY CODES 0-255
Dim Shared iKeyBoardCount As Integer ' # OF KEYBOARDS ATTACHED
' FOR TEST OUTPUT
Dim Shared arrScreen(1 To 80, 1 To 25) As String ' STORES TEXT FOR SCREEN
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL VARIABLES PART 3
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' EXECUTION STARTS HERE!
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
iMinX = 0
iMaxX = 3583
iMinY = 0
iMaxY = 8202
System Val(Str$(WinMain))
System ' return control to the operating system
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DATA
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' MOUSE CURSORS (JUST SOME LETTERS)
CData:
Data A,b,C,D,E,f,G,H
' DEFAULT/INTIAL X COORDINATE OF EACH CURSOR ON SCREEN
XData:
Data 5,15,25,35,45,55,65,75
' DEFAULT/INTIAL Y COORDINATE OF EACH CURSOR ON SCREEN
YData:
Data 17,17,19,19,21,21,23,23
' DEFAULT/INITIAL VALUE OF EACH SCROLL WHEEL
WData:
Data 224,192,160,128,96,64,32,0
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DATA
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN RAW INPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' I'M GUESSING THIS FUNCTION WILL ACCOMPLISH THE SAME AS:
' CONST WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
' ???
Function WS_OVERLAPPEDWINDOW~&
WS_OVERLAPPEDWINDOW~& = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
End Function
' /////////////////////////////////////////////////////////////////////////////
' Runs first
Function WinMain~%& ()
Dim As Offset hwndMain, hInst
Dim As MSG msg
Dim As WNDCLASSEX wndclass
Dim As String szMainWndClass
Dim As String szWinTitle
Dim As Unsigned Integer reg
' =============================================================================
' SET UP WINDOW
'DEBUG: TRY FULL SCREEN <- PROGRAM CRASHES!
'_FullScreen _SquarePixels
hInst = GetModuleHandle(0)
szMainWndClass = "WinTestWin" + Chr$(0)
szWinTitle = "Hello" + Chr$(0)
wndclass.lpszClassName = Offset(szMainWndClass)
wndclass.cbSize = Len(wndclass)
wndclass.style = CS_HREDRAW Or CS_VREDRAW
wndclass.lpfnWndProc = WindowProc
wndclass.hInstance = hInst 'GetModuleHandle(0) will return the hInstance of this EXE
wndclass.hIcon = LoadIcon(0, MAKEINTRESOURCE(IDI_APPLICATION))
wndclass.hIconSm = LoadIcon(0, MAKEINTRESOURCE(IDI_APPLICATION))
wndclass.hCursor = LoadCursor(0, MAKEINTRESOURCE(IDC_ARROW))
wndclass.hbrBackground = COLOR_WINDOW + 1
reg = RegisterClassEx(Offset(wndclass)) 'I prefer to use the output of RegisterClassEx rather than the window name
'DEBUG: SUBSTITUTE _WindowHandle
'Function CreateWindowEx%& (ByVal dwExStyle As Unsigned Long, Byval lpClassName As Offset, Byval lpWindowName As Offset, Byval dwStyle As Unsigned Long, Byval x As Long, Byval y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As Offset, Byval hMenu As Offset, Byval hInstance As Offset, Byval lpParam As Offset)
hwndMain = CreateWindowEx(0, MAKELPARAM(reg, 0), Offset(szWinTitle), WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, hInst, 0)
'hwndMain = _WindowHandle
'DEBUG: SUBSTITUTE _WindowHandle
ShowWindow hwndMain, SW_SHOW
'ShowWindow _WindowHandle, SW_SHOW
'DEBUG: SUBSTITUTE _WindowHandle
UpdateWindow hwndMain
'UpdateWindow _WindowHandle
' =============================================================================
' INITIALIZE RAW INPUT
InitRawInput
InitMouseTest 'TODO: SAVE_MOUSE_INFO
' INITIALIZE ARRAY FOR TEXT OUTPUT TO SCREEN:
ClearText
' =============================================================================
' BEGIN MAIN LOOP
' =============================================================================
While GetMessage(Offset(msg), 0, 0, 0)
TranslateMessage Offset(msg)
DispatchMessage Offset(msg)
Wend
' =============================================================================
' END MAIN LOOP
' =============================================================================
' RETURN A VALUE
WinMain = msg.wParam
End Function ' WinMain
' /////////////////////////////////////////////////////////////////////////////
' Handles main window events
Function MainWndProc%& (hwnd As Offset, nMsg As Unsigned Long, wParam As Unsigned Offset, lParam As Offset)
' EVENT HANDLER VARIABLES PART 1
Static As Offset hwndButton
Static As Long cx, cy
Dim As Offset hdc
Dim As PAINTSTRUCT ps
Dim As RECT rc
Dim As MEM lpb
Dim As Unsigned Long dwSize
Dim As RAWINPUT raw
Dim As Long tmpx, tmpy
Static As Long maxx
Dim As RAWINPUTHEADER rih
' TEMP VARIABLES FOR DISPLAYING FORMATTED VALUES TO SCREEN
Dim strNextID As String
Dim iIndex As Integer
Dim iRowOffset As Integer
Dim iLine As Integer
Dim iLen As Integer
Dim sCount As String
Dim sX As String
Dim sY As String
Dim sWheel As String
Dim sLeftDown As String
Dim sMiddleDown As String
Dim sRightDown As String
Dim sLeftCount As String
Dim sMiddleCount As String
Dim sRightCount As String
Dim sNext As String
Dim iNewX As Integer
Dim iNewY As Integer
Dim iDX As Integer
Dim iDY As Integer
' EVENT HANDLER VARIABLES PART 2
'DIM RidDeviceInfo AS RID_DEVICE_INFO
Dim pRawInput As _Offset ' RAWINPUT POINTER
Dim zKeyName As String ' ASCIIZ * 50 = NULL-terminated string
'Static CtrlClass As String ' ASCIIZ * 50 = NULL-terminated string
Dim sRawInput As String
Dim sBuffer As String
Dim ScanCode As _Unsigned Long ' DWORD
'Static hidDevice As _Unsigned Long ' DWORD
Static hFocusBak As _Unsigned Long ' DWORD
Dim RawInputDevCount As Long
Dim KeyboardTypeCount As Long
Dim RawInputDeviceIndex As Long
'Static hidF9 As Long
Dim ByteCount As Long
'Static SelStart As Long
'Static SelEnd As Long
Dim vbCrLf As String: vbCrLf = Chr$(13) + Chr$(10)
Dim vbCr As String: vbCr = Chr$(13)
Dim vbLf As String: vbLf = Chr$(10)
ReDim arrText$(0)
' HANDLE EVENTS
Select Case nMsg
Case WM_DESTROY
PostQuitMessage 0
MainWndProc = 0
Exit Function
Case WM_INPUT
GetRawInputData lParam, RID_INPUT, 0, Offset(dwSize), Len(rih)
' KEYBOARD VERSION:
'GetRawInputData(CBLPARAM, %RID_INPUT, BYVAL %NULL, ByteCount, SIZEOF(RAWINPUTHEADER)) 'Get size of raw input buffer
lpb = MemNew(dwSize)
If lpb.SIZE = 0 Then
MainWndProc = 0
Exit Function
End If
If GetRawInputData(lParam, RID_INPUT, lpb.OFFSET, Offset(dwSize), Len(rih)) <> dwSize Then
Print "GetRawInputData doesn't return correct size!"
End If
MemGet lpb, lpb.OFFSET, raw
If raw.header.dwType = RIM_TYPEMOUSE Then
tmpx = raw.mouse.lLastX
tmpy = raw.mouse.lLastY
maxx = tmpx
' UPDATE RANGE OF MOUSE COORDINATES
If GET_X_LPARAM(lParam) < iMinX Then iMinX = GET_X_LPARAM(lParam)
If GET_X_LPARAM(lParam) > iMaxX Then iMaxX = GET_X_LPARAM(lParam)
If GET_Y_LPARAM(lParam) < iMinY Then iMinY = GET_Y_LPARAM(lParam)
If GET_Y_LPARAM(lParam) > iMaxY Then iMaxY = GET_Y_LPARAM(lParam)
' IDENTIFY WHICH MOUSE IT IS
strNextID = _Trim$(Str$(raw.header.hDevice))
iIndex = GetMouseIndex%(strNextID)
If iIndex >= LBound(arrMouse) Then
If iIndex <= UBound(arrMouse) Then
' =============================================================================
' UPDATE ABSOLUTE POSITION
' DOESN'T WORK, MOVES ALL OVER THE PLACE:
'' METHOD #1: SCALE MOUSE POSITION TO 80X25 POSITION
'iNewX = GET_X_LPARAM(lParam)
'iNewY = GET_Y_LPARAM(lParam)
'arrMouse(iIndex).x = iNewX
'arrMouse(iIndex).y = iNewY
' WORKS BUT NOT THAT ACCURATE:
' METHOD #2: INCREMENT/DECREMENT DELTA
If raw.mouse.lLastX < 0 Then
arrMouse(iIndex).x = arrMouse(iIndex).x - 1
ElseIf raw.mouse.lLastX > 0 Then
arrMouse(iIndex).x = arrMouse(iIndex).x + 1
End If
If raw.mouse.lLastY < 0 Then
arrMouse(iIndex).y = arrMouse(iIndex).y - 1
ElseIf raw.mouse.lLastY > 0 Then
arrMouse(iIndex).y = arrMouse(iIndex).y + 1
End If
' =============================================================================
' left button = 1 when down, 2 when released
If ((raw.mouse.usButtonFlags And 1) = 1) Then
arrMouse(iIndex).LeftDown = TRUE
ElseIf ((raw.mouse.usButtonFlags And 2) = 2) Then
arrMouse(iIndex).LeftDown = FALSE
End If
' =============================================================================
' middle button = 16 when down, 32 when released
If ((raw.mouse.usButtonFlags And 16) = 16) Then
arrMouse(iIndex).MiddleDown = TRUE
ElseIf ((raw.mouse.usButtonFlags And 32) = 32) Then
arrMouse(iIndex).MiddleDown = FALSE
End If
' =============================================================================
' right button = 4 when down, 8 when released
If ((raw.mouse.usButtonFlags And 4) = 4) Then
arrMouse(iIndex).RightDown = TRUE
ElseIf ((raw.mouse.usButtonFlags And 8) = 8) Then
arrMouse(iIndex).RightDown = FALSE
End If
' =============================================================================
' scroll wheel = ???
'Hex$(raw.mouse.usButtonFlags)
'arrMouse(iIndex).wheel = ???
End If
End If
' ================================================================================================================================================================
' BEGIN DRAW SCREEN
' ================================================================================================================================================================
WriteText 1, 1, "# X Y Wheel LeftDown MiddleDown RightDown LeftCount MiddleCount RightCount "
' NOTE: LEAVE THE NEXT 8 LINES FREE (ROWS 8-15)
' TO DISPLAY TEST VALUES FOR UPTO 8 MICE
' GET INPUT AND MOVE MOUSE CURSORS
iRowOffset = 0
For iIndex = LBound(arrMouse) To UBound(arrMouse)
' CHECK CURSOR BOUNDARIES
If arrMouse(iIndex).x < cMinX Then arrMouse(iIndex).x = cMinX
If arrMouse(iIndex).x > cMaxX Then arrMouse(iIndex).x = cMaxX
If arrMouse(iIndex).y < cMinY Then arrMouse(iIndex).y = cMinY
If arrMouse(iIndex).y > cMaxY Then arrMouse(iIndex).y = cMaxY
' PLOT CURSOR TO SCREEN ARRAY:
WriteText arrMouse(iIndex).y, arrMouse(iIndex).x, arrMouse(iIndex).c
' CALCULATE LINE # ON SCREEN:
iLine = iRowOffset + 1
' CONVERT VARIABLES TO SPACE-PADDED STRINGS FOR DISPLAY:
iLen = 3: sCount = Left$(LTrim$(RTrim$(Str$(iLine))) + String$(iLen, " "), iLen)
iLen = 3: sX = Left$(LTrim$(RTrim$(Str$(arrMouse(iIndex).x))) + String$(iLen, " "), iLen)
iLen = 3: sY = Left$(LTrim$(RTrim$(Str$(arrMouse(iIndex).y))) + String$(iLen, " "), iLen)
iLen = 6: sWheel = Left$(LTrim$(RTrim$(Str$(arrMouse(iIndex).wheel))) + String$(iLen, " "), iLen)
iLen = 9: sLeftDown = Left$(LTrim$(RTrim$(Str$(arrMouse(iIndex).LeftDown))) + String$(iLen, " "), iLen)
iLen = 11: sMiddleDown = Left$(LTrim$(RTrim$(Str$(arrMouse(iIndex).MiddleDown))) + String$(iLen, " "), iLen)
iLen = 10: sRightDown = Left$(LTrim$(RTrim$(Str$(arrMouse(iIndex).RightDown))) + String$(iLen, " "), iLen)
iLen = 10: sLeftCount = Left$(LTrim$(RTrim$(Str$(arrMouse(iIndex).LeftCount))) + String$(iLen, " "), iLen)
iLen = 12: sMiddleCount = Left$(LTrim$(RTrim$(Str$(arrMouse(iIndex).MiddleCount))) + String$(iLen, " "), iLen)
iLen = 11: sRightCount = Left$(LTrim$(RTrim$(Str$(arrMouse(iIndex).RightCount))) + String$(iLen, " "), iLen)
' WRITE VARIABLES TO NEXT LINE # OF SCREEN ARRAY:
If iLine > 0 And iLine < 25 Then
WriteText iLine, 1, " "
WriteText iLine, 1, sCount + sX + sY + sWheel + sLeftDown + sMiddleDown + sRightDown + sLeftCount + sMiddleCount + sRightCount
End If
' INCREMENT LINE
iRowOffset = iRowOffset + 1
Next iIndex
' COPY SCREEN ARRAY TO mousemessage WHICH IS DISPLAYED ELSEWHERE
mousemessage = ScreenToString$
' INVOKE PAINT?
InvalidateRect hwnd, 0, -1
SendMessage hwnd, WM_PAINT, 0, 0
MainWndProc = 0
' ================================================================================================================================================================
' END DRAW SCREEN
' ================================================================================================================================================================
ElseIf raw.header.dwType = RIM_TYPEHID Then
' DO NOTHING
ElseIf raw.header.dwType = RIM_TYPEKEYBOARD Then
' ****************************************************************************************************************************************************************
' BEGIN PROCESS KEYBOARD INPUT HERE
' ****************************************************************************************************************************************************************
' this isn't yet 100% converted from PowerBASIC
' we can probably dedupe some of the variables
' that are already defined for the mouse code
'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 = ""
sBuffer = sBuffer + "RawInput.Header.hDevice = " + _Trim$(Str$(raw.header.hDevice)) + vbCr ' Show handle
sBuffer = sBuffer + "RawInput.Header.dwType = " + "RIM_TYPEKEYBOARD" + vbCr ' raw.header.dwType
'NEEDS FIXING:
sBuffer = sBuffer + "RawInput.data.Keyboard.vKey = " + _Trim$(Str$(raw.data.Keyboard.vKey)) + vbCr
sBuffer = sBuffer + "Character = " + chr$(34) + CHR$(raw.data.Keyboard.vKey) + chr$(34) + vbCr ' Show char
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' BEGIN TRY GET KEY NAME
ScanCode = MapVirtualKey(raw.data.Keyboard.vKey, 0) ' Create a scan code from vKey to get GetKeyNameText
SELECT CASE raw.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
'BEGIN SHIFT SCANCODE
'Here we try to do this line:
'SHIFT LEFT ScanCode, 16 ' Shift left
'in QB64PE:
'
'The _SHL function is used to shift the bits of a numerical value to the left.
'Syntax: result = _SHL(numericalVariable, numericalValue)
'Parameter(s)
' numericalVariable is the variable to shift the bits of and can be of the following types: INTEGER, LONG,_INTEGER64, or _BYTE.
' Integer values can be signed or _UNSIGNED.
' numericalValue is the number of places to shift the bits.
' While 0 is a valid value it will have no affect on the variable being shifted.
ScanCode = _SHL(ScanCode, 16) ' Shift left
'END SHIFT SCANCODE
GetKeyNameText(ScanCode, BYVAL VARPTR(zKeyName), SIZEOF(zKeyName)) ' Get key name like "Tab" or "Esc"
sBuffer = sBuffer + "KeyName = " + chr$(34) + zKeyName + vbCr
' END TRY TO GET KEY NAME
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'NEEDS FIXING:
sBuffer = sBuffer + "RawInput.data.Keyboard.Message = " + _Trim$(Str$(raw.data.Keyboard.Message, 8)) + vbCr ' Show message
'NEEDS FIXING:
SELECT CASE raw.data.Keyboard.Message
Case WM_KEYDOWN:
sBuffer = sBuffer + "WM_KEYDOWN" + vbCr
Case WM_KEYUP:
sBuffer = sBuffer + "WM_KEYUP" + vbCr
Case WM_SYSKEYDOWN:
sBuffer = sBuffer + "WM_SYSKEYDOWN" + vbCr
Case WM_SYSKEYDOWN:
sBuffer = sBuffer + "WM_SYSKEYDOWN" + vbCr
End Select
'NEEDS FIXING:
sBuffer = sBuffer + "RawInput.data.Keyboard.MakeCode = " + _Trim$(Str$(raw.data.Keyboard.MakeCode)) + vbCr ' Show make code
'NEEDS FIXING:
sBuffer = sBuffer + "RawInput.data.Keyboard.ExtraInformation = " + _Trim$(Str$(raw.data.Keyboard.ExtraInformation, 8) + vbCr ' Show extra info
'NEEDS FIXING:
IF (raw.data.Keyboard.Flags AND RI_KEY_BREAK) THEN ' Show flags
sBuffer = sBuffer + "Flag RI_KEY_BREAK" + vbCr
Else
sBuffer = sBuffer + "Flag RI_KEY_MAKE" + vbCr
End If
'NEEDS FIXING:
IF (raw.data.Keyboard.Flags AND RI_KEY_E0) THEN
sBuffer = sBuffer + "Flag RI_KEY_E0" + vbCr
End If
'NEEDS FIXING:
IF (raw.data.Keyboard.Flags AND RI_KEY_E1) THEN
sBuffer = sBuffer + "Flag RI_KEY_E1" + vbCr
End If
'NEEDS FIXING:
IF (raw.data.Keyboard.Flags AND RI_KEY_TERMSRV_SET_LED) THEN
sBuffer = sBuffer + "Flag RI_KEY_TERMSRV_SET_LED" + vbCr
End If
'NEEDS FIXING:
IF (raw.data.Keyboard.Flags AND RI_KEY_TERMSRV_SHADOW) THEN
sBuffer = sBuffer + "Flag RI_KEY_TERMSRV_SHADOW" + vbCr
End If
' ================================================================================================================================================================
' BEGIN DRAW SCREEN
' ================================================================================================================================================================
' UPDATE LINES 10-24 WITH TEXT IN sBuffer:
' (WRITE BUFFER LINES STARTING AT LINE 10 IN SCREEN ARRAY)
split sBuffer, vbCr, arrTest$() ' BREAK UP sBuffer INTO ARRAY OF LINES
iRowOffset = 0
For iIndex = LBound(arrTest$) To UBound(arrTest$)
' CALCULATE LINE # ON SCREEN:
iLine = iRowOffset + 10 ' START DISPLAYING AT ROW 10
' WRITE LINE OF sBuffer TO NEXT LINE # OF SCREEN ARRAY:
if iLine > 0 and iLine < 25 then
WriteText iLine, 1, " "
WriteText iLine, 1, arrTest$(iIndex)
end if
' INCREMENT LINE
iRowOffset = iRowOffset + 1
Next iIndex
'
' COPY SCREEN ARRAY TO mousemessage WHICH IS DISPLAYED ELSEWHERE
mousemessage = ScreenToString$
' INVOKE PAINT?
InvalidateRect hwnd, 0, -1
SendMessage hwnd, WM_PAINT, 0, 0
MainWndProc = 0
' ================================================================================================================================================================
' END DRAW SCREEN
' ================================================================================================================================================================
' ****************************************************************************************************************************************************************
' END PROCESS KEYBOARD INPUT HERE
' ****************************************************************************************************************************************************************
End If
' FINISHUP WM_INPUT
MemFree lpb
MainWndProc = 0
Exit Function
Case WM_MOUSEMOVE
' SAVE RANGE OF MOUSE COORDINATES
If GET_X_LPARAM(lParam) < iMinX Then iMinX = GET_X_LPARAM(lParam)
If GET_X_LPARAM(lParam) > iMaxX Then iMaxX = GET_X_LPARAM(lParam)
If GET_Y_LPARAM(lParam) < iMinY Then iMinY = GET_Y_LPARAM(lParam)
If GET_Y_LPARAM(lParam) > iMaxY Then iMaxY = GET_Y_LPARAM(lParam)
' IDENTIFY WHICH MOUSE IT IS
strNextID = _Trim$(Str$(raw.header.hDevice))
iIndex = GetMouseIndex%(strNextID)
If iIndex >= LBound(arrMouse) Then
If iIndex <= UBound(arrMouse) Then
' =============================================================================
' UPDATE ABSOLUTE POSITION
' NEEDS FIXING (LATER):
' DOESN'T WORK, MOVES ALL OVER THE PLACE:
'' METHOD #1: SCALE MOUSE POSITION TO 80X25 POSITION
''iNewX = ( (GET_X_LPARAM(lParam) + 1) * 80) \ 1520
'iNewX = ( (GET_X_LPARAM(lParam) + 1) * 80) \ (iMaxX+1)
''iNewY = ( (GET_Y_LPARAM(lParam) + 1) * 25) \ 782
'iNewY = ( (GET_Y_LPARAM(lParam) + 1) * 25) \ (iMaxY+1)
'arrMouse(iIndex).x = iNewX
'arrMouse(iIndex).y = iNewY
End If
End If
InvalidateRect hwnd, 0, -1
SendMessage hwnd, WM_PAINT, 0, 0
MainWndProc = 0
Exit Function
Case WM_PAINT
'Q: HOW DO WE GET THIS TO WORK WITH REGULAR QB64 WINDOW?
'hdc = BeginPaint(_WindowHandle, Offset(ps))
hdc = BeginPaint(hwnd, Offset(ps))
'Q: HOW DO WE GET THIS TO WORK WITH REGULAR QB64 WINDOW?
GetClientRect hwnd, Offset(rc)
'GetClientRect _WindowHandle, Offset(rc)
DrawText hdc, Offset(mousemessage), Len(mousemessage), Offset(rc), DT_CENTER
OffsetRect Offset(rc), 0, 200
EndPaint hwnd, Offset(ps)
'EndPaint _WindowHandle, Offset(ps)
MainWndProc = 0
Exit Function
' ****************************************************************************************************************************************************************
' BEGIN EVENTS FOR PART 2
' ****************************************************************************************************************************************************************
' this isn't yet 100% converted from PowerBASIC
' we can probably dedupe some of the variables
' that are already defined for the mouse code
Case WM_INITDIALOG
'NEEDS FIXING:
'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_CHAR
Case WM_APPCOMMAND
Case WM_APP
'NEEDS FIXING:
'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
'NEEDS FIXING:
'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
'NEEDS FIXING:
'IF CBWPARAM = 0 THEN 'Application loose focus
' hFocusBak = GetFocus()
'ELSEIF hFocusBak THEN
' SendMessage(hDlg, WM_NEXTDLGCTL, hFocusBak, 1)
' hFocusBak = 0
'END IF
' ****************************************************************************************************************************************************************
' END EVENTS FOR PART 2
' ****************************************************************************************************************************************************************
Case Else
'MainWndProc = DefWindowProc(_WindowHandle, nMsg, wParam, lParam)
MainWndProc = DefWindowProc(hwnd, nMsg, wParam, lParam)
End Select
End Function ' MainWndProc
' /////////////////////////////////////////////////////////////////////////////
' Initializes raw input stuff
Sub InitRawInput ()
Dim As RAWINPUTDEVICE Rid(0 To 49)
Dim As Unsigned Long nDevices
Dim As RAWINPUTDEVICELIST RawInputDeviceList
Dim As MEM pRawInputDeviceList
ReDim As RAWINPUTDEVICELIST rawdevs(-1)
Dim As Unsigned Long x
Dim iLoop2 As Integer
Dim strNextID As String
If GetRawInputDeviceList(0, Offset(nDevices), Len(RawInputDeviceList)) <> 0 Then
Exit Sub
End If
pRawInputDeviceList = MemNew(Len(RawInputDeviceList) * nDevices)
GetRawInputDeviceList pRawInputDeviceList.OFFSET, Offset(nDevices), Len(RawInputDeviceList)
' This small block of commented code proves that we've got the device list
ReDim As RAWINPUTDEVICELIST rawdevs(0 To nDevices - 1)
MemGet pRawInputDeviceList, pRawInputDeviceList.OFFSET, rawdevs()
' GET DEVICE INFO
iMouseCount = 0
iKeyBoardCount = 0
rawinputdevices = "Number of raw input devices:" + Str$(nDevices) + Chr$(13)
For x = 0 To UBound(rawdevs)
rawinputdevices = rawinputdevices + Str$(rawdevs(x).hDevice) + ":" + Str$(rawdevs(x).dwType) + Chr$(13)
' Is it a mouse? Keyboard?
If rawdevs(x).dwType = RIM_TYPEMOUSE Then
iMouseCount = iMouseCount + 1 ' INCREMENT THE MOUSE COUNT
strNextID = _Trim$(Str$(rawdevs(x).hDevice)) ' GET THE MOUSE DEVICE ID
arrMouse(iMouseCount - 1).ID = strNextID ' SAVE THE MOUSE DEVICE ID
ElseIf rawdevs(x).dwType = RIM_TYPEKEYBOARD Then
iKeyBoardCount = iKeyBoardCount + 1 ' INCREMENT THE KEYBAORD COUNT
strNextID = _Trim$(Str$(rawdevs(x).hDevice)) ' GET THE KEYBOARD DEVICE ID
arrKeyIndex(iMouseCount - 1) = strNextID ' SAVE THE KEYBOARD DEVICE ID
arrLastKeyDown(iMouseCount - 1) = 0
' INITIALIZE THE KEY STATES FOR ALL KEY CODES FOR THIS KEYBOARD
for iLoop2 = 0 to 255
arrKeyboard(iMouseCount - 1, iLoop2) = FALSE
next iLoop2
End If
Next x
rawinputdevices = rawinputdevices + Chr$(0)
MemFree pRawInputDeviceList
Rid(0).usUsagePage = &H01
Rid(0).usUsage = &H02
Rid(0).dwFlags = 0
'Rid(0).hwndTarget = _WindowHandle
Rid(0).hwndTarget = 0
If RegisterRawInputDevices(Offset(Rid()), 1, Len(Rid(0))) = 0 Then
mousemessage = "RawInput init failed" + Chr$(0)
End If
End Sub ' InitRawInput
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END RAW INPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN MOUSE TEST FUNCTIONS #1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Initialize mouse test stuff
'TODO: SAVE_MOUSE_INFO
Sub InitMouseTest
Dim iIndex As Integer
Dim iLoop As Integer
' FOR NOW ONLY SUPPORT UPTO 8 MICE
If (iMouseCount > 8) Then iMouseCount = 8
' INITIALIZE CURSORS, MOUSE STATE, ETC.
Restore CData
iIndex = LBound(arrMouse) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrMouse(iIndex).c
arrMouse(iIndex).LeftDown = FALSE
arrMouse(iIndex).MiddleDown = FALSE
arrMouse(iIndex).RightDown = FALSE
arrMouse(iIndex).LeftCount = 0
arrMouse(iIndex).MiddleCount = 0
arrMouse(iIndex).RightCount = 0
Next iLoop
' INITIALIZE X COORDINATES
Restore XData
iIndex = LBound(arrMouse) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrMouse(iIndex).x
Next iLoop
' INITIALIZE Y COORDINATES
Restore YData
iIndex = LBound(arrMouse) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrMouse(iIndex).y
Next iLoop
' INITIALIZE SCROLL WHEEL
Restore WData
iIndex = LBound(arrMouse) - 1
For iLoop = 1 To iMouseCount
iIndex = iIndex + 1
Read arrMouse(iIndex).wheel
Next iLoop
End Sub ' InitMouseTest
' /////////////////////////////////////////////////////////////////////////////
' Finds position in array arrMouse where .ID = MouseID
Function GetMouseIndex% (MouseID As String)
Dim iLoop As Integer
Dim iIndex%
iIndex% = LBound(arrMouse) - 1
For iLoop = LBound(arrMouse) To UBound(arrMouse)
If arrMouse(iLoop).ID = MouseID Then
iIndex% = iLoop
Exit For
Else
' not it
End If
Next iLoop
GetMouseIndex% = iIndex%
End Function ' GetMouseIndex%
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END MOUSE TEST FUNCTIONS #1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN TEST OUTPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Clears global array arrScreen
Sub ClearText
Dim iColNum As Integer
Dim iRowNum As Integer
For iColNum = LBound(arrScreen, 1) To UBound(arrScreen, 1)
For iRowNum = LBound(arrScreen, 2) To UBound(arrScreen, 2)
arrScreen(iColNum, iRowNum) = " "
Next iRowNum
Next iColNum
End Sub ' ClearText
' /////////////////////////////////////////////////////////////////////////////
' Plots string MyString to position (iX, iY) in global array arrScreen.
Sub WriteText (iRow As Integer, iColumn As Integer, MyString As String)
Dim iPos As Integer
Dim iLoop As Integer
If iColumn > 0 And iColumn < 81 Then
If iRow > 0 And iRow < 26 Then
For iLoop = 1 To Len(MyString)
iPos = iColumn + (iLoop - 1)
If iPos < 81 Then
arrScreen(iPos, iRow) = Mid$(MyString, iLoop, 1)
Else
Exit For
End If
Next iLoop
End If
End If
End Sub ' WriteText
' /////////////////////////////////////////////////////////////////////////////
' Converts global array arrScreen to a string.
Function ScreenToString$
Dim sResult As String
Dim iColNum As Integer
Dim iRowNum As Integer
sResult = ""
For iRowNum = LBound(arrScreen, 2) To UBound(arrScreen, 2)
For iColNum = LBound(arrScreen, 1) To UBound(arrScreen, 1)
sResult = sResult + arrScreen(iColNum, iRowNum)
Next iColNum
sResult = sResult + Chr$(13)
Next iRowNum
ScreenToString$ = sResult
End Function ' ScreenToString$
' /////////////////////////////////////////////////////////////////////////////
' based on code from:
' Qbasic Programs - Download free bas source code
' http://www.thedubber.altervista.org/qbsrc.htm
Sub DrawTextLine (y%, x%, y2%, x2%, c$)
Dim i%
Dim steep%
Dim e%
Dim sx%
Dim dx%
Dim sy%
Dim dy%
i% = 0: steep% = 0: e% = 0
If (x2% - x%) > 0 Then sx% = 1: Else sx% = -1
dx% = Abs(x2% - x%)
If (y2% - y%) > 0 Then sy% = 1: Else sy% = -1
dy% = Abs(y2% - y%)
If (dy% > dx%) Then
steep% = 1
Swap x%, y%
Swap dx%, dy%
Swap sx%, sy%
End If
e% = 2 * dy% - dx%
For i% = 0 To dx% - 1
If steep% = 1 Then
''PSET (y%, x%), c%:
'Locate y%, x% : Print c$;
WriteText y%, x%, c$
Else
''PSET (x%, y%), c%
'Locate x%, y% : Print c$;
WriteText x%, y%, c$
End If
While e% >= 0
y% = y% + sy%: e% = e% - 2 * dx%
Wend
x% = x% + sx%: e% = e% + 2 * dy%
Next
''PSET (x2%, y2%), c%
'Locate x2%, y2% : Print c$;
WriteText x2%, y2%, c$
End Sub ' DrawTextLine
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END TEST OUTPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
Function join$ (in$(), delimiter$)
result$ = in$(LBound(in$))
For i = LBound(in$) + 1 To UBound(in$)
result$ = result$ + delimiter$ + in$(i)
Next i
join$ = result$
End Function ' join$
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
' Modified to handle multi-character delimiters
Sub split (in$, delimiter$, result$())
Dim start As Integer
Dim finish As Integer
Dim iDelimLen As Integer
ReDim result$(-1)
iDelimLen = Len(delimiter$)
start = 1
Do
'While Mid$(in$, start, 1) = delimiter$
While Mid$(in$, start, iDelimLen) = delimiter$
'start = start + 1
start = start + iDelimLen
If start > Len(in$) Then
Exit Sub
End If
Wend
finish = InStr(start, in$, delimiter$)
If finish = 0 Then
finish = Len(in$) + 1
End If
ReDim _Preserve result$(0 To UBound(result$) + 1)
result$(UBound(result$)) = Mid$(in$, start, finish - start)
start = finish + 1
Loop While start <= Len(in$)
End Sub ' split
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' found at abandoned, outdated and now likely malicious qb64 dot net website
' http://www.qb64.[net]/forum/index_topic_5964-0/
'
'SUMMARY:
' Purpose: A library of custom functions that transform strings.
' Author: Dustinian Camburides (dustinian@gmail.com)
' Platform: QB64 (www.qb64.org)
' Revision: 1.6
' Updated: 5/28/2012
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
' VARIABLES:
Dim Text2 As String
Dim Find2 As String
Dim Add2 As String
Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
Dim strBefore As String ' The characters before the string to be replaced.
Dim strAfter As String ' The characters after the string to be replaced.
' INITIALIZE:
' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
Text2 = Text1
Find2 = Find1
Add2 = Add1
lngLocation = InStr(1, Text2, Find2)
' PROCESSING:
' While [Find2] appears in [Text2]...
While lngLocation
' Extract all Text2 before the [Find2] substring:
strBefore = Left$(Text2, lngLocation - 1)
' Extract all text after the [Find2] substring:
strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
' Return the substring:
Text2 = strBefore + Add2 + strAfter
' Locate the next instance of [Find2]:
lngLocation = InStr(1, Text2, Find2)
' Next instance of [Find2]...
Wend
' OUTPUT:
Replace$ = Text2
End Function ' Replace$
'' /////////////////////////////////////////////////////////////////////////////
'
'Sub SplitTest
' Dim in$
' Dim delim$
' ReDim arrTest$(0)
' Dim iLoop%
'
' delim$ = Chr$(10)
' in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
' Print "in$ = " + Chr$(34) + in$ + Chr$(34)
' Print "delim$ = " + Chr$(34) + delim$ + Chr$(34)
' split in$, delim$, arrTest$()
'
' For iLoop% = LBound(arrTest$) To UBound(arrTest$)
' Print "arrTest$(" + LTrim$(RTrim$(Str$(iLoop%))) + ") = " + Chr$(34) + arrTest$(iLoop%) + Chr$(34)
' Next iLoop%
' Print
' Print "Split test finished."
'End Sub ' SplitTest
'' /////////////////////////////////////////////////////////////////////////////
'
'Sub SplitAndReplaceTest
' Dim in$
' Dim out$
' Dim iLoop%
' ReDim arrTest$(0)
'
' Print "-------------------------------------------------------------------------------"
' Print "SplitAndReplaceTest"
' Print
'
' Print "Original value"
' in$ = "This line 1 " + Chr$(13) + Chr$(10) + "and line 2" + Chr$(10) + "and line 3 " + Chr$(13) + "finally THE END."
' out$ = in$
' out$ = Replace$(out$, Chr$(13), "\r")
' out$ = Replace$(out$, Chr$(10), "\n")
' out$ = Replace$(out$, Chr$(9), "\t")
' Print "in$ = " + Chr$(34) + out$ + Chr$(34)
' Print
'
' Print "Fixing linebreaks..."
' in$ = Replace$(in$, Chr$(13) + Chr$(10), Chr$(13))
' in$ = Replace$(in$, Chr$(10), Chr$(13))
' out$ = in$
' out$ = Replace$(out$, Chr$(13), "\r")
' out$ = Replace$(out$, Chr$(10), "\n")
' out$ = Replace$(out$, Chr$(9), "\t")
' Print "in$ = " + Chr$(34) + out$ + Chr$(34)
' Print
'
' Print "Splitting up..."
' split in$, Chr$(13), arrTest$()
'
' For iLoop% = LBound(arrTest$) To UBound(arrTest$)
' out$ = arrTest$(iLoop%)
' out$ = Replace$(out$, Chr$(13), "\r")
' out$ = Replace$(out$, Chr$(10), "\n")
' out$ = Replace$(out$, Chr$(9), "\t")
' Print "arrTest$(" + cstr$(iLoop%) + ") = " + Chr$(34) + out$ + Chr$(34)
' Next iLoop%
' Print
'
' Print "SplitAndReplaceTest finished."
'End Sub ' SplitAndReplaceTest
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN handle MEM for any type
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' QB64 GPT Just Rewrote My Code
' https://qb64phoenix.com/forum/showthread.php?tid=2728
' And the revisions QB64 GPT made (after minor changes and me asking it to redo some syntax errors):
' It separated out a lot of processing out to separate subs.
' It is quite impressive how little input I had to give it to fix its mistakes.
' The code actually worked just as well as it did before the changes, which blows my mind.
' It actually even listened to me when I told it that it would need to cast an OFFSET type by using VAL(STR$(var)).
' To be fair, I had to tell it "ByRef" was invalid and a couple of other things.
' I also had to declare "y" each time it was used. But the last iteration only required me to declare "y".
' I think that is a decent enough result. Too bad I can't get it to be this good every time.
' 1) This is the paid version of GPT4. I am on the plus plan, so whatever that one has.
' 2) I think I deleted the session. Sorry. I only used it for as long as I needed it.
' 3) I don't know what the hard limit is. It's in "tokens", which I have no idea how those are calculated.
' I got a pretty large source code from one output and it can take a lot of input. I would just say it can handle quite a bit.
' The GPT I used was one I trained using the Wiki, sample code, etc. At the time, it used GPT4.
' Custom GPTs now use 4o. I will probably need to republish it to take advantage of 4o for it.
' I guess training is the wrong word. A custom GPT has a "knowledge base".
' You can have a maximum of 20 files.
' It can use those files to create an answer. Even a zip folder can be used.
' It will basically only use the knowledge base when specifically asked. Otherwise, it is using whatever it already had in its model.
' As for testing code and such, you can create "actions" for your GPT that allow it to do things outside of ChatGPT, including REST API.
' So if dbox ever made a REST API for QBJS, you could definitely have it write QBJS code and then ask it to run it.
Sub anyArg (args() As _MEM)
Dim As _Unsigned Integer x, y
Dim As _Unsigned _Offset z
Dim As _Unsigned Long size, elementsize
For x = LBound(args) To UBound(args)
If _MemExists(args(x)) Then
z = 0
size = Val(Str$(args(x).SIZE))
elementsize = Val(Str$(args(x).ELEMENTSIZE))
If _ReadBit(args(x).TYPE, 7) And _ReadBit(args(x).TYPE, 13) = 0 Then
HandleNumericType args(x), size, elementsize, z
ElseIf _ReadBit(args(x).TYPE, 8) Then
HandleFloatingType args(x), size, elementsize, z
ElseIf _ReadBit(args(x).TYPE, 9) Then
HandleStringType args(x), size, elementsize
ElseIf _ReadBit(args(x).TYPE, 13) And _ReadBit(args(x).TYPE, 7) Then
HandleOffsetType args(x), size, elementsize, z
ElseIf args(x).TYPE = 0 And args(x).SIZE > 0 Then
HandleSoundType args(x)
ElseIf _ReadBit(args(x).TYPE, 14) Then
Print args(x).SIZE, "MEM"
' TODO: Handle other types if necessary
End If
If _ReadBit(args(x).TYPE, 11) Then
Screen args(x).IMAGE
End If
End If
Next
End Sub ' anyArg
' Subroutines for handling specific types
Sub HandleNumericType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)
If _ReadBit(arg.TYPE, 10) Then
If _ReadBit(arg.TYPE, 16) Then
Select Case elementsize
Case 1
Dim As _Unsigned _Byte unsignedbytearray(1 To (size / elementsize))
ProcessArray_UByte unsignedbytearray(), arg, size, elementsize, z, "UBYTE ARRAY"
Case 2
Dim As _Unsigned Integer unsignedintarray(1 To (size / elementsize))
ProcessArray_UInteger unsignedintarray(), arg, size, elementsize, z, "USHORT ARRAY"
Case 4
Dim As _Unsigned Long unsignedlongarray(1 To (size / elementsize))
ProcessArray_ULong unsignedlongarray(), arg, size, elementsize, z, "ULONG ARRAY"
Case 8
Dim As _Unsigned _Integer64 unsignedint64array(1 To (size / elementsize))
ProcessArray_UInt64 unsignedint64array(), arg, size, elementsize, z, "UINT64 ARRAY"
End Select
Else
PrintSingleValue arg, size, elementsize
End If
Else
If _ReadBit(arg.TYPE, 16) Then
Select Case elementsize
Case 1
Dim As _Byte bytearray(1 To (size / elementsize))
ProcessArray_Byte bytearray(), arg, size, elementsize, z, "BYTE ARRAY"
Case 2
Dim As Integer intarray(1 To (size / elementsize))
ProcessArray_Integer intarray(), arg, size, elementsize, z, "SHORT ARRAY"
Case 4
Dim As Long longarray(1 To (size / elementsize))
ProcessArray_Long longarray(), arg, size, elementsize, z, "LONG ARRAY"
Case 8
Dim As _Integer64 int64array(1 To (size / elementsize))
ProcessArray_Int64 int64array(), arg, size, elementsize, z, "INT64 ARRAY"
End Select
Else
PrintSingleValue arg, size, elementsize
End If
End If
End Sub ' HandleNumericType
Sub HandleFloatingType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)
If _ReadBit(arg.TYPE, 16) Then
Select Case elementsize
Case 4
Dim As Single singlearray(1 To (size / elementsize))
ProcessArray_Single singlearray(), arg, size, elementsize, z, "SINGLE ARRAY"
Case 8
Dim As Double doublearray(1 To (size / elementsize))
ProcessArray_Double doublearray(), arg, size, elementsize, z, "DOUBLE ARRAY"
Case 32
Dim As _Float floatarray(1 To (size / elementsize))
ProcessArray_Float floatarray(), arg, size, elementsize, z, "FLOAT ARRAY"
End Select
Else
Select Case size
Case 4
Print _MemGet(arg, arg.OFFSET, Single), "SINGLE"
Case 8
Print _MemGet(arg, arg.OFFSET, Double), "DOUBLE"
Case 32
Print _MemGet(arg, arg.OFFSET, _Float), "FLOAT"
End Select
End If
End Sub ' HandleFloatingType
Sub HandleStringType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long)
If _ReadBit(arg.TYPE, 16) Then
Dim As String stringarray(1 To (size / elementsize))
Dim As _Unsigned Long y
For y = LBound(stringarray) To UBound(stringarray)
stringarray(y) = Space$(elementsize)
_MemGet arg, (arg.OFFSET) + (y * elementsize - elementsize), stringarray(y)
Print stringarray(y), "STRING ARRAY"
Next
Else
Dim As String stringtest: stringtest = Space$(elementsize)
_MemGet arg, arg.OFFSET, stringtest
Print stringtest
End If
End Sub ' HandleStringType
Sub HandleOffsetType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)
If _ReadBit(arg.TYPE, 10) Then
If _ReadBit(arg.TYPE, 16) Then
Dim As _Unsigned _Offset unsignedoffsetarray(1 To (size / elementsize))
ProcessArray_UOffset unsignedoffsetarray(), arg, size, elementsize, z, "ULONG_PTR ARRAY"
Else
Print _MemGet(arg, arg.OFFSET, _Unsigned _Offset), "ULONG_PTR"
End If
Else
If _ReadBit(arg.TYPE, 16) Then
Dim As _Offset offsetarray(1 To (size / elementsize))
ProcessArray_Offset offsetarray(), arg, size, elementsize, z, "LONG_PTR ARRAY"
Else
Print _MemGet(arg, arg.OFFSET, _Offset), "LONG_PTR"
End If
End If
End Sub ' HandleOffsetType
Sub HandleSoundType (arg As _MEM)
If Not _SndPlaying(arg.SOUND) Then
_SndPlay (arg.SOUND)
End If
Print "SOUND", arg.SIZE, arg.ELEMENTSIZE
End Sub ' HandleSoundType
' Subroutines for processing arrays
Sub ProcessArray_UByte (unsignedbytearray() As _Unsigned _Byte, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(unsignedbytearray) To UBound(unsignedbytearray)
_MemGet arg, arg.OFFSET + z, unsignedbytearray(y)
z = z + elementsize
Print unsignedbytearray(y), typeName
Next
End Sub ' ProcessArray_UByte
Sub ProcessArray_UInteger (unsignedintarray() As _Unsigned Integer, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(unsignedintarray) To UBound(unsignedintarray)
_MemGet arg, arg.OFFSET + z, unsignedintarray(y)
z = z + elementsize
Print unsignedintarray(y), typeName
Next
End Sub ' ProcessArray_UInteger
Sub ProcessArray_ULong (unsignedlongarray() As _Unsigned Long, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(unsignedlongarray) To UBound(unsignedlongarray)
_MemGet arg, arg.OFFSET + z, unsignedlongarray(y)
z = z + elementsize
Print unsignedlongarray(y), typeName
Next
End Sub ' ProcessArray_ULong
Sub ProcessArray_UInt64 (unsignedint64array() As _Unsigned _Integer64, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(unsignedint64array) To UBound(unsignedint64array)
_MemGet arg, arg.OFFSET + z, unsignedint64array(y)
z = z + elementsize
Print unsignedint64array(y), typeName
Next
End Sub ' ProcessArray_UInt64
Sub ProcessArray_Byte (bytearray() As _Byte, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(bytearray) To UBound(bytearray)
_MemGet arg, arg.OFFSET + z, bytearray(y)
z = z + elementsize
Print bytearray(y), typeName
Next
End Sub ' ProcessArray_Byte
Sub ProcessArray_Integer (intarray() As Integer, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(intarray) To UBound(intarray)
_MemGet arg, arg.OFFSET + z, intarray(y)
z = z + elementsize
Print intarray(y), typeName
Next
End Sub ' ProcessArray_Integer
Sub ProcessArray_Long (longarray() As Long, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(longarray) To UBound(longarray)
_MemGet arg, arg.OFFSET + z, longarray(y)
z = z + elementsize
Print longarray(y), typeName
Next
End Sub ' ProcessArray_Long
Sub ProcessArray_Int64 (int64array() As _Integer64, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(int64array) To UBound(int64array)
_MemGet arg, arg.OFFSET + z, int64array(y)
z = z + elementsize
Print int64array(y), typeName
Next
End Sub ' ProcessArray_Int64
Sub ProcessArray_Single (singlearray() As Single, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(singlearray) To UBound(singlearray)
_MemGet arg, arg.OFFSET + z, singlearray(y)
z = z + elementsize
Print singlearray(y), typeName
Next
End Sub ' ProcessArray_Single
Sub ProcessArray_Double (doublearray() As Double, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(doublearray) To UBound(doublearray)
_MemGet arg, arg.OFFSET + z, doublearray(y)
z = z + elementsize
Print doublearray(y), typeName
Next
End Sub ' ProcessArray_Double
Sub ProcessArray_Float (floatarray() As _Float, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(floatarray) To UBound(floatarray)
_MemGet arg, arg.OFFSET + z, floatarray(y)
z = z + elementsize / 2
Print floatarray(y), typeName
Next
End Sub ' ProcessArray_Float
Sub ProcessArray_UOffset (unsignedoffsetarray() As _Unsigned _Offset, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(unsignedoffsetarray) To UBound(unsignedoffsetarray)
_MemGet arg, arg.OFFSET + z, unsignedoffsetarray(y)
z = z + elementsize
Print unsignedoffsetarray(y), typeName
Next
End Sub ' ProcessArray_UOffset
Sub ProcessArray_Offset (offsetarray() As _Offset, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)
Dim As _Unsigned Long y
For y = LBound(offsetarray) To UBound(offsetarray)
_MemGet arg, arg.OFFSET + z, offsetarray(y)
z = z + elementsize
Print offsetarray(y), typeName
Next
End Sub ' ProcessArray_Offset
Sub PrintSingleValue (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long)
Select Case size
Case 1
Print _MemGet(arg, arg.OFFSET, _Byte), "BYTE"
Case 2
Print _MemGet(arg, arg.OFFSET, Integer), "SHORT"
Case 4
Print _MemGet(arg, arg.OFFSET, Long), "LONG"
Case 8
Print _MemGet(arg, arg.OFFSET, _Integer64), "INT64"
End Select
End Sub ' PrintSingleValue
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END handle MEM for any type
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Posts: 719
Threads: 28
Joined: Apr 2022
Reputation:
38
06-06-2024, 05:48 PM
(This post was last modified: 06-06-2024, 06:01 PM by SpriggsySpriggs.)
I hate to say it but I am lost looking at your code :/
I will say the reason you couldn't get WS_OVERLAPPEDWINDOW to work is because you had some of the constants it depends on declared after it. I moved them to before it and that constant is fine. Since you are only caring about mice in your program, you should probably forget trying to process the keyboard with rawinput. I think you are causing yourself headaches with trying to make that struct work for both mice and keyboards. I'd stick to using rawinput to monitor multiple mice but using built-in stuff for the keyboard.
As for the sizeof() and OFFSETOF() stuff, here's what you need to do (even though it is time-consuming and monotonous):
1) Take every struct you are using and put them in a C header file.
2) Output sizeof(your_struct_name_here) to the console window. This tells you the size of the struct.
3) Output the length of the QB64 type by printing LEN(your_type_name_here) to the console window. If the numbers do not match, you are missing alignment or a critical member.
4) Use OFFSETOF() for each member of the struct. The number tells you where the member falls in the struct. If the positioning of the struct member doesn't match the position of the type member, you need alignment of however many bytes difference. You can figure out the position of the member by either manually counting or by using OFFSET() in QB64 and figuring out the difference between the start of the TYPE and the location of the member.
Sometimes you can cheese it and take a guess by knowing you need 8 bytes for each "block" in a struct on 64 bit and 4 bytes for 32. However, I don't recommend this. Just follow these quickly written steps to victory.
Tread on those who tread on you
|
