Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
reading multiple mice absolute position, keyboard with raw input api ?
#1
Question 
Well, we can read multiple mice in Windows - see the attached code 
  1. plug in 2+ USB mice
  2. make sure .h files are in program directory
  3. compile subprogram 'readmicesub43.bas" (or run it, it will run and immediately close)
  4. run the main program "readmicemain43.bas"
  5. try moving around the different mice on your PC, you should see letters move around the screen
  6. try clicking left and middle mouse buttons to hear sounds
  7. to quit, right click any mouse

However I'm not sure about reading the absolute position of the cursor - it tracks movement pretty good using dx/dy, but you can't quickly move a mouse and have the position jump immediately to where the mouse cursor should be. There is a value the subprogram reads that I thought might be the absolute position but doesn't seem to be. Any ideas? Also how to read the scroll wheel?

I'm also not sure how to detect keypresses in the current program. Normal methods of reading the keyboard like _BUTTON, _KEYHIT and _KEYDOWN from the main loop in the subprogram (which has the focus) don't seem to work. Maybe the keyboard needs to be read using Raw Input? And as long as we're using the Raw Input API to read the keyboard, can we read seperate input from multiple keyboards, like we do with mice? I found a bunch of information on using the Raw Input API to read keyboard input:

but this stuff is way over my head, and I would need some help translating this into QB64PE. 
With everyone's help I was able to get the mouse mostly working, so the keyboard should be possible too. 

If anyone is interested in giving this a look, that would be great.


Attached Files
.zip   readmice.zip (Size: 52.18 KB / Downloads: 24)
Reply
#2
Question 
Here is the minimal version of the code that just reads the mouse, just one program. 
(Be sure to place "winproc.h" and "makeint.h" files below to the program directory.)
How can we modify this to read keypresses? 

"multimouse.bas":

Code: (Select All)
' ################################################################################################################################################################
' Multimouse
' ################################################################################################################################################################
' Working proof of concept! (Windows only so far)
' Plug in 2 or more USB mice and try moving them around

' From thread:
' kind of works? reading multiple mice: any c programmers want to look at this? (REPLY #34)
' https://qb64phoenix.com/forum/showthread.php?tid=864&pid=6554#pid6554

' -------------------------------------------------------------------------------
' TO DO
' -------------------------------------------------------------------------------
' * read keyboard input
' * hide the real mouse cursor
' * detect moving the scroll wheel
' * read the absolute position of each mouse rather than dx and dy
' * read multiple keyboard input
' * get this working with _FullScreen _SquarePixels
' * get the same functionality for Mac & Linux

' -------------------------------------------------------------------------------
' CHANGES
' -------------------------------------------------------------------------------
' DATE         WHO        WHAT
' 2004-04-22   jstookey   added the ability to detect whether RawMouse is
'                         available or not so the application can either use a
'                         different multi-mouse system, or exit gracefully
'                         (thanks to Mark Healey).
' 2005-04-24   jstookey   Modified the code work with the latest version of
'                         MinGW. The new MinGW incorporates rawinput, so my
'                         winuser header and library is obsolete.
' 2006-03-05   jstookey   Initialized is_absolute and is_virtual_desktop to
'                         work better with newer versions of VStudio.
' 2022-09-07   madscijr   Turned into a command line EXE that is called from
'                         QB64 with SpriggsySpriggs' pipecom from
'                         https://github.com/SpriggsySpriggs/Spriggsys-API-Collection/blob/master/Cross-Platform%20(Windows%2C%20Macintosh%2C%20Linux)/pipecomqb64.bas
'                         This version doesn't work.
' 2022-09-08   Spriggsy   Converted C to pure QB64 code.
' 2022-09-09   madscijr   Added demo code to move multiple objects on screen
'                         with separate mice independently.
' 2022-09-09   Spriggsy   Added a screen refresh.
' 2022-09-10   madscijr   Added detecting mouse buttons.

