kind of works? reading multiple mice: any c programmers want to look at this?

[SpriggsySpriggs]

I have yet again made another edit to the code. This version now prints the device handles and types to the screen as well as displays the X, Y coordinates from WM_MOUSEMOVE.

Code: (Select All)

Option Explicit
$NoPrefix
$Console:Only
Console Off

Const CS_HREDRAW = &H0002
Const CS_VREDRAW = &H0001

Const IDI_APPLICATION = 32512
Const IDC_ARROW = 32512
Const COLOR_WINDOW = 5

Const WS_OVERLAPPED = &H00000000
Const WS_CAPTION = &H00C00000
Const WS_SYSMENU = &H00080000
Const WS_THICKFRAME = &H00040000
Const WS_MINIMIZEBOX = &H00020000
Const WS_MAXIMIZEBOX = &H00010000
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Const CW_USEDEFAULT = &H80000000

Const WM_DESTROY = &H0002
Const WM_INPUT = &H00FF

Const SW_SHOW = 5

Const RID_INPUT = &H10000003
Const RIM_TYPEMOUSE = 0

Const MOUSE_MOVE_RELATIVE = &H00
Const MOUSE_MOVE_ABSOLUTE = &H01
Const MOUSE_VIRTUAL_DESKTOP = &H02
Const MOUSE_ATTRIBUTES_CHANGED = &H04
Const MOUSE_MOVE_NOCOALESCE = &H08

Const WM_MOUSEMOVE = &H0200

Const WM_PAINT = &H000F

Const DT_CENTER = &H00000001

Type RAWINPUTDEVICE
    As Unsigned Integer usUsagePage, usUsage
    As Unsigned Long dwFlags
    As Offset hwndTarget
End Type

Type RAWINPUTDEVICELIST
    As Offset hDevice
    As Unsigned Long dwType
    $If 64BIT Then
        As String * 4 alignment
    $End If
End Type

Type POINT
    As Long x, y
End Type

Type MSG
    As Offset hwnd
    As Unsigned Long message
    As Unsigned Offset wParam
    As Offset lParam
    As Long time
    As POINT pt
    As Long lPrivate
End Type

Type WNDCLASSEX
    As Unsigned Long cbSize, style
    As Offset lpfnWndProc
    As Long cbClsExtra, cbWndExtra
    As Offset hInstance, hIcon, hCursor, hbrBackground, lpszMenuName, lpszClassName, hIconSm
End Type

Type RECT
    As Long left, top, right, bottom
End Type

Type PAINTSTRUCT
    As Offset hdc
    As Long fErase
    $If 64BIT Then
        As String * 4 alignment
    $End If
    As RECT rcPaint
    As Long fRestore, fIncUpdate
    As String * 32 rgbReserved
End Type

Type RAWINPUTHEADER
    As Unsigned Long dwType, dwSize
    As Offset hDevice
    As Unsigned Offset wParam
End Type

Type RAWMOUSE
    As Unsigned Integer usFlags
    $If 64BIT Then
        As String * 2 alignment
    $End If
    'As Unsigned Long ulButtons  'commented out because I'm creating this value using MAKELONG
    As Unsigned Integer usButtonFlags, usButtonData
    As Unsigned Long ulRawButtons
    As Long lLastX, lLastY
    As Unsigned Long ulExtraInformation
End Type

Type RAWINPUT
    As RAWINPUTHEADER header
    As RAWMOUSE mouse
End Type

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

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

Declare Library "winproc"
    Function WindowProc%& ()
End Declare

Dim Shared As String mousemessage, rawinputdevices

System Val(Str$(WinMain))

