09-07-2022, 06:21 PM
(09-07-2022, 03:18 PM)Spriggsy Wrote: Adding this reply as a way to keep track of this source as I work on converting what you've done so far. I'll have to pull up my Win32 Video Player code to bring in all my junk for the callbacks and window functions but the InitRawInput function works as expected
Code: (Select All)Option Explicit
$NoPrefix
$Console:Only
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
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 GetLastError~& ()
End Declare
InitRawInput
Sub InitRawInput ()
Dim As RAWINPUTDEVICE Rid(0 To 49)
Dim As Unsigned Long nDevices
Dim As RAWINPUTDEVICELIST RawInputDeviceList
If GetRawInputDeviceList(0, Offset(nDevices), Len(RawInputDeviceList)) <> 0 Then
Exit Sub
End If
Dim As MEM pRawInputDeviceList: 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
'Dim As RAWINPUTDEVICELIST rawdevs(0 To nDevices - 1)
'MemGet pRawInputDeviceList, pRawInputDeviceList.OFFSET, rawdevs()
'Dim As Unsigned Long x
'For x = 0 To UBound(rawdevs)
' Print rawdevs(x).hDevice, rawdevs(x).dwType
'Next
Print "Number of raw input devices:" + Str$(nDevices)
MemFree pRawInputDeviceList
Rid(0).usUsagePage = &H01
Rid(0).usUsage = &H02
Rid(0).dwFlags = 0
Rid(0).hwndTarget = 0
If RegisterRawInputDevices(Offset(Rid()), 1, Len(Rid(0))) = 0 Then
Print "RawInput init failed:"
End If
End Sub
We talked about this a while back, and I found this code on my PC, named "manymouse.SpriggsySpriggs.20210331_123656.bas".
I don't think I ever got it working, but I see some RAWINPUT and RAWMOUSE declarations in there, that might be used for this...
Any recollection of any of this?
Code: (Select All)
Option _Explicit
$Console:Only
Declare CustomType Library
Function LoadLibrary%& (lpLibFileName As String)
Function GetProcAddress%& (ByVal hModule As _Offset, lpProcName As String)
Sub FreeLibrary (ByVal hLibModule As _Offset)
Sub InitializeCriticalSection (ByVal lpCriticalSection As _Offset)
Sub EnterCriticalSection (ByVal lpCriticalSection As _Offset)
Sub LeaveCriticalSection (ByVal lpCriticalSection As _Offset)
Function GetRawInputData~& (ByVal hRawInput As _Offset, Byval uiCommand As _Unsigned Long, Byval pData As _Offset, Byval pcbSize As _Offset, Byval cbSize As _Unsigned Long)
Function DefWindowProc%& Alias "DefWindowProcA" (ByVal hWnd As _Offset, Byval Msg As _Unsigned Long, Byval wParam As _Unsigned _Offset, Byval lParam As _Offset)
Function GetModuleHandle%& Alias "GetModuleHandleA" (ByVal lpModuleName As _Offset)
Function RegisterClass% Alias "RegisterClassExA" (ByVal unnamedParam1 As _Offset)
Function CreateWindow%& Alias "CreateWindowExA" (ByVal dwExStyle As Long, Byval lpClassName As _Offset, Byval lpWindowName As _Offset, Byval dwStyle As 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)
End Declare
Declare Dynamic Library "Kernel32"
Sub CopyMemory Alias "RtlCopyMemory" (ByVal Destination As _Offset, Byval Source As _Offset, Byval Length As _Offset)
End Declare
Const WIN32_WINNT = &H0501
Const WM_INPUT = &H00FF
Const MAX_MICE = 32
Const MAX_EVENTS = 1024
Const RIM_TYPEMOUSE = 0
Const MOUSE_MOVE_ABSOLUTE = 1
Const MANYMOUSE_EVENT_ABSMOTION = 0
Const MANYMOUSE_EVENT_RELMOTION = 1
Const MANYMOUSE_EVENT_BUTTON = 2
Const MANYMOUSE_EVENT_SCROLL = 3
Const MANYMOUSE_EVENT_DISCONNECT = 4
Const MANYMOUSE_EVENT_MAX = 5
Const RI_MOUSE_WHEEL = &H0400
Const RID_HEADER = &H10000005
Const RID_INPUT = &H10000003
Const WM_INPUT = &H00FF
Const WM_DESTROY = &H0002
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_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Const CW_USEDEFAULT = &H80000000
Const HWND_MESSAGE = -3
Type LIST_ENTRY
As _Offset Flink, Blink
End Type
Type RTL_CRITICAL_SECTION_DEBUG
As Integer Type, CreatorBackTraceIndex
As _Offset CriticalSection
As LIST_ENTRY ProcessLocksList
As _Unsigned Long EntryCount, ContentionCount, Flags
As Integer CreatorBackTraceIndexHigh, SpareUSHORT
End Type
Type CRITICAL_SECTION
As _Offset DebugInfo
As Long LockCount, RecursionCount
As _Offset OwningThread, LockSemaphore
As _Unsigned Long SpinCount
End Type
Type ManyMouseEvent
As Long type
As _Unsigned Long device, item
As Long value, minval, maxval
End Type
Type MouseStruct
As _Offset handle
As String * 256 name
End Type
Type RAWINPUTHEADER
As Long dwType, dwSize
As _Offset hDevice
As _Unsigned _Offset wParam
End Type
Type RAWMOUSE
As _Unsigned Integer usFlags, 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
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 RAWINPUTDEVICE
As _Unsigned Integer usUsagePage, usUsage
As Long dwFlags
As _Offset hwndTarget
End Type
Dim Shared As ManyMouseEvent input_events(MAX_EVENTS)
Dim Shared As Long input_events_read
Dim Shared As Long input_events_write
Dim Shared As Long available_mice
Dim Shared As Long did_api_lookup
Dim Shared As _Offset raw_hwnd
Dim Shared As String class_name: class_name = "ManyMouseRawInputCatcher"
Dim Shared As String win_name: win_name = "ManyMouseRawInputMsgWindow"
Dim Shared As Integer class_atom
Dim Shared As CRITICAL_SECTION mutex
Dim Shared As _Offset hWnd
Dim Shared As _Unsigned Long Msg
Dim Shared As _Unsigned _Offset wParam
Dim Shared As _Offset lParam
Dim Shared As MouseStruct mice(MAX_MICE)
Print find_api_symbols
Sleep
Function symlookup%& (dll As _Offset, sym As String) Static
Dim As _Offset addr
addr = GetProcAddress(dll, sym)
If addr = 0 Then
Call FreeLibrary(dll)
symlookup = 0
Exit Function
End If
symlookup = addr
Exit Function
End Function
Function find_api_symbols& () Static
FunctionList:
Data "GetRawInputDeviceInfoA","RegisterRawInputDevices","GetRawInputDeviceList","DefRawInputProc","GetRawInputBuffer","GetRawInputData","CreateWindowExA"
Data "RegisterClassExA","UnregisterClassA","DefWindowProcA","PeekMessageA","TranslateMessage","DispatchMessageA","DestroyWindow","GetModuleHandleA"
Data "GetLastError","InitializeCriticalSection","EnterCriticalSection","LeaveCriticalSection","DeleteCriticalSection","SetupDiGetClassDevsA","SetupDiEnumDeviceInfo"
Data "SetupDiGetDeviceInstantIdA","SetupDiGetDeviceRegistryPropertyA","SetupDiDestroyDeviceInfoList"
dllList:
Data "user32.dll","kernel32.dll","setupapi.dll"
Dim As _Offset dll
If did_api_lookup Then
find_api_symbols = 1
Exit Function
End If
Dim As String dllList(1 To 3), functionList(1 To 25)
Dim As Integer x, y
Restore dllList
For x = 1 To 3
Read dllList(x)
Next
Restore FunctionList
For x = 1 To 25
Read functionList(x)
Next
x = 1
y = 1
Do
If y = 15 Then x = 2
If y = 21 Then x = 3
dll = LoadLibrary(dllList(x))
If symlookup(dll, functionList(y)) <> 0 Then
If dll = 0 Then
find_api_symbols = 0
Exit Function
End If
End If
'Print dllList(x), functionList(y), dll
y = y + 1
Loop Until y = 25
did_api_lookup = 1
find_api_symbols = 1
End Function
Sub queue_event (event As ManyMouseEvent) Static
Call CopyMemory(_Offset(input_events(input_events_write)), _Offset(event), Len(event))
input_events_write = (input_events_write + 1) Mod MAX_EVENTS
If input_events_write = input_events_read Then
input_events_read = (input_events_read + 1) Mod MAX_EVENTS
End If
End Sub
Sub queue_from_rawinput (raw As RAWINPUT) Static
Dim As Long i
Dim As RAWINPUTHEADER header: header = raw.header
Dim As RAWMOUSE mouse: mouse = raw.mouse
Dim As ManyMouseEvent event
If raw.header.dwType <> RIM_TYPEMOUSE Then
Exit Sub
End If
For i = 0 To available_mice
If mice(i).handle = header.hDevice Then Exit For
Next
If i = available_mice Then Exit Sub
event.device = i
Call EnterCriticalSection(_Offset(mutex))
If mouse.usFlags And MOUSE_MOVE_ABSOLUTE Then
event.type = MANYMOUSE_EVENT_ABSMOTION
event.item = 0
event.value = mouse.lLastX
Call queue_event(event)
Else
event.type = MANYMOUSE_EVENT_RELMOTION
If mouse.lLastX <> 0 Then
event.item = 0
event.value = mouse.lLastX
Call queue_event(event)
End If
If mouse.lLastY <> 0 Then
event.item = 1
event.value = mouse.lLastY
Call queue_event(event)
End If
End If
event.type = MANYMOUSE_EVENT_BUTTON
RI_MOUSE_BUTTON:
Data &H0001,&H0002,&H0004,&H0008,&H0010,&H0020,&H0040,&H0080,&H0100,&H0200
Dim As Integer x
Dim As Long MOUSE_BUTTON
Restore RI_MOUSE_BUTTON
For x = 1 To 5
Read MOUSE_BUTTON
If mouse.usButtonFlags And MOUSE_BUTTON Then
event.item = MOUSE_BUTTON - 1
event.value = 1
Call queue_event(event)
End If
Read MOUSE_BUTTON
If mouse.usButtonFlags And MOUSE_BUTTON Then
event.item = MOUSE_BUTTON - 1
event.value = 0
Call queue_event(event)
End If
Next
If mouse.usButtonFlags And RI_MOUSE_WHEEL Then
If mouse.usButtonData <> 0 Then
event.type = MANYMOUSE_EVENT_SCROLL
event.item = 0
If mouse.usButtonData > 0 Then event.value = 1 Else event.value = -1
Call queue_event(event)
End If
End If
Call LeaveCriticalSection(_Offset(mutex))
End Sub
Sub wminput_handler (wParam As _Unsigned _Offset, lParam As _Offset) Static
Dim As _Unsigned Long dwSize, getrawinput
Dim As RAWINPUT lpb
Dim As RAWINPUTHEADER rawinputheader
getrawinput = GetRawInputData(lParam, RID_INPUT, 0, _Offset(dwSize), Len(rawinputheader))
If dwSize < Len(rawinputheader) Then Exit Sub
If GetRawInputData(lParam, RID_INPUT, _Offset(lpb), _Offset(dwSize), Len(rawinputheader)) <> dwSize Then Exit Sub
Call queue_from_rawinput(lpb)
End Sub
Function RawWndProc%& Static
If Msg = WM_INPUT Then
Call wminput_handler(wParam, lParam)
ElseIf Msg = WM_DESTROY Then
RawWndProc = 0
Exit Function
End If
RawWndProc = DefWindowProc(hWnd, Msg, wParam, lParam)
End Function
Function init_event_queue& () Static
Dim As _Offset hInstance: hInstance = GetModuleHandle(0)
Dim As WNDCLASSEX wce
Dim As RAWINPUTDEVICE rid
input_events_read = 0: input_events_write = 0
wce.cbSize = Len(wce)
wce.lpfnWndProc = RawWndProc
wce.lpszClassName = _Offset(class_name)
wce.hInstance = hInstance
class_atom = RegisterClass(_Offset(wce))
If class_atom = 0 Then Exit Function
raw_hwnd = CreateWindow(0, _Offset(class_name), _Offset(win_name), WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, HWND_MESSAGE, 0, hInstance, 0)
If raw_hwnd = 0 Then
init_event_queue = 0
Exit Function
End If
Call InitializeCriticalSection(_Offset(mutex))
'Got more junk to write here. Good grief. Left off on line 374 of windows_wminput.c
End Function