' -------------------------------------------------------------------------------
' RESOURCES
' -------------------------------------------------------------------------------
' >Here is the relevant link for the RAWMOUSE struct.
' >https://docs.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawmouse
'
' Multiple Mice in Windows using Raw Input by jstookey
' * https://jstookey.com/multiple-mice-raw-input/
'
' One of the original QB64 threads
' * https://qb64phoenix.com/forum/showthread.php?tid=864
'
' Using Raw Input from C# to handle multiple keyboards by Emma Burrows, Steve Messer
' * https://www.codeproject.com/Articles/17123/Using-Raw-Input-from-C-to-handle-multiple-keyboard
'
' Microsoft's Raw Input API docs at pages around:
' * https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputheader
' * https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevicelist
'
' Looking at RAWINPUT for more detail (HACKADAY.IO)
' * https://hackaday.io/project/5364-cheap-windows-jogkeyboard-controller-for-cncs/log/16843-looking-at-rawinput-for-more-detail
'
' TimothyTimbers Raw Input Class for indie Game Developers:
' * https://www.unknowncheats.me/forum/c-and-c-/64318-raw-input-class-indie-game-developers.html
'
' WINDOWS PROGRAMMING: ACCESSING RAW INPUT by DAVID OREJUELA
' * https://davidorejuela.blogspot.com/2013/12/windows-programming-accessing-raw-input.html
'
' Explorations in Game Development: Why Raw Input?
' * https://explore-gamedev.blogspot.com/2013/09/why-raw-input.html

Option Explicit
_Title "multimouse"
$NoPrefix
$Console:Only
Console Off

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CONSTANTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Const FALSE = 0
Const TRUE = Not FALSE

Const CS_HREDRAW = &H0002
Const CS_VREDRAW = &H0001

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

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

Const WM_DESTROY = &H0002
Const WM_INPUT = &H00FF

Const SW_SHOW = 5

Const RID_INPUT = &H10000003
Const RIM_TYPEMOUSE = 0

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

Const WM_MOUSEMOVE = &H0200

Const WM_PAINT = &H000F

Const DT_CENTER = &H00000001

' MIN/MAX VALUES FOR MOUSE TEST
Const cMinX = 2
Const cMaxX = 79
Const cMinY = 16
Const cMaxY = 24
Const cMinWheel = 0
Const cMaxWheel = 255
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END CONSTANTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN UDTs
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Type RAWINPUTDEVICE
    As Unsigned Integer usUsagePage, usUsage
    As Unsigned Long dwFlags
    As Offset hwndTarget
End Type

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

Type POINT
    As Long x, y
End Type

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

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

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

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

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

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

Type RAWINPUT
    As RAWINPUTHEADER header
    As RAWMOUSE mouse
End Type

' UDT TO HOLD THE INFO FOR EACH MOUSE
Type InfoType
    ID As String ' mouse device ID
    c As String ' cursor character
    x As Integer ' screen x position
    y As Integer ' screen y position
    wheel As Integer ' mouse wheel value
    LeftDown As Integer ' tracks left mouse button state, TRUE=down
    MiddleDown As Integer ' tracks middle mouse button state, TRUE=down
    RightDown As Integer ' tracks right mouse button state, TRUE=down
    LeftCount As Integer ' counts left clicks
    MiddleCount As Integer ' counts middle clicks
    RightCount As Integer ' counts right clicks
