(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
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++