Function MainWndProc%& (hwnd As Offset, nMsg As Unsigned Long, wParam As Unsigned Offset, lParam As Offset)
    Static As Offset hwndButton
    Static As Long cx, cy

    Dim As Offset hdc
    Dim As PAINTSTRUCT ps
    Dim As RECT rc

    Dim As MEM lpb
    Dim As Unsigned Long dwSize
    Dim As RAWINPUT raw
    Dim As Long tmpx, tmpy

    Static As Long maxx
    Select Case nMsg
        Case WM_DESTROY
            PostQuitMessage 0
            MainWndProc = 0
            Exit Function
        Case WM_INPUT
            Dim As RAWINPUTHEADER rih
            GetRawInputData lParam, RID_INPUT, 0, Offset(dwSize), Len(rih)

            lpb = MemNew(dwSize)
            If lpb.SIZE = 0 Then
                MainWndProc = 0
                Exit Function
            End If

            If GetRawInputData(lParam, RID_INPUT, lpb.OFFSET, Offset(dwSize), Len(rih)) <> dwSize Then
                Print "GetRawInputData doesn't return correct size!"
            End If

            MemGet lpb, lpb.OFFSET, raw
            If raw.header.dwType = RIM_TYPEMOUSE Then
                tmpx = raw.mouse.lLastX
                tmpy = raw.mouse.lLastY
                maxx = tmpx
                mousemessage = "Mouse:hDevice" + Str$(raw.header.hDevice) + " usFlags=" + Hex$(raw.mouse.usFlags)
                mousemessage = mousemessage + " ulButtons=" + Hex$(MAKELONG(raw.mouse.usButtonFlags, raw.mouse.usFlags))
                mousemessage = mousemessage + " usButtonFlags=" + Hex$(raw.mouse.usButtonFlags) + " usButtonData=" + Hex$(raw.mouse.usButtonData)
                mousemessage = mousemessage + " ulRawButtons=" + Hex$(raw.mouse.ulRawButtons) + " lLastX=" + Str$(raw.mouse.lLastX)
                mousemessage = mousemessage + " lLastY=" + Str$(raw.mouse.lLastY) + " ulExtraInformation=" + Hex$(raw.mouse.ulExtraInformation) + Chr$(13)
            End If
            MemFree lpb

            MainWndProc = 0
            Exit Function
        Case WM_MOUSEMOVE
            mousemessage = mousemessage + "X:" + Str$(GET_X_LPARAM(lParam))
            mousemessage = mousemessage + " Y:" + Str$(GET_Y_LPARAM(lParam))
            mousemessage = mousemessage + Chr$(0)
            InvalidateRect hwnd, 0, -1
            SendMessage hwnd, WM_PAINT, 0, 0

            MainWndProc = 0
            Exit Function
        Case WM_PAINT
            hdc = BeginPaint(hwnd, Offset(ps))

            GetClientRect hwnd, Offset(rc)
            DrawText hdc, Offset(mousemessage), Len(mousemessage), Offset(rc), DT_CENTER
            OffsetRect Offset(rc), 0, 200
            DrawText hdc, Offset(rawinputdevices), Len(rawinputdevices), Offset(rc), DT_CENTER
            EndPaint hwnd, Offset(ps)
            MainWndProc = 0
            Exit Function
        Case Else
            MainWndProc = DefWindowProc(hwnd, nMsg, wParam, lParam)
    End Select
End Function

Function WinMain~%& ()
    Dim As Offset hwndMain, hInst: hInst = GetModuleHandle(0)
    Dim As MSG msg
    Dim As WNDCLASSEX wndclass

    Dim As String szMainWndClass: szMainWndClass = "WinTestWin" + Chr$(0)
    Dim As String szWinTitle: 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

    Dim As Unsigned Integer reg: reg = RegisterClassEx(Offset(wndclass)) 'I prefer to use the output of RegisterClassEx rather than the window name

    hwndMain = CreateWindowEx(0, MAKELPARAM(reg, 0), Offset(szWinTitle), WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, hInst, 0)

    ShowWindow hwndMain, SW_SHOW
    UpdateWindow hwndMain

    InitRawInput

    While GetMessage(Offset(msg), 0, 0, 0)
        TranslateMessage Offset(msg)
        DispatchMessage Offset(msg)
    Wend

    WinMain = msg.wParam
End Function

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
    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)
    Next
    rawinputdevices = rawinputdevices + Chr$(0)

    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
        mousemessage = "RawInput init failed" + Chr$(0)
    End If
End Sub