End Type ' InfoType

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END UDTs
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN API DECLARATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Declare CustomType Library
    Function GetRawInputDeviceList~& (ByVal pRawInputDeviceList As Offset, Byval puiNumDevices As Offset, Byval cbSize As Unsigned Long)
    Sub GetRawInputDeviceList (ByVal pRawInputDeviceList As Offset, Byval puiNumDevices As Offset, Byval cbSize As Unsigned Long)
    Function RegisterRawInputDevices& (ByVal pRawInputDevices As Offset, Byval uiNumDevices As Unsigned Long, Byval cbSize As Unsigned Long)
    Function GetModuleHandle%& (ByVal lpModulename As Offset)
    Function LoadIcon%& (ByVal hInstance As Offset, Byval lpIconName As Offset)
    Function LoadCursor%& (ByVal hInstance As Offset, Byval lpCursorName As Offset)
    Function RegisterClassEx~% (ByVal wndclassex As Offset)
    Function CreateWindowEx%& (ByVal dwExStyle As Unsigned Long, Byval lpClassName As Offset, Byval lpWindowName As Offset, Byval dwStyle As Unsigned Long, Byval x As Long, Byval y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As Offset, Byval hMenu As Offset, Byval hInstance As Offset, Byval lpParam As Offset)
    Sub ShowWindow (ByVal hWnd As Offset, Byval nCmdShow As Long)
    Sub UpdateWindow (ByVal hWnd As Offset)
    Function GetMessage& (ByVal lpMsg As Offset, Byval hWnd As Offset, Byval wMsgFilterMin As Unsigned Long, Byval wMsgFilterMax As Unsigned Long)
    Sub TranslateMessage (ByVal lpMsg As Offset)
    Sub DispatchMessage (ByVal lpMsg As Offset)
    Sub PostQuitMessage (ByVal nExitCode As Long)
    Function DefWindowProc%& (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
    Sub GetRawInputData (ByVal hRawInput As Offset, Byval uiCommand As Unsigned Long, Byval pData As Offset, Byval pcbSize As Offset, Byval cbSizeHeader As Unsigned Long)
    Function GetRawInputData~& (ByVal hRawInput As Offset, Byval uiCommand As Unsigned Long, Byval pData As Offset, Byval pcbSize As Offset, Byval cbSizeHeader As Unsigned Long)
    Sub InvalidateRect (ByVal hWnd As Offset, Byval lpRect As Offset, Byval bErase As Long)
    Sub SendMessage (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
    Function BeginPaint%& (ByVal hWnd As Offset, Byval lpPaint As Offset)
    Sub GetClientRect (ByVal hWnd As Offset, Byval lpRect As Offset)
    Sub DrawText (ByVal hdc As Offset, Byval lpchText As Offset, Byval cchText As Long, Byval lprc As Offset, Byval format As Unsigned Long)
    Sub OffsetRect (ByVal lprc As Offset, Byval dx As Long, Byval dy As Long)
    Sub EndPaint (ByVal hWnd As Offset, Byval lpPaint As Offset)
End Declare

' Header file "makeint.h" must be in same folder as this program.
Declare CustomType Library ".\makeint"
    Function MAKEINTRESOURCE%& Alias "MAKEINTRSC" (ByVal i As _Offset)
End Declare

Declare Library
    Function MAKELPARAM%& (ByVal l As Integer, Byval h As Integer)
    Function MAKELONG~& (ByVal l As Unsigned Integer, Byval h As Unsigned Integer)
End Declare

$If 64BIT Then
    Declare Library ".\internal\c\c_compiler\x86_64-w64-mingw32\include\windowsx"
    $Else
    Declare Library ".\internal\c\c_compiler\i686-w64-mingw32\include\windowsx"
    $End If
    Function GET_Y_LPARAM& (ByVal lp As Offset)
    Function GET_X_LPARAM& (ByVal lp As Offset)
End Declare

' Header file "winproc.h" must be in same folder as this program.
Declare Library ".\winproc"
    Function WindowProc%& ()
End Declare
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END API DECLARATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL VARIABLES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bDebug As Integer: m_bDebug = FALSE

' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

' RAW INPUT VARIABLES
Dim Shared mousemessage As String
Dim Shared rawinputdevices As String

' MOUSE TEST VARIABLES
Dim Shared arrInfo(8) As InfoType ' STORES INFO FOR EACH MOUSE
'Dim Shared arrRawMouseID(8) As Long ' device IDs for mice connected to system (guessing this would be a string, dunno)
Dim Shared iMouseCount As Integer ' # OF MICE ATTACHED
Dim Shared arrScreen(1 To 80, 1 To 25) As String ' STORES TEXT FOR SCREEN
Dim Shared iMinX As Long
Dim Shared iMaxX As Long
Dim Shared iMinY As Long
Dim Shared iMaxY As Long
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL VARIABLES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' EXECUTION STARTS HERE!
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
iMinX = 0
iMaxX = 3583
iMinY = 0
iMaxY = 8202
System Val(Str$(WinMain))
System ' return control to the operating system

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DATA
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' MOUSE CURSORS (JUST SOME LETTERS)
CData:
Data A,b,C,D,E,f,G,H

' DEFAULT/INTIAL X COORDINATE OF EACH CURSOR ON SCREEN
XData:
Data 5,15,25,35,45,55,65,75

' DEFAULT/INTIAL Y COORDINATE OF EACH CURSOR ON SCREEN
YData:
Data 17,17,19,19,21,21,23,23

' DEFAULT/INITIAL VALUE OF EACH SCROLL WHEEL
WData:
Data 224,192,160,128,96,64,32,0
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DATA
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN RAW INPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' /////////////////////////////////////////////////////////////////////////////
' Runs first

Function WinMain~%& ()
    Dim As Offset hwndMain, hInst
    Dim As MSG msg
    Dim As WNDCLASSEX wndclass
    Dim As String szMainWndClass
    Dim As String szWinTitle
    Dim As Unsigned Integer reg
  
   
    ' =============================================================================
    ' SET UP WINDOW
   
    '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
    hwndMain = CreateWindowEx(0, MAKELPARAM(reg, 0), Offset(szWinTitle), WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, hInst, 0)
    'hwndMain = _WindowHandle
  
    'DEBUG: SUBSTITUTE _WindowHandle
    ShowWindow hwndMain, SW_SHOW
    'ShowWindow _WindowHandle, SW_SHOW
  
    'DEBUG: SUBSTITUTE _WindowHandle
    UpdateWindow hwndMain
    'UpdateWindow _WindowHandle
  
    ' =============================================================================
    ' INITIALIZE RAW INPUT
    InitRawInput
    InitMouseTest 'TODO: SAVE_MOUSE_INFO
  
    ' =============================================================================
    ' BEGIN MAIN LOOP
    ' =============================================================================
    While GetMessage(Offset(msg), 0, 0, 0)
        TranslateMessage Offset(msg)
        DispatchMessage Offset(msg)
    Wend
    ' =============================================================================
    ' END MAIN LOOP
    ' =============================================================================
   
    ' RETURN A VALUE
    WinMain = msg.wParam
End Function ' WinMain

' /////////////////////////////////////////////////////////////////////////////
' Handles main window events

Function MainWndProc%& (hwnd As Offset, nMsg As Unsigned Long, wParam As Unsigned Offset, lParam As Offset)
    Static As Offset hwndButton
    Static As Long cx, cy
    Dim As Offset hdc
    Dim As PAINTSTRUCT ps
    Dim As RECT rc
    Dim As MEM lpb
    Dim As Unsigned Long dwSize
    Dim As RAWINPUT raw
    Dim As Long tmpx, tmpy
    Static As Long maxx
    Dim As RAWINPUTHEADER rih
  
    ' TEMP VARIABLES FOR DISPLAYING FORMATTED VALUES TO SCREEN
    Dim strNextID As String
    Dim iIndex As Integer
    Dim iRowOffset As Integer
    Dim iLen As Integer
    Dim sCount As String
    Dim sX As String
    Dim sY As String
    Dim sWheel As String
    Dim sLeftDown As String
    Dim sMiddleDown As String
    Dim sRightDown As String
    Dim sLeftCount As String
    Dim sMiddleCount As String
    Dim sRightCount As String
    Dim sNext As String
    Dim iNewX As Integer
    Dim iNewY As Integer
    Dim iDX As Integer
    Dim iDY As Integer
  
    ' HANDLE EVENTS
    Select Case nMsg
        Case WM_DESTROY
            PostQuitMessage 0
            MainWndProc = 0
            Exit Function
          
        Case WM_INPUT
            GetRawInputData lParam, RID_INPUT, 0, Offset(dwSize), Len(rih)
            lpb = MemNew(dwSize)
            If lpb.SIZE = 0 Then
                MainWndProc = 0
                Exit Function
            End If
            If GetRawInputData(lParam, RID_INPUT, lpb.OFFSET, Offset(dwSize), Len(rih)) <> dwSize Then
                Print "GetRawInputData doesn't return correct size!"
            End If
            MemGet lpb, lpb.OFFSET, raw
            If raw.header.dwType = RIM_TYPEMOUSE Then
                tmpx = raw.mouse.lLastX
                tmpy = raw.mouse.lLastY
                maxx = tmpx
              
                ' UPDATE RANGE OF MOUSE COORDINATES
                If GET_X_LPARAM(lParam) < iMinX Then iMinX = GET_X_LPARAM(lParam)
                If GET_X_LPARAM(lParam) > iMaxX Then iMaxX = GET_X_LPARAM(lParam)
                If GET_Y_LPARAM(lParam) < iMinY Then iMinY = GET_Y_LPARAM(lParam)
                If GET_Y_LPARAM(lParam) > iMaxY Then iMaxY = GET_Y_LPARAM(lParam)
              
                ' IDENTIFY WHICH MOUSE IT IS
                strNextID = _Trim$(Str$(raw.header.hDevice))
                iIndex = GetMouseIndex%(strNextID)
                If iIndex >= LBound(arrInfo) Then
                    If iIndex <= UBound(arrInfo) Then
                      
                        ' =============================================================================
                        ' UPDATE ABSOLUTE POSITION
                        ' DOESN'T WORK, MOVES ALL OVER THE PLACE:
                        '' METHOD #1: SCALE MOUSE POSITION TO 80X25 POSITION
                        'iNewX = GET_X_LPARAM(lParam)
                        'iNewY = GET_Y_LPARAM(lParam)
                        'arrInfo(iIndex).x = iNewX
                        'arrInfo(iIndex).y = iNewY
                       
                        ' WORKS BUT NOT THAT ACCURATE:
                        ' METHOD #2: INCREMENT/DECREMENT DELTA
                        If raw.mouse.lLastX < 0 Then
                            arrInfo(iIndex).x = arrInfo(iIndex).x - 1
                        ElseIf raw.mouse.lLastX > 0 Then
                            arrInfo(iIndex).x = arrInfo(iIndex).x + 1
                        End If
                        If raw.mouse.lLastY < 0 Then
                            arrInfo(iIndex).y = arrInfo(iIndex).y - 1
                        ElseIf raw.mouse.lLastY > 0 Then
                            arrInfo(iIndex).y = arrInfo(iIndex).y + 1
                        End If
                      
                        ' =============================================================================
                        ' left button = 1 when down, 2 when released
                        If ((raw.mouse.usButtonFlags And 1) = 1) Then
                            arrInfo(iIndex).LeftDown = TRUE
                        ElseIf ((raw.mouse.usButtonFlags And 2) = 2) Then
                            arrInfo(iIndex).LeftDown = FALSE
                        End If
                      
                        ' =============================================================================
                        ' middle button = 16 when down, 32 when released
                        If ((raw.mouse.usButtonFlags And 16) = 16) Then
                            arrInfo(iIndex).MiddleDown = TRUE
                        ElseIf ((raw.mouse.usButtonFlags And 32) = 32) Then
                            arrInfo(iIndex).MiddleDown = FALSE
                        End If
                      
                        ' =============================================================================
                        ' right button = 4 when down, 8 when released
                        If ((raw.mouse.usButtonFlags And 4) = 4) Then
                            arrInfo(iIndex).RightDown = TRUE
                        ElseIf ((raw.mouse.usButtonFlags And 8) = 8) Then
                            arrInfo(iIndex).RightDown = FALSE
                        End If
                      
                        ' =============================================================================
                        ' scroll wheel = ???
                        'Hex$(raw.mouse.usButtonFlags)
                        'arrInfo(iIndex).wheel = ???
                    End If
                End If
              
                ' ================================================================================================================================================================
                ' BEGIN DRAW SCREEN
                ' ================================================================================================================================================================
                ClearText
                WriteText 1, 1, "1. PLUG 1-8 MICE INTO THE COMPUTER"
                WriteText 2, 1, "2. USE MICE TO POSITION LETTERS ON SCREEN"
                WriteText 3, 1, "3. PRESS <ESC> TO QUIT"
                WriteText 4, 1, "--------------------------------------------------------------------------------"
                WriteText 5, 1, "#  X  Y  Wheel LeftDown MiddleDown RightDown LeftCount MiddleCount RightCount   "
                WriteText 6, 1, "--------------------------------------------------------------------------------"
              
                ' NOTE: LEAVE THE NEXT 8 LINES FREE (ROWS 8-15)
                '       TO DISPLAY TEST VALUES FOR UPTO 8 MICE
              
                ' DRAW BORDER AROUND PLAYING FIELD
                DrawTextLine cMinX - 1, cMinY - 1, cMinX - 1, cMaxY + 1, "#"
                DrawTextLine cMinX - 1, cMinY - 1, cMaxX + 1, cMinY - 1, "#"
                DrawTextLine cMaxX + 1, cMaxY + 1, cMaxX + 1, cMinY - 1, "#"
                DrawTextLine cMaxX + 1, cMaxY + 1, cMinX - 1, cMaxY + 1, "#"
              
                ' GET INPUT AND MOVE PLAYERS
                iRowOffset = 0
                For iIndex = LBound(arrInfo) To UBound(arrInfo)
                  
                    ' CHECK BOUNDARIES
                    If arrInfo(iIndex).x < cMinX Then arrInfo(iIndex).x = cMinX
                    If arrInfo(iIndex).x > cMaxX Then arrInfo(iIndex).x = cMaxX
                    If arrInfo(iIndex).y < cMinY Then arrInfo(iIndex).y = cMinY
                    If arrInfo(iIndex).y > cMaxY Then arrInfo(iIndex).y = cMaxY
                  
                    ' PLOT CURSOR
                    WriteText arrInfo(iIndex).y, arrInfo(iIndex).x, arrInfo(iIndex).c
                  
                    ' DISPLAY VARIABLES
                    iLen = 3: sCount = Left$(LTrim$(RTrim$(Str$(iRowOffset + 1))) + String$(iLen, " "), iLen)
                    iLen = 3: sX = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).x))) + String$(iLen, " "), iLen)
                    iLen = 3: sY = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).y))) + String$(iLen, " "), iLen)
                    iLen = 6: sWheel = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).wheel))) + String$(iLen, " "), iLen)
                    iLen = 9: sLeftDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).LeftDown))) + String$(iLen, " "), iLen)
                    iLen = 11: sMiddleDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).MiddleDown))) + String$(iLen, " "), iLen)
                    iLen = 10: sRightDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).RightDown))) + String$(iLen, " "), iLen)
                    iLen = 10: sLeftCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).LeftCount))) + String$(iLen, " "), iLen)
                    iLen = 12: sMiddleCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).MiddleCount))) + String$(iLen, " "), iLen)
                    iLen = 11: sRightCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).RightCount))) + String$(iLen, " "), iLen)
                    'sNext = sCount + sX + sY + sWheel + sLeftDown + sMiddleDown + sRightDown + sLeftCount + sMiddleCount + sRightCount
                    WriteText 6 + iRowOffset, 1, sCount + sX + sY + sWheel + sLeftDown + sMiddleDown + sRightDown + sLeftCount + sMiddleCount + sRightCount
                    iRowOffset = iRowOffset + 1
                Next iIndex
              
                ' UPDATE mousemessage WITH PLAYING FIELD
                mousemessage = ScreenToString$
                ' ================================================================================================================================================================
                ' END DRAW SCREEN
                ' ================================================================================================================================================================
              
                InvalidateRect hwnd, 0, -1
                SendMessage hwnd, WM_PAINT, 0, 0
                MainWndProc = 0
            End If
            MemFree lpb
            MainWndProc = 0
            Exit Function
          
        Case WM_MOUSEMOVE
            ' SAVE RANGE OF MOUSE COORDINATES
            If GET_X_LPARAM(lParam) < iMinX Then iMinX = GET_X_LPARAM(lParam)
            If GET_X_LPARAM(lParam) > iMaxX Then iMaxX = GET_X_LPARAM(lParam)
            If GET_Y_LPARAM(lParam) < iMinY Then iMinY = GET_Y_LPARAM(lParam)
            If GET_Y_LPARAM(lParam) > iMaxY Then iMaxY = GET_Y_LPARAM(lParam)
          
            ' IDENTIFY WHICH MOUSE IT IS
            strNextID = _Trim$(Str$(raw.header.hDevice))
            iIndex = GetMouseIndex%(strNextID)
            If iIndex >= LBound(arrInfo) Then
                If iIndex <= UBound(arrInfo) Then
                  
                    ' =============================================================================
                    ' UPDATE ABSOLUTE POSITION
                    ' DOESN'T WORK, MOVES ALL OVER THE PLACE:
                    '' METHOD #1: SCALE MOUSE POSITION TO 80X25 POSITION
                    ''iNewX = ( (GET_X_LPARAM(lParam) + 1) * 80) \ 1520
                    'iNewX = ( (GET_X_LPARAM(lParam) + 1) * 80) \ (iMaxX+1)
                    ''iNewY = ( (GET_Y_LPARAM(lParam) + 1) * 25) \ 782
                    'iNewY = ( (GET_Y_LPARAM(lParam) + 1) * 25) \ (iMaxY+1)
                    'arrInfo(iIndex).x = iNewX
                    'arrInfo(iIndex).y = iNewY
                  
                End If
            End If
          
            InvalidateRect hwnd, 0, -1
            SendMessage hwnd, WM_PAINT, 0, 0
            MainWndProc = 0
            Exit Function
          
        Case WM_PAINT
            'Q: HOW DO WE GET THIS TO WORK WITH REGULAR QB64 WINDOW?
            'hdc = BeginPaint(_WindowHandle, Offset(ps))
            hdc = BeginPaint(hwnd, Offset(ps))
           
            'Q: HOW DO WE GET THIS TO WORK WITH REGULAR QB64 WINDOW?
            GetClientRect hwnd, Offset(rc)
            'GetClientRect _WindowHandle, Offset(rc)
           
            DrawText hdc, Offset(mousemessage), Len(mousemessage), Offset(rc), DT_CENTER
            OffsetRect Offset(rc), 0, 200
           
            EndPaint hwnd, Offset(ps)
            'EndPaint _WindowHandle, Offset(ps)
           
            MainWndProc = 0
            Exit Function
           
        Case Else
            MainWndProc = DefWindowProc(hwnd, nMsg, wParam, lParam)
            'MainWndProc = DefWindowProc(_WindowHandle, nMsg, wParam, lParam)
    End Select
End Function ' MainWndProc

' /////////////////////////////////////////////////////////////////////////////
' Initializes raw input stuff

Sub InitRawInput ()
    Dim As RAWINPUTDEVICE Rid(0 To 49)
    Dim As Unsigned Long nDevices
    Dim As RAWINPUTDEVICELIST RawInputDeviceList
    Dim As MEM pRawInputDeviceList
    ReDim As RAWINPUTDEVICELIST rawdevs(-1)
    Dim As Unsigned Long x
    Dim strNextID As String
  
    If GetRawInputDeviceList(0, Offset(nDevices), Len(RawInputDeviceList)) <> 0 Then
        Exit Sub
    End If
  
    pRawInputDeviceList = MemNew(Len(RawInputDeviceList) * nDevices)
    GetRawInputDeviceList pRawInputDeviceList.OFFSET, Offset(nDevices), Len(RawInputDeviceList)
  
    ' This small block of commented code proves that we've got the device list
    ReDim As RAWINPUTDEVICELIST rawdevs(0 To nDevices - 1)
    MemGet pRawInputDeviceList, pRawInputDeviceList.OFFSET, rawdevs()
  
    ' GET MOUSE INFO
    iMouseCount = 0
    rawinputdevices = "Number of raw input devices:" + Str$(nDevices) + Chr$(13)
    For x = 0 To UBound(rawdevs)
        rawinputdevices = rawinputdevices + Str$(rawdevs(x).hDevice) + ":" + Str$(rawdevs(x).dwType) + Chr$(13)
      
        ' Is it a mouse?
        If rawdevs(x).dwType = 0 Then
            iMouseCount = iMouseCount + 1
            strNextID = _Trim$(Str$(rawdevs(x).hDevice))
            arrInfo(iMouseCount - 1).ID = strNextID
        End If
      
    Next x
    rawinputdevices = rawinputdevices + Chr$(0)
  
    MemFree pRawInputDeviceList
  
    Rid(0).usUsagePage = &H01
    Rid(0).usUsage = &H02
    Rid(0).dwFlags = 0
  
    Rid(0).hwndTarget = 0
    'Rid(0).hwndTarget = _WindowHandle
   
    If RegisterRawInputDevices(Offset(Rid()), 1, Len(Rid(0))) = 0 Then
        mousemessage = "RawInput init failed" + Chr$(0)
    End If
End Sub ' InitRawInput

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END RAW INPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN MOUSE TEST FUNCTIONS #1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' /////////////////////////////////////////////////////////////////////////////
' Initialize mouse test stuff

'TODO: SAVE_MOUSE_INFO

Sub InitMouseTest
    Dim iIndex As Integer
    Dim iLoop As Integer
  
    ' FOR NOW ONLY SUPPORT UPTO 8 MICE
    If (iMouseCount > 8) Then iMouseCount = 8
  
    ' INITIALIZE CURSORS, MOUSE STATE, ETC.
    Restore CData
    iIndex = LBound(arrInfo) - 1
    For iLoop = 1 To iMouseCount
        iIndex = iIndex + 1
        Read arrInfo(iIndex).c
        arrInfo(iIndex).LeftDown = FALSE
        arrInfo(iIndex).MiddleDown = FALSE
        arrInfo(iIndex).RightDown = FALSE
        arrInfo(iIndex).LeftCount = 0
        arrInfo(iIndex).MiddleCount = 0
        arrInfo(iIndex).RightCount = 0
    Next iLoop
  
    ' INITIALIZE X COORDINATES
    Restore XData
    iIndex = LBound(arrInfo) - 1
    For iLoop = 1 To iMouseCount
        iIndex = iIndex + 1
        Read arrInfo(iIndex).x
    Next iLoop
  
    ' INITIALIZE Y COORDINATES
    Restore YData
    iIndex = LBound(arrInfo) - 1
    For iLoop = 1 To iMouseCount
        iIndex = iIndex + 1
        Read arrInfo(iIndex).y
    Next iLoop
  
    ' INITIALIZE SCROLL WHEEL
    Restore WData
    iIndex = LBound(arrInfo) - 1
    For iLoop = 1 To iMouseCount
        iIndex = iIndex + 1
        Read arrInfo(iIndex).wheel
    Next iLoop
  
End Sub ' InitMouseTest

' /////////////////////////////////////////////////////////////////////////////
' Finds position in array arrInfo where .ID = MouseID

Function GetMouseIndex% (MouseID As String)
    Dim iLoop As Integer
    Dim iIndex%
    iIndex% = LBound(arrInfo) - 1
    For iLoop = LBound(arrInfo) To UBound(arrInfo)
        If arrInfo(iLoop).ID = MouseID Then
            iIndex% = iLoop
            Exit For
        Else
            ' not it
        End If
    Next iLoop
    GetMouseIndex% = iIndex%
End Function ' GetMouseIndex%

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END MOUSE TEST FUNCTIONS #1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN TEST OUTPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' /////////////////////////////////////////////////////////////////////////////
' Clears global array arrScreen

Sub ClearText
    Dim iColNum As Integer
    Dim iRowNum As Integer
    For iColNum = LBound(arrScreen, 1) To UBound(arrScreen, 1)
        For iRowNum = LBound(arrScreen, 2) To UBound(arrScreen, 2)
            arrScreen(iColNum, iRowNum) = " "
        Next iRowNum
    Next iColNum
End Sub ' ClearText

' /////////////////////////////////////////////////////////////////////////////
' Plots string MyString to position (iX, iY) in global array arrScreen.

Sub WriteText (iRow As Integer, iColumn As Integer, MyString As String)
    Dim iPos As Integer
    Dim iLoop As Integer
    If iColumn > 0 And iColumn < 81 Then
        If iRow > 0 And iRow < 26 Then
            For iLoop = 1 To Len(MyString)
                iPos = iColumn + (iLoop - 1)
                If iPos < 81 Then
                    arrScreen(iPos, iRow) = Mid$(MyString, iLoop, 1)
                Else
                    Exit For
                End If
            Next iLoop
        End If
    End If
End Sub ' WriteText

' /////////////////////////////////////////////////////////////////////////////
' Converts global array arrScreen to a string.

Function ScreenToString$
    Dim sResult As String
    Dim iColNum As Integer
    Dim iRowNum As Integer
    sResult = ""
    For iRowNum = LBound(arrScreen, 2) To UBound(arrScreen, 2)
        For iColNum = LBound(arrScreen, 1) To UBound(arrScreen, 1)
            sResult = sResult + arrScreen(iColNum, iRowNum)
        Next iColNum
        sResult = sResult + Chr$(13)
    Next iRowNum
    ScreenToString$ = sResult
End Function ' ScreenToString$

' /////////////////////////////////////////////////////////////////////////////
' based on code from:
' Qbasic Programs - Download free bas source code
' http://www.thedubber.altervista.org/qbsrc.htm

Sub DrawTextLine (y%, x%, y2%, x2%, c$)
    Dim i%
    Dim steep%
    Dim e%
    Dim sx%
    Dim dx%
    Dim sy%
    Dim dy%
  
    i% = 0: steep% = 0: e% = 0
    If (x2% - x%) > 0 Then sx% = 1: Else sx% = -1
    dx% = Abs(x2% - x%)
    If (y2% - y%) > 0 Then sy% = 1: Else sy% = -1
    dy% = Abs(y2% - y%)
    If (dy% > dx%) Then
        steep% = 1
        Swap x%, y%
        Swap dx%, dy%
        Swap sx%, sy%
    End If
    e% = 2 * dy% - dx%
    For i% = 0 To dx% - 1
        If steep% = 1 Then
            ''PSET (y%, x%), c%:
            'Locate y%, x% : Print c$;
            WriteText y%, x%, c$
        Else
            ''PSET (x%, y%), c%
            'Locate x%, y% : Print c$;
            WriteText x%, y%, c$
        End If

        While e% >= 0
            y% = y% + sy%: e% = e% - 2 * dx%
        Wend
        x% = x% + sx%: e% = e% + 2 * dy%
    Next
    ''PSET (x2%, y2%), c%
    'Locate x2%, y2% : Print c$;
    WriteText x2%, y2%, c$
End Sub ' DrawTextLine

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END TEST OUTPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


"makeint.h" (include this in the program directory):

Code: (Select All)
LPSTR MAKEINTRSC(ptrszint i){
    return MAKEINTRESOURCE(i);
}

"winproc.h" (include this in the program directory):

Code: (Select All)
ptrszint FUNC_MAINWNDPROC(ptrszint*_FUNC_MAINWNDPROC_OFFSET_HWND,uint32*_FUNC_MAINWNDPROC_ULONG_NMSG,uptrszint*_FUNC_MAINWNDPROC_UOFFSET_WPARAM,ptrszint*_FUNC_MAINWNDPROC_OFFSET_LPARAM);

LRESULT CALLBACK MainWndProc(HWND hwnd, UINT nMsg, WPARAM wParam, LPARAM lParam){
    return FUNC_MAINWNDPROC((ptrszint *) (&hwnd), &nMsg, &wParam, (ptrszint *)(&lParam));
}

void * WindowProc(){
    return (void *) MainWndProc;
}
Reply




Users browsing this thread: 2 Guest(s)