Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Error #75 at Open {file} For Input As #1 (need 2 progs on same PC to communicate)
#1
This works pretty well until it doesn't. It could be 30 seconds or 2 minutes, but eventually it seems to stop updating the display and I've tracked it down to an Error #75 at line 425 in "MAINPROG.BAS":

Code: (Select All)
                Open arrFile(iIndex, cFileName) For Input As #1

after which it then just keeps getting Error #55 at line 425.

If you kill "MAINPROG.BAS" and run it again (leave "READMICE.BAS" running) it works again (as long as you give "READMICE.BAS" the focus) but eventually the error happens again. 

The way it works is, two programs run simultaneously:
  • "READMICE.BAS" reads mice input using the Raw Input API, and continually writes the mouse input to files (1 file per mouse). This window must have the focus but the other program is set to always display on top, as it is what draws the graphics and handles the main logic. 
  • "MAINPROG.BAS" continually reads the mouse input from the files, and uses it to position some text on the screen. This window is set to always display on top, but the other program must have the focus so that it can read the mice.

I suspect what's happening is that the one program is trying to read the file at the exact same time the other one is writing it. 

I think there has to be a better way than writing/reading files to get the two programs to talk to each other, either somehow using some shared environmental variables in memory or maybe talking via LAN calls, but I don't know much about those things. 

Any help getting this working would be much appreciated! 

PS Currently "MAINPROG" is set up to output error messages to the console window for debugging, this can be turned off from the line

Code: (Select All)
Dim Shared m_bDebug As Integer: m_bDebug = TRUE

by setting m_bDebug to FALSE.

The 2 programs follow: 

Program A "READMICE.BAS". This should have the focus but be hidden underneath Program B (which controls the display and is always on top).
Code: (Select All)
' ################################################################################################################################################################
' Multimouse program A "readmice.bas" = mouse reader
' ################################################################################################################################################################

' Working proof of concept! (Windows only so far)
' 1. Plug 2 or more USB mice into your computer.
' 2. Run the mouse reader program "readmice.bas"
' 3. Run the front end program "mainprog.bas"
' 4. Drag the windows and make sure they line up, one on top of the other.
' 5. Set the focus to "readmice.bas" (it will be hidden underneath "mainprog", so use the taskbar or ALT+TAB).
' 6. Try moving each mouse. Each one should move a different letter.
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' madscijr - Mini-Mod
' #34
' 09-12-2022, 12:05 PM (This post was last modified: 09-12-2022, 12:07 PM by madscijr.)
' (09-09-2022, 04:27 PM) Spriggsy Wrote:
' >The button catching was working in the example I gave you so you might want to take a look at that mousemessage string. My version displayed the current button being pressed. Here is the relevant link for the RAWMOUSE struct.
' >https://docs.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawmouse
' >You can see the value for each button state listed there.
' >Edit.... Weird. Now it isn't wanting to work on my machine. It was working yesterday just fine.
' >Edit again.... Ah, I wasn't drawing the button information again. I accidentally erased the update. See below and you can try it out. The code does catch the buttons.
'
' Aha, thanks. The mouse button up/down are now being detected and I have it saving the state for left/middle/right clicks (code below).
'
' Now what black magic are we going to have to do, to get this out of the "event driven" code, and working like a regular QB64 program?
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' McNeill - Super Moderator
' #2
' 05-17-2024, 07:27 PM (This post was last modified: 05-17-2024, 07:28 PM by SMcNeill.)
' https://qb64phoenix.com/qb64wiki/index.php/Windows_Libraries#Top_Most_Window

' SMcNeill - Super Moderator
' #11
' 2 hours ago
' Const SWP_NOMOVE = &H0002 'ignores x and y position parameters

' Steffan-68 - Junior Member
' #12
' 2 hours ago
' Do both programs have to be in the same place on the monitor?
' If not, you can change these lines.
'     If 0 = SetWindowPos(hWnd, HWND_TOPMOST, 840, 200, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE) Then
' und
'     _ScreenClick 880, 240 ' add 40 to x and y to focus on positioned window
'
' This means that both programs would be next to each other,
' but only the one that is set to foreground remains in the foreground
' and the other one could then fade into the background.
' I don't know what you're trying to do, maybe you could also
' play around with the command (_SCREENICON).
' So that the program that is not in the foreground disappears from the monitor?

' SMcNeill - Super Moderator
' #13
' 2 hours ago
' Sorry. I didn't notice the need for _SCREENCLICK.
' What you're looking for is:
' https://qb64phoenix.com/qb64wiki/index.php/SCREENX
' https://qb64phoenix.com/qb64wiki/index.php/SCREENY
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' -------------------------------------------------------------------------------
' TO DO
' -------------------------------------------------------------------------------
' Some issues and things to fix:
' * detect mouse button clicks (left, middle, right buttons) without losing focus
'   and the focus going to "mainprog.bas" which is in front but must not have the focus.
' * rework code from event-driven to linear (ie call a routine to get the
'   latest coordinates / button states / scroll wheel for mouse n)
' * detect moving the scroll wheel
' * hide the real mouse cursor
' * get this working with _FullScreen _SquarePixels
' * scale the dx and dy of each mouse to 80x25 (or whatever target range is)
' * read the absolute position rather than dx and dy & fix scaling mouse
'   coordinates to 80x25 (or whatever our target range is)
' * the code is seeing an extra (phantom) mouse - might be the disabled
'   trackpad on my laptop. Is there a way to determine which mice or devices
'   are disabled or can be ignored?
' * (later) Figure out how to do this for reading multiple keyboards.
' * (later) Figure out how to 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.
' 2024-05-19   madscijr   Try having the program write mice coordinates / button
'                         states to a file that main program "always on top"
'                         without focus can read.

Option Explicit
_Title "readmice"
$NoPrefix
'$Console:Only
'Console Off

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CONSTANTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Const cProgName = "readmice"
Const FALSE = 0
Const TRUE = Not FALSE

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' USED TO CONVERT MOUSE POSITION TO GET SCREEN POSITION
' ScreenPos = MousePos / ScaleValue
' This doesn't really work too accurately!
Const cScaleX = 3
Const cScaleY = 4

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' FOR RAW INPUT API
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 ' Raw input comes from the mouse.
Const RIM_TYPEKEYBOARD = 1 ' Raw input comes from the keyboard.
Const RIM_TYPEHID = 2 ' Raw input comes from some device that is not a keyboard or a mouse.

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 = 1
Const cMaxX = 80
Const cMinY = 1
Const cMaxY = 30 ' 24
Const cMinWheel = 0
Const cMaxWheel = 255

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' CONSTANT FOR 2ND DIMENSION OF arrFile ARRAY
Const cFileName = 0
Const cFileData = 1

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 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 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
    mouseX As Integer ' mouse x movement -1=left, 1=right, 0=none
    mouseY 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
End Type ' MouseInfoType

' UDT TO HOLD THE INFO FOR EACH KEYBOARD
Type KeyboardInfoType
    UpdateCount As Integer ' if this value changes we know a value changed
    ID As String ' keyboard device ID
    'TBD
End Type ' KeyboardInfoType

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

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN API DECLARATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' FOR RAW INPUT API
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
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
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 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)

' GLOBAL VARIABLES TO TRACK ERROR STATE
Dim Shared m_sError As String: m_sError = ""
Dim Shared m_sIncludeError As String: m_sIncludeError = ""

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

' MOUSE VARIABLES
Dim Shared arrMouse(0 To 8) As MouseInfoType ' 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

' KEYBOARD VARIABLES
Dim Shared arrKeyboard(0 To 8) As KeyboardInfoType ' STORES INFO FOR EACH KEYBOARD
Dim Shared iKeyboardCount As Integer ' # OF KEYBOARDS ATTACHED
Dim Shared arrKeyState(0 To 8, 1 To 512) As Integer ' arrKeyState({device#}, {keyCode}) = TRUE if key {keyCode} on keyboard {device#} is currently held down.

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

' RAW FILE NAMES
Dim Shared arrFile(0 To 31, 0 To 1) As String

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL VARIABLES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' EXECUTION STARTS HERE!
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' =============================================================================
' START THE MAIN ROUTINE
main

' =============================================================================
' FINISH
Print m_ProgramName$ + " finished."
End
'System ' return control to the operating system

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL ERROR HANDLER
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ErrorHandler:
m_sError = "Error #" + _Trim$(Str$(Err)) + " at line " + _Trim$(Str$(_ErrorLine)) + "."
m_sIncludeError = "File " + Chr$(34) + _InclErrorFile$ + Chr$(34) + " at line " + _Trim$(Str$(_InclErrorLine)) + "."
Resume Next
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL ERROR HANDLER
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DATA STATEMENTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 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 STATEMENTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN MAIN ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' /////////////////////////////////////////////////////////////////////////////

Sub main
    Dim iLoop As Integer
    Dim in$

    ' INITIALIZE
    For iLoop = LBound(arrFile) To UBound(arrFile)
        arrFile(iLoop, cFileName) = m_ProgramPath$ + "mouse" + _Trim$(Str$(iLoop)) + ".txt"
        arrFile(iLoop, cFileData) = ""
    Next iLoop

    ' INITIALIZE
    iMinX = 0
    iMaxX = 3583
    iMinY = 0
    iMaxY = 8202

    ' SET UP WINDOW
    'Screen _NewImage(1024, 768, 32)
    Screen 12 ' SCREEN 12 can use 16 color attributes with a black background. 256K possible RGB color hues. Background colors can be used with QB64.
   
    ' window needs to be lined up directly under the main program, so the mouse coordinates align with the display
    _ScreenMove 0, 0 ' <<< NOT WORKING, HOW DO WE DO THIS IN THE EVENT MODEL?

    ' GIVE CONTROL TO THE EVENT-ORIENTED CODE
    System Val(Str$(WinMain))

End Sub ' main

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END MAIN ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 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
   
    'DEBUG: TRY FULL SCREEN <- PROGRAM CRASHES!
    '_FullScreen _SquarePixels
   
    hInst = GetModuleHandle(0)
    szMainWndClass = "WinTestWin" + Chr$(0)
    'szWinTitle = "Hello" + Chr$(0)
    szWinTitle = cProgName + 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 = 0
    '   Byval lpClassName  As Offset        = MAKELPARAM(reg, 0)
    '   Byval lpWindowName As Offset        = Offset(szWinTitle)
    '   Byval dwStyle      As Unsigned Long = WS_OVERLAPPEDWINDOW
    '   Byval x            As Long          = CW_USEDEFAULT
    '   Byval y            As Long          = CW_USEDEFAULT
    '   Byval nWidth       As Long          = CW_USEDEFAULT
    '   Byval nHeight      As Long          = CW_USEDEFAULT
    '   Byval hWndParent   As Offset        = 0
    '   Byval hMenu        As Offset        = 0
    '   Byval hInstance    As Offset        = hInst
    '   Byval lpParam      As Offset        = 0
   
    '    hwndMain = CreateWindowEx( _
    '       0, _
    '       MAKELPARAM(reg, 0), _
    '       Offset(szWinTitle), _
    '       WS_OVERLAPPEDWINDOW, _
    '       CW_USEDEFAULT, _
    '       CW_USEDEFAULT, _
    '       CW_USEDEFAULT, _
    '       CW_USEDEFAULT, _
    '       0, _
    '       0, _
    '       hInst, _
    '       0)
   
    hwndMain = CreateWindowEx( _
        0, _
        MAKELPARAM(reg, 0), _
        Offset(szWinTitle), _
        WS_OVERLAPPEDWINDOW, _
        0, _
        0, _
        1024, _
        768, _
        0, _
        0, _
        hInst, _
        0)
   
    'hwndMain = _WindowHandle
   
    'DEBUG: SUBSTITUTE _WindowHandle
    ShowWindow hwndMain, SW_SHOW
    'ShowWindow _WindowHandle, SW_SHOW
   
    'DEBUG: SUBSTITUTE _WindowHandle
    UpdateWindow hwndMain
    'UpdateWindow _WindowHandle
   
    InitRawInput
    InitMouseTest 'TODO: SAVE_MOUSE_INFO
   
    While GetMessage(Offset(msg), 0, 0, 0)
        TranslateMessage Offset(msg)
        DispatchMessage Offset(msg)
    Wend
   
    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
   
    ' MORE TEMP VARIABLES
    Dim iMouseNum 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!"
                mousemessage = "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
               
                ' GET MOUSE INFO
                ' NOTES:
                ' ulButtons and usButtonFlags both return the same thing (buttons)
                ' usButtonData changes value when scroll wheel moved (just stays at one value)
                'mousemessage = ""
                'mousemessage = mousemessage + "Mouse:hDevice" + Str$(raw.header.hDevice)
                'mousemessage = mousemessage + "usFlags=" + Hex$(raw.mouse.usFlags)
                'mousemessage = mousemessage + "ulButtons=" + Hex$(MAKELONG(raw.mouse.usButtonFlags, raw.mouse.usFlags))
                'mousemessage = mousemessage + "usButtonFlags=" + Hex$(raw.mouse.usButtonFlags)
                'mousemessage = mousemessage + "usButtonData=" + Hex$(raw.mouse.usButtonData)
                'mousemessage = mousemessage + "ulRawButtons=" + Hex$(raw.mouse.ulRawButtons)
                'mousemessage = mousemessage + "lLastX=" + Str$(raw.mouse.lLastX)
                'mousemessage = mousemessage + "lLastY=" + Str$(raw.mouse.lLastY)
                'mousemessage = mousemessage + "ulExtraInformation=" + Hex$(raw.mouse.ulExtraInformation) + Chr$(13)
               
                ' 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
                      
                        ' =============================================================================
                        ' READ MOUSE MOVEMENT
                      
                        ' DOESN'T WORK, MOVES ALL OVER THE PLACE:
                        '' METHOD #1: SCALE MOUSE POSITION TO 80X25 POSITION
                        'iNewX = ( (GET_X_LPARAM(lParam) + 1) * 80) \ (iMaxX+1)
                        'iNewY = ( (GET_Y_LPARAM(lParam) + 1) * 25) \ (iMaxY+1)
                        '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).mouseX = -1
                           
                        ElseIf raw.mouse.lLastX > 0 Then
                            arrMouse(iIndex).mouseX = 1
                        Else
                            arrMouse(iIndex).mouseX = 0
                        End If
                       
                        If raw.mouse.lLastY < 0 Then
                            arrMouse(iIndex).mouseY = -1
                        ElseIf raw.mouse.lLastY > 0 Then
                            arrMouse(iIndex).mouseY = 1
                        Else
                            arrMouse(iIndex).mouseY = 0
                        End If
                      
                        ' =============================================================================
                        'TODO: SAVE SCROLL WHEEL + BUTTONS
                        'Hex$(raw.mouse.usButtonFlags)
                      
                        ' 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 = ???
                        'arrMouse(iIndex).wheel = ???
                       
                        ' DID VALUE CHANGE?
                        If arrMouse(iIndex).UpdateCount = 32767 Then
                            arrMouse(iIndex).UpdateCount = 1
                        Else
                            arrMouse(iIndex).UpdateCount = arrMouse(iIndex).UpdateCount + 1
                        End If
                       
                        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
                        ' WRITE VALUES FOR THIS MOUSE TO FILE
                       
                        arrFile(iIndex, cFileData) = ""
                        arrFile(iIndex, cFileData) = arrFile(iIndex, cFileData) + LTrim$(RTrim$(Str$(arrMouse(iIndex).UpdateCount))) + Chr$(13)
                        arrFile(iIndex, cFileData) = arrFile(iIndex, cFileData) + LTrim$(RTrim$(Str$(arrMouse(iIndex).mouseX))) + Chr$(13)
                        arrFile(iIndex, cFileData) = arrFile(iIndex, cFileData) + LTrim$(RTrim$(Str$(arrMouse(iIndex).mouseY))) + Chr$(13)
                        arrFile(iIndex, cFileData) = arrFile(iIndex, cFileData) + LTrim$(RTrim$(Str$(arrMouse(iIndex).wheel))) + Chr$(13)
                        arrFile(iIndex, cFileData) = arrFile(iIndex, cFileData) + LTrim$(RTrim$(Str$(arrMouse(iIndex).LeftDown))) + Chr$(13)
                        arrFile(iIndex, cFileData) = arrFile(iIndex, cFileData) + LTrim$(RTrim$(Str$(arrMouse(iIndex).MiddleDown))) + Chr$(13)
                        arrFile(iIndex, cFileData) = arrFile(iIndex, cFileData) + LTrim$(RTrim$(Str$(arrMouse(iIndex).RightDown))) + Chr$(13)
                       
                        Open arrFile(iIndex, cFileName) For Output As #1
                        Print #1, arrFile(iIndex, cFileData)
                        Close #1
                       
                        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
                        ' CLEAR MOVEMENT
                        arrMouse(iIndex).mouseX = 0
                        arrMouse(iIndex).mouseY = 0
                       
                    End If
                End If
               
                ' UPDATE mousemessage WITH PLAYING FIELD
                mousemessage = ScreenToString$
                ' ================================================================================================================================================================
                ' END WRITE OUTPUT FILE
                ' ================================================================================================================================================================
               
                InvalidateRect hwnd, 0, -1
                SendMessage hwnd, WM_PAINT, 0, 0
                MainWndProc = 0
               
            ElseIf raw.header.dwType = RIM_TYPEKEYBOARD Then
                ' TODO: READ KEYBOARD INPUT
               
                ' SEE:
                ' https://www.codeproject.com/Articles/17123/Using-Raw-Input-from-C-to-handle-multiple-keyboard
                ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/55985-raw-keyboard-hid-input-discussion
                ' https://hackaday.io/project/5364-cheap-windows-jogkeyboard-controller-for-cncs/log/16843-looking-at-rawinput-for-more-detail
               
                ' WinAPI Raw Input confusion - For Beginners - GameDev.net
                ' https://www.gamedev.net/forums/topic/700010-winapi-raw-input-confusion/

                'iKeyboardCount = iKeyboardCount + 1 ' # KEYBOARDS ATTACHED
                'strNextID = _Trim$(Str$(rawdevs(x).hDevice))
                'arrKeyboard(iKeyboardCount - 1).ID = strNextID
                ' TODO: READ KEYBOARD AND STORE KEYBOARD STATE
                'arrKeyState(0 To 8, 1 To 512) As Integer ' arrKeyState({device#}, {keyCode}) = TRUE if key {keyCode} on keyboard {device#} is currently held down.
               
            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)
           
            ' SAVE RANGE OF MOUSE COORDINATES
            If GET_X_LPARAM(lParam) < iMinX Then
                iMinX = GET_X_LPARAM(lParam)
                arrMouse(iIndex).mouseX = -1
            ElseIf GET_X_LPARAM(lParam) > iMaxX Then
                iMaxX = GET_X_LPARAM(lParam)
                arrMouse(iIndex).mouseX = 1
            Else
                arrMouse(iIndex).mouseX = 0
            End If
           
            If GET_Y_LPARAM(lParam) < iMinY Then
                iMinY = GET_Y_LPARAM(lParam)
                arrMouse(iIndex).mouseY = -1
            ElseIf GET_Y_LPARAM(lParam) > iMaxY Then
                iMaxY = GET_Y_LPARAM(lParam)
                arrMouse(iIndex).mouseY = 1
            Else
                arrMouse(iIndex).mouseY = 0
            End If
           
            ' 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) + 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
                   
                    ' WORKS BUT NOT THAT ACCURATE:
                    ' METHOD #2: INCREMENT/DECREMENT DELTA
                    ' (should we update here too?)
                   
                    'TODO: SAVE SCROLL WHEEL + BUTTONS
                    ' (should we update here too?)
                    'arrMouse(iIndex).wheel =
                    'arrMouse(iIndex).LeftDown =
                    'arrMouse(iIndex).MiddleDown =
                    'arrMouse(iIndex).RightDown =
                End If
            End If
           
            'DEBUG: SUBSTITUTE _WindowHandle
            InvalidateRect hwnd, 0, -1
            'InvalidateRect _WindowHandle, 0, -1
          
            'DEBUG: SUBSTITUTE _WindowHandle
            SendMessage hwnd, WM_PAINT, 0, 0
            'SendMessage _WindowHandle, WM_PAINT, 0, 0
           
            MainWndProc = 0
            Exit Function
           
        Case WM_PAINT
            'DEBUG: SUBSTITUTE _WindowHandle
            hdc = BeginPaint(hwnd, Offset(ps))
            'hdc = BeginPaint(_WindowHandle, Offset(ps))
           
            'DEBUG: SUBSTITUTE _WindowHandle
            GetClientRect hwnd, Offset(rc)
            'GetClientRect _WindowHandle, Offset(rc)
           
            DrawText hdc, Offset(mousemessage), Len(mousemessage), Offset(rc), DT_CENTER
            OffsetRect Offset(rc), 0, 200
           
            '' PRINT LIST OF RawInput DEVICES:
            'DrawText hdc, Offset(rawinputdevices), Len(rawinputdevices), Offset(rc), DT_CENTER
           
            'DEBUG: SUBSTITUTE _WindowHandle
            EndPaint hwnd, Offset(ps)
            'EndPaint _WindowHandle, Offset(ps)
           
            MainWndProc = 0
            Exit Function
           
        Case Else
            'DEBUG: SUBSTITUTE _WindowHandle
            MainWndProc = DefWindowProc(hwnd, nMsg, wParam, lParam)
            'MainWndProc = DefWindowProc(_WindowHandle, nMsg, wParam, lParam)
    End Select
   
    If _KeyDown(27) Then End
   
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
    'dim lngNextID as long
   
    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 / KEYBOARD 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)
       
        ' RAWINPUTHEADER (winuser.h) - Win32 apps | Microsoft Learn
        ' https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputheader
        ' dwType
        ' Type: DWORD
        ' The type of raw input. It can be one of the following values:
        ' Constant           Value   Meaning
        ' RIM_TYPEMOUSE      0       Raw input comes from the mouse.
        ' RIM_TYPEKEYBOARD   1       Raw input comes from the keyboard.
        ' RIM_TYPEHID        2       Raw input comes from some device that is not a keyboard or a mouse.
       
        ' WHAT TYPE OF DEVICE IS IT?
        'If rawdevs(x).dwType = 0 Then
        If rawdevs(x).dwType = RIM_TYPEMOUSE Then
            iMouseCount = iMouseCount + 1
            strNextID = _Trim$(Str$(rawdevs(x).hDevice))
            'lngNextID = Val(strNextID)
            'arrMouse(iMouseCount-1).ID = lngNextID
            arrMouse(iMouseCount - 1).ID = strNextID
            arrMouse(iMouseCount - 1).UpdateCount = 0
            'TODO: SAVE_MOUSE_INFO
           
        ElseIf rawdevs(x).dwType = RIM_TYPEKEYBOARD Then
            iKeyboardCount = iKeyboardCount + 1 ' # KEYBOARDS ATTACHED
            strNextID = _Trim$(Str$(rawdevs(x).hDevice))
            arrKeyboard(iKeyboardCount - 1).ID = strNextID
            arrKeyboard(iKeyboardCount - 1).UpdateCount = 0
            ' TODO: READ KEYBOARD AND STORE KEYBOARD STATE
           
            'arrKeyState(0 To 8, 1 To 512) As Integer ' arrKeyState({device#}, {keyCode}) = TRUE if key {keyCode} on keyboard {device#} is currently held down.
        End If
       
    Next x
    rawinputdevices = rawinputdevices + Chr$(0)
   
    MemFree pRawInputDeviceList

    Rid(0).usUsagePage = &H01
    Rid(0).usUsage = &H02
    Rid(0).dwFlags = 0
   
    'DEBUG: SUBSTITUTE _WindowHandle
    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(arrMouse) - 1
    For iLoop = 1 To iMouseCount
        iIndex = iIndex + 1
        Read arrMouse(iIndex).c
        ' INITIALIZED BELOW: arrMouse(iIndex).x = 0
        ' INITIALIZED BELOW: arrMouse(iIndex).y = 0
        ' INITIALIZED BELOW: arrMouse(iIndex).wheel = 127
        arrMouse(iIndex).LeftDown = FALSE
        arrMouse(iIndex).MiddleDown = FALSE
        arrMouse(iIndex).RightDown = FALSE
        arrMouse(iIndex).LeftCount = 0
        arrMouse(iIndex).MiddleCount = 0
        arrMouse(iIndex).RightCount = 0
        arrMouse(iIndex).UpdateCount = 1
    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 FOR API CONTROLLED UI
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' /////////////////////////////////////////////////////////////////////////////
' 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 FOR API CONTROLLED UI
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN MOUSE FUNCTIONS TO COME
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' /////////////////////////////////////////////////////////////////////////////
' Returns a count of # of RawInput mouse devices connected to the system

' *****************************************************************************
' TODO: GET COUNT FROM RawInput API
' For now, hardcoded to 1 until we figure out how to do this.
' *****************************************************************************
Function GetRawMouseCount% ()
    GetRawMouseCount% = 1
End Function ' GetRawMouseCount%

' /////////////////////////////////////////////////////////////////////////////
' Gets ID of each RawInput mouse device connected to the system (for now upto 8)

' Returns the IDs in an array of LONG <- may change depending on whether
' we save each the device handle for each mouse or the index

' If no mouse found, the ID will just be 0 <- or whatever value we decide as default/none

' *****************************************************************************
' TODO: GET THIS FROM RawInput API
' For now, hardcoded arrRawMouseID(1) to 1, and the rest 0, until we figure out how to do this.
' *****************************************************************************
'Sub GetRawMouseIDs (arrRawMouseID( 8) As Integer)
Sub GetRawMouseIDs ()
    Dim iLoop As Integer
   
    ' CLEAR OUT IDs
    For iLoop = 1 To 8
        ''arrRawMouseID(iLoop) = 0
        'arrMouse(iLoop).ID = 0
        arrMouse(iLoop).ID = ""
    Next iLoop
   
    ' GET IDs
    'TODO: get this from RawInput API
    ''arrRawMouseID(1) = 1 ' for now just fudge it!
    'arrMouse(0).ID = 1 ' for now just fudge it!
End Sub ' GetRawMouseIDs

' /////////////////////////////////////////////////////////////////////////////
' Read mouse using RawInput API

' Gets input from mouse, MouseID% = which mouse

' NOTE: click events (mouse up/mouse down) are handled by the calling sub,
'       this routine just sends back
'       TRUE if the given button is currently down or FALSE if it is up.

' Parameters (input only):
' MouseID% = which mouse to return input for
' wheelMin% = minimum value to allow wheelValue% to be decremented to
' wheelMax% = maximum value to allow wheelValue% to be incremened to

' Parameters (values returned):
' x% = mouse x position
' y% = mouse y position
' leftButton% = current state of left mouse button (up or down)
' middleButton% = current state of middle mouse button / scroll wheel button (up or down)
' rightButton% = current state of right mouse button (up or down)
' wheelValue% = value of mouse scroll wheel (passed in and incremented/decremented by 1 if wheel move detected)

Sub ReadRawMouse (MouseID%, x%, y%, leftButton%, middleButton%, rightButton%, wheelValue%, wheelMin%, wheelMax%)
    Dim scrollAmount%
    Dim dx%
    Dim dy%
   
    ' =============================================================================
    ' BEGIN READ MOUSE THE NEW RawInput WAY:
   
    ' read scroll wheel
    'TODO: get this from RawInput API
   
    ' determine mouse x position
    'TODO: get this from RawInput API
    dx% = 0 ' = getMouseDx(MouseID%)
    x% = x% + dx% ' adjust mouse value by dx
   
    ' determine mouse y position
    'TODO: get this from RawInput API
    dy% = 0 ' = getMouseDy(MouseID%)
    y% = y% + dy% ' adjust mouse value by dx
   
    ' read mouse buttons
    'TODO: get this from RawInput API
    leftButton% = FALSE
    middleButton% = FALSE
    rightButton% = FALSE
   
    ' END READ MOUSE THE NEW RawInput WAY:
    ' =============================================================================
   
    ' =============================================================================
    ' BEGIN READ MOUSE THE OLD QB64 WAY:
    '
    '' read scroll wheel
    'WHILE _MOUSEINPUT ' get latest mouse information
    '    scrollAmount% = _MOUSEWHEEL ' (Returns -1 when scrolling up and 1 when scrolling down with 0 indicating no movement since last read.)
    '    IF (scrollAmount% = -1) AND (wheelValue% > wheelMin%) THEN
    '        wheelValue% = wheelValue% + scrollAmount%
    '    ELSEIF (scrollAmount% = 1) AND (wheelValue% < wheelMax%) THEN
    '        wheelValue% = wheelValue% + scrollAmount%
    '    END IF
    'WEND
    '
    '' determine mouse x position
    'x% = _MOUSEX
    '
    '' determine mouse y position
    'y% = _MOUSEY
    '
    '' read mouse buttons
    'leftButton% = _MOUSEBUTTON(1)
    'middleButton% = _MOUSEBUTTON(3)
    'rightButton% = _MOUSEBUTTON(2)
    '
    ' END READ MOUSE THE OLD QB64 WAY:
    ' =============================================================================
   
End Sub ' ReadRawMouse

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END MOUSE FUNCTIONS TO COME
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN ERROR HANDLING HELPER FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub ErrorClear
    m_sError = ""
    m_sIncludeError = ""
End Sub ' ErrorClear
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END ERROR HANDLING HELPER FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' /////////////////////////////////////////////////////////////////////////////
' FOR BITWISE OPERATIONS

Function HasBit% (iByte As Integer, iBit As Integer)
    ''TODO: precalculate
    'dim shared m_arrBitValue(1 To 8) As Integer
    'dim iLoop as Integer
    'For iLoop = 0 To 7
    '   m_arrBitValue(iLoop + 1) = 2 ^ iLoop
    'Next iLoop
    'HasBit% = ((iByte And m_arrBitValue(iBit)) = m_arrBitValue(iBit))
    Dim iBitValue As Integer
    iBitValue = 2 ^ (iBit - 1)
    HasBit% = ((iByte And iBitValue) = iBitValue)
End Function ' HasBit%

' /////////////////////////////////////////////////////////////////////////////
' Returns TRUE if value OriginalString$ is numeric.

' Re: Does a Is Number function exist in QB64?
' https://www.qb64.org/forum/index.php?topic=896.15

' Version 2 by madscijr
' Returns TRUE (-1) if string is an integer, FALSE (0) if not

' Version 1 by MWheatley
' Reply #18 on: January 01, 2019, 11:24:30 AM
' returns 1 if string is an integer, 0 if not

Function IsNumber% (OriginalString$)
    Dim bResult%: bResult% = FALSE
    Dim iLoop%
    Dim TestString$
    'Dim bNegative%
    Dim iDecimalCount%
    Dim sNextChar$

    'THEY SHOULD TRIM OUTSIDE THE FUNCTION!
    'TestString$ = _TRIM$(OriginalString$)

    If Len(OriginalString$) > 0 Then
        TestString$ = ""
        If Left$(OriginalString$, 1) = "+" Then
            TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
            'bNegative% = FALSE
        ElseIf Left$(OriginalString$, 1) = "-" Then
            TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
            'bNegative% = TRUE
        Else
            TestString$ = OriginalString$
            'bNegative% = FALSE
        End If
        If Len(TestString$) > 0 Then
            bResult% = TRUE
            iDecimalCount% = 0
            For iLoop% = 1 To Len(TestString$)
                sNextChar$ = Mid$(TestString$, iLoop%, 1)
                If sNextChar$ = "." Then
                    iDecimalCount% = iDecimalCount% + 1
                    If iDecimalCount% > 1 Then
                        ' TOO MANY DECIMAL POINTS, INVALID!
                        bResult% = FALSE
                        Exit For
                    End If
                ElseIf Asc(sNextChar$) < 48 Or Asc(sNextChar$) > 57 Then
                    ' NOT A NUMERAL OR A DECIMAL, INVALID!
                    bResult% = FALSE
                    Exit For
                End If
            Next iLoop%
        End If
    End If
    IsNumber% = bResult%
End Function ' IsNumber%

' /////////////////////////////////////////////////////////////////////////////
' 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$)
    Dim result$
    Dim iLoop%
    result$ = in$(LBound(in$))
    For iLoop% = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(iLoop%)
    Next iLoop%
    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

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ################################################################################################################################################################
' #REFERENCE

' =============================================================================
' SOME USEFUL STUFF FOR REFERENCE:

' Type Name               Type suffix symbol   Minimum value                  Maximum value                Size in Bytes
' ---------------------   ------------------   ----------------------------   --------------------------   -------------
' _BIT                    `                    -1                             0                            1/8
' _BIT * n                `n                   -128                           127                          n/8
' _UNSIGNED _BIT          ~`                   0                              1                            1/8
' _BYTE                   %%                   -128                           127                          1
' _UNSIGNED _BYTE         ~%%                  0                              255                          1
' INTEGER                 %                    -32,768                        32,767                       2
' _UNSIGNED INTEGER       ~%                   0                              65,535                       2
' LONG                    &                    -2,147,483,648                 2,147,483,647                4
' _UNSIGNED LONG          ~&                   0                              4,294,967,295                4
' _INTEGER64              &&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    8
' _UNSIGNED _INTEGER64    ~&&                  0                              18,446,744,073,709,551,615   8
' SINGLE                  ! or none            -2.802597E-45                  +3.402823E+38                4
' DOUBLE                  #                    -4.490656458412465E-324        +1.797693134862310E+308      8
' _FLOAT                  ##                   -1.18E-4932                    +1.18E+4932                  32(10 used)
' _OFFSET                 %&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    Use LEN
' _UNSIGNED _OFFSET       ~%&                  0                              18,446,744,073,709,551,615   Use LEN
' _MEM                    none                 combined memory variable type  N/A                          Use LEN

' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%

' @END

Program B "MAINPROG.BAS" - this is set to always on top, but Program A "READMICE.BAS" must have the actual focus.
Code: (Select All)
' ################################################################################################################################################################
' Multimouse program B "mainprog.bas" = front end
' ################################################################################################################################################################

' Working proof of concept! (Windows only so far)
' 1. Plug 2 or more USB mice into your computer.
' 2. Run the mouse reader program "readmice.bas"
' 3. Run the front end program "mainprog.bas"
' 4. Drag the windows and make sure they line up, one on top of the other.
' 5. Set the focus to "readmice.bas" (it will be hidden underneath "mainprog", so use the taskbar or ALT+TAB).
' 6. Try moving each mouse. Each one should move a different letter.
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' madscijr - Mini-Mod
' #34
' 09-12-2022, 12:05 PM (This post was last modified: 09-12-2022, 12:07 PM by madscijr.)
' (09-09-2022, 04:27 PM) Spriggsy Wrote:
' >The button catching was working in the example I gave you so you might want to take a look at that mousemessage string. My version displayed the current button being pressed. Here is the relevant link for the RAWMOUSE struct.
' >https://docs.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawmouse
' >You can see the value for each button state listed there.
' >Edit.... Weird. Now it isn't wanting to work on my machine. It was working yesterday just fine.
' >Edit again.... Ah, I wasn't drawing the button information again. I accidentally erased the update. See below and you can try it out. The code does catch the buttons.
'
' Aha, thanks. The mouse button up/down are now being detected and I have it saving the state for left/middle/right clicks (code below).
'
' Now what black magic are we going to have to do, to get this out of the "event driven" code, and working like a regular QB64 program?
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' McNeill - Super Moderator
' #2
' 05-17-2024, 07:27 PM (This post was last modified: 05-17-2024, 07:28 PM by SMcNeill.)
' https://qb64phoenix.com/qb64wiki/index.php/Windows_Libraries#Top_Most_Window

' SMcNeill - Super Moderator
' #11
' 2 hours ago
' Const SWP_NOMOVE = &H0002 'ignores x and y position parameters

' Steffan-68 - Junior Member
' #12
' 2 hours ago
' Do both programs have to be in the same place on the monitor?
' If not, you can change these lines.
'     If 0 = SetWindowPos(hWnd, HWND_TOPMOST, 840, 200, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE) Then
' und
'     _ScreenClick 880, 240 ' add 40 to x and y to focus on positioned window
'
' This means that both programs would be next to each other,
' but only the one that is set to foreground remains in the foreground
' and the other one could then fade into the background.
' I don't know what you're trying to do, maybe you could also
' play around with the command (_SCREENICON).
' So that the program that is not in the foreground disappears from the monitor?

' SMcNeill - Super Moderator
' #13
' 2 hours ago
' Sorry. I didn't notice the need for _SCREENCLICK.
' What you're looking for is:
' https://qb64phoenix.com/qb64wiki/index.php/SCREENX
' https://qb64phoenix.com/qb64wiki/index.php/SCREENY
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------


Option Explicit
_Title "mainprog"
$NoPrefix
'$Console:Only
'Console Off

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CONSTANTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Const cProgName = "mainprog"
Const FALSE = 0
Const TRUE = Not FALSE

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' USED TO CONVERT MOUSE POSITION TO GET SCREEN POSITION
' ScreenPos = MousePos / ScaleValue
' This doesn't really work too accurately!
Const cScaleX = 3
Const cScaleY = 6

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' TEXT MODE COLORS:
Const cBlack = 0: Const cBlue = 1: Const cGreen = 2: Const cLtBlue = 3
Const cRed = 4: Const cPurple = 5: Const cOrange = 6: Const cWhite = 7
Const cGray = 8: Const cPeriwinkle = 9: Const cLtGreen = 10: Const cCyan = 11
Const cLtRed = 12: Const cPink = 13: Const cYellow = 14: Const cLtGray = 15

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' FOR CONTROLLING WINDOW ON TOP, ETC.
Const SWP_NOSIZE = &H0001 'ignores cx and cy size parameters
Const SWP_NOMOVE = &H0002 'ignores x and y position parameters
Const SWP_NOZORDER = &H0004 'keeps z order and ignores hWndInsertAfter parameter
Const SWP_NOREDRAW = &H0008 'does not redraw window changes
Const SWP_NOACTIVATE = &H0010 'does not activate window
Const SWP_FRAMECHANGED = &H0020
Const SWP_SHOWWINDOW = &H0040
Const SWP_HIDEWINDOW = &H0080
Const SWP_NOCOPYBITS = &H0100
Const SWP_NOOWNERZORDER = &H0200
Const SWP_NOSENDCHANGING = &H0400
Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Const SWP_DEFERERASE = &H2000
Const SWP_ASYNCWINDOWPOS = &H4000
Const HWND_TOP = 0 'window at top of z order no focus
Const HWND_BOTTOM = 1 'window at bottom of z order no focus
Const HWND_TOPMOST = -1 'window above all others no focus unless active
Const HWND_NOTOPMOST = -2 'window below active no focus

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' CONSTANT FOR 2ND DIMENSION OF arrFile ARRAY
Const cFileName = 0
Const cFileData = 1

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' CONSTANT FOR WHAT DATA IS EXPECTED FROM THIS LINE IN FILE
Const cUpdateCount = 1
Const cMouseX = 2
Const cMouseY = 3
Const cMouseWheel = 4
Const cMouseLeftDown = 5
Const cMouseMiddleDown = 6
Const cMouseRightDown = 7

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END CONSTANTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN API DECLARATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' FOR CONTROLLING WINDOW ON TOP, ETC.
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
Declare Dynamic Library "user32"
    Function FindWindowA%& (ByVal lpClassName%&, Byval lpWindowName%&)
    Function SetWindowPos& (ByVal hWnd%&, Byval hWndInsertAfter%&, Byval X&, Byval Y&, Byval cx&, Byval cy&, Byval uFlags~&)
    Function GetForegroundWindow%&
End Declare

Declare Dynamic Library "kernel32"
    Function GetLastError~& ()
End Declare

' UDT TO HOLD THE INFO FOR EACH MOUSE
Type InfoType
    ID As String ' player identifier or mouse device ID
    char As String ' cursor character
    color As Integer ' character color
    row As Integer ' line to display values at
   
    UpdateCount As Integer ' if this value changes we know a value changed
    OldUpdateCount As Integer ' if this value changes we know a value changed
   
    mouseX As Integer ' mouse x position
    mouseY As Integer ' mouse y position
    x As Integer ' screen x position
    y As Integer ' screen y position
    oldX As Integer
    oldY As Integer
    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 API DECLARATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL VARIABLES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 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)

' GLOBAL VARIABLES TO TRACK ERROR STATE
Dim Shared m_sError As String: m_sError = ""
Dim Shared m_sIncludeError As String: m_sIncludeError = ""

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL VARIABLES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ****************************************************************************************************************************************************************
' BEGIN DEBUG CONSOLE
' ****************************************************************************************************************************************************************
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bDebug As Integer: m_bDebug = TRUE

' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    $Console
    _Delay 4
    _Console On
    _Echo "Started " + m_ProgramName$
    _Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
' END DEBUG CONSOLE
' ****************************************************************************************************************************************************************


' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' EXECUTION STARTS HERE!
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' =============================================================================
' START THE MAIN ROUTINE
main

' =============================================================================
' FINISH
Print m_ProgramName$ + " finished."

' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
    _Console Off
End If
' ****************************************************************************************************************************************************************

End
'System ' return control to the operating system

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL ERROR HANDLER
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ErrorHandler:
m_sError = "Error #" + _Trim$(Str$(Err)) + " at line " + _Trim$(Str$(_ErrorLine)) + "."
m_sIncludeError = "File " + Chr$(34) + _InclErrorFile$ + Chr$(34) + " at line " + _Trim$(Str$(_InclErrorLine)) + "."
Resume Next
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL ERROR HANDLER
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN MAIN ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' /////////////////////////////////////////////////////////////////////////////

Sub main
    ' MOUSE TEST VARIABLES
    Dim arrInfo(0 To 8) As InfoType ' STORES INFO FOR EACH MOUSE
    'Dim arrRawMouseID(8) As Long ' device IDs for mice connected to system (guessing this would be a string, dunno)
    Dim iMouseCount As Integer ' # OF MICE ATTACHED

    'Dim arrScreen(1 To 80, 1 To 25) As String ' STORES TEXT FOR SCREEN
    Dim iMinX As Long
    Dim iMaxX As Long
    Dim iMinY As Long
    Dim iMaxY As Long

    ' RAW FILE NAMES
    Dim arrFile(0 To 31, 0 To 1) As String

    ' WINDOW VARIABLES
    Dim hWndThis As _Offset ' hWndThis%&
    Dim hWndTop As _Offset ' x%&

    ' OTHER VARS
    Dim iLoop As Integer
    Dim sNextError As String
    Dim iIndex As Integer
    Dim sLine As String
    Dim iLineNum As Integer
    Dim iCount As Integer
    Dim iCol As Integer
    Dim iRow As Integer
    Dim arrColor(0 To 31) As Integer
    Dim in$
   
    ' =============================================================================
    ' SET ERROR TRAPPING
    On Error GoTo ErrorHandler

    ' =============================================================================
    ' INITIALIZE VARIABLES
   
    ' INITIALIZE MOUSE INPUT FILENAMES
    For iLoop = LBound(arrFile) To UBound(arrFile)
        arrFile(iLoop, cFileName) = m_ProgramPath$ + "mouse" + _Trim$(Str$(iLoop)) + ".txt"
        arrFile(iLoop, cFileData) = ""
    Next iLoop
   
    ' INITALIZE COLORS
    iCount = 0
    For iLoop = LBound(arrColor) To UBound(arrColor)
        iCount = iCount + 1: If iCount > 15 Then iCount = 1
        arrColor(iLoop) = iCount
    Next iLoop
   
    ' INITIALIZE USER DATA
    iCount = 0
    For iIndex = LBound(arrInfo) To UBound(arrInfo)
        iCount = iCount + 1
        arrInfo(iIndex).ID = "Mouse" + _Trim$(Str$(iCount))
        arrInfo(iIndex).char = Chr$(64 + iCount)
        arrInfo(iIndex).color = arrColor(iCount)
        arrInfo(iIndex).row = iCount + 4
       
        arrInfo(iIndex).UpdateCount = 0
        arrInfo(iIndex).OldUpdateCount = 0
       
        arrInfo(iIndex).mouseX = 0
        arrInfo(iIndex).mouseY = 0
        arrInfo(iIndex).x = 1
        arrInfo(iIndex).y = 1
        arrInfo(iIndex).oldX = 1
        arrInfo(iIndex).oldY = 1
        arrInfo(iIndex).wheel = 0
        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 iIndex

    ' =============================================================================
    ' MOVE WINDOW TO TOP
   
    ' GET WINDOW HANDLES
    hWndThis = _WindowHandle ' FindWindowA(0, _OFFSET(t))
    hWndTop = GetForegroundWindow%& ' find currently focused process handle

    ' GET FOCUS
    If hWndThis <> hWndTop Then
        _ScreenClick 240, 240 ' add 40 to x and y to focus on positioned window
    End If

    ' MOVE TO TOP
    If SetWindowPos(hWndThis, HWND_TOPMOST, 200, 200, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE) = 0 Then
        'sNextError = "SetWindowPos failed. 0x" + LCase$(Hex$(GetLastError))
        m_sError = "SetWindowPos failed. 0x" + LCase$(Hex$(GetLastError))
    End If

    ' =============================================================================
    ' INIT SCREEN
    Screen 12 ' SCREEN 12 can use 16 color attributes with a black background. 256K possible RGB color hues. Background colors can be used with QB64.
    'Screen _NewImage(1024, 768, 32)
   
    ' SET MIN/MAX SCREEN POSITIONS
    iMinX = 1 ' 2
    iMaxX = 80 ' 79
    iMinY = 1
    iMaxY = 30
   
    ' window needs to be lined up directly under the main program, so the mouse coordinates align with the display
    _ScreenMove 0, 0
    '_SCREENMOVE _MIDDLE
   
    Cls , cBlack
   
    ' =============================================================================
    ' MAIN LOOP
    Do
        ' PRINT MESSAGE
        iRow = 1: iCol = 1
        Color cLtRed, cBlack
        PrintString1 iRow, iCol, "*** MAKE SURE PROGRAM READMICE HAS THE FOCUS ***"
        iRow = 2: iCol = 1
        Color cCyan, cBlack
        PrintString1 iRow, iCol, "Plug in 2 or more USB mice and move them around over the window."
       
        ' PRINT HEADER ROW
        iRow = 4: iCol = 1
        Color cBlack, cWhite
       
        PrintString1 iRow, iCol, "CHAR    ": iCol = iCol + 9
        PrintString1 iRow, iCol, "Mouse X ": iCol = iCol + 9
        PrintString1 iRow, iCol, "X       ": iCol = iCol + 9
        PrintString1 iRow, iCol, "Mouse Y ": iCol = iCol + 9
        PrintString1 iRow, iCol, "Y       ": iCol = iCol + 9
        PrintString1 iRow, iCol, "WHEEL   ": iCol = iCol + 9
        PrintString1 iRow, iCol, "LEFT    ": iCol = iCol + 9
        PrintString1 iRow, iCol, "MIDDLE  ": iCol = iCol + 9
        PrintString1 iRow, iCol, "RIGHT   ": iCol = iCol + 9

        ' PROCESS EACH USER'S INPUT
        For iIndex = LBound(arrInfo) To UBound(arrInfo)
            DebugPrint "READ INPUT #" + _Trim$(Str$(iIndex))
            DebugPrint "    FILENAME " + Chr$(34) + arrFile(iIndex, cFileName) + Chr$(34)
           
            ' -----------------------------------------------------------------------------
            ' DISPLAY VALUES TO NEXT ROW
            iRow = arrInfo(iIndex).row: iCol = 1
            Color arrInfo(iIndex).color, cBlack
            PrintString1 iRow, iCol, arrInfo(iIndex).char + "         ": iCol = iCol + 9
           
            ' -----------------------------------------------------------------------------
            ' REDRAW AND SAVE OLD COORDINATES
            If arrInfo(iIndex).oldX <> arrInfo(iIndex).x Or arrInfo(iIndex).oldY <> arrInfo(iIndex).y Then
                PrintString1 arrInfo(iIndex).oldY, arrInfo(iIndex).oldX, " "
                PrintString1 arrInfo(iIndex).y, arrInfo(iIndex).x, arrInfo(iIndex).char
                arrInfo(iIndex).oldY = arrInfo(iIndex).y
                arrInfo(iIndex).oldX = arrInfo(iIndex).x
            End If
           
            If Len(m_sError) > 0 Then
                ' (OUTPUT ERROR TO LOG HERE)
                'cls
                'color cLtRed, cBlack
                'print m_sError
                ''PrintString1 1,1, m_sError
                'input "PRESS ENTER TO CONTINUE"; in$
                ErrorClear
            End If
           
            ' -----------------------------------------------------------------------------
            ' READ MICE COORDINATES FROM FILE...
           
            ' FOUND FILE?
            If _FileExists(arrFile(iIndex, cFileName)) = TRUE Then
                DebugPrint "    FILE FOUND"
               
                ' OPEN FILE
                Open arrFile(iIndex, cFileName) For Input As #1
               
                ' DID IT WORK?
                If Len(m_sError) = 0 Then
                    DebugPrint "    FILE OPENED"
                   
                    ' READ EACH LINE
                    iLineNum = 0
                    While Not EOF(1)
                        If Len(m_sError) = 0 Then
                            ' TRACK WHAT LINE # WE'RE ON
                            iLineNum = iLineNum + 1
                           
                            DebugPrint "        READ LINE #" + _Trim$(Str$(iLineNum))
                           
                            ' READ LINE
                            Line Input #1, sLine ' read entire text file line
                           
                            ' IS IT A VALID INTEGER?
                            If IsNumber%(sLine) Then
                                ' DETERMINE WHICH VALUE IT IS FROM ORDINAL POSITION (LINE #) IN FILE
                                ' AND SAVE TO APPROPRIATE VARIABLE
                                Select Case iLineNum
                                    Case cUpdateCount
                                        ' THIS VALUE TELLS US IF THERE IS NEW INPUT
                                        arrInfo(iIndex).UpdateCount = Val(sLine)
                                       
                                    Case cMouseX:
                                        ' READ RAW VALUE
                                        arrInfo(iIndex).mouseX = Val(sLine)
                                       
                                        '' SCALE MOUSE POSITION TO SCREEN POSITION
                                        '' ScreenPos = MousePos / ScaleValue
                                        'arrInfo(iIndex).x = arrInfo(iIndex).mouseX / cScaleX
                                       
                                        ' ADJUST COORDINATES BASED ON MOVEMENT
                                        arrInfo(iIndex).x = arrInfo(iIndex).x + arrInfo(iIndex).mouseX
                                       
                                        ' CHECK BOUNDARIES
                                        If arrInfo(iIndex).x < iMinX Then
                                            arrInfo(iIndex).x = iMinX
                                        ElseIf arrInfo(iIndex).x > iMaxX Then
                                            arrInfo(iIndex).x = iMaxX
                                        End If
                                       
                                        ' DISPLAY VALUES
                                        PrintString1 iRow, iCol, sLine + "         ": iCol = iCol + 9
                                        PrintString1 iRow, iCol, _Trim$(Str$(arrInfo(iIndex).x)) + "         ": iCol = iCol + 9
                                       
                                    Case cMouseY:
                                        ' READ RAW VALUE
                                        arrInfo(iIndex).mouseY = Val(sLine)
                                       
                                        '' SCALE MOUSE POSITION TO SCREEN POSITION
                                        '' ScreenPos = MousePos / ScaleValue
                                        'arrInfo(iIndex).y = arrInfo(iIndex).mouseY / cScaleY
                                       
                                        ' ADJUST COORDINATES BASED ON MOVEMENT
                                        arrInfo(iIndex).y = arrInfo(iIndex).y + arrInfo(iIndex).mouseY
                                       
                                        ' CHECK BOUNDARIES
                                        If arrInfo(iIndex).y < iMinY Then
                                            arrInfo(iIndex).y = iMinY
                                        ElseIf arrInfo(iIndex).y > iMaxY Then
                                            arrInfo(iIndex).y = iMaxY
                                        End If
                                       
                                        ' DISPLAY VALUES
                                        PrintString1 iRow, iCol, sLine + "         ": iCol = iCol + 9
                                        PrintString1 iRow, iCol, _Trim$(Str$(arrInfo(iIndex).y)) + "         ": iCol = iCol + 9
                                       
                                    Case cMouseWheel:
                                        '' READ RAW VALUE
                                        'arrInfo(iIndex).wheel = Val(sLine)
                                        'PrintString1 iRow, iCol, _Trim$(Str$(arrInfo(iIndex).wheel)) + "         ": iCol = iCol + 9
                                       
                                        ' DISPLAY VALUES
                                        PrintString1 iRow, iCol, sLine + "         ": iCol = iCol + 9
                                    Case cMouseLeftDown:
                                        '' READ RAW VALUE
                                        'arrInfo(iIndex).LeftDown = Val(sLine)
                                        'PrintString1 iRow, iCol, _Trim$(Str$(arrInfo(iIndex).LeftDown)) + "         ": iCol = iCol + 9
                                       
                                        ' DISPLAY VALUES
                                        PrintString1 iRow, iCol, sLine + "         ": iCol = iCol + 9
                                    Case cMouseMiddleDown:
                                        '' READ RAW VALUE
                                        'arrInfo(iIndex).MiddleDown = Val(sLine)
                                        'PrintString1 iRow, iCol, _Trim$(Str$(arrInfo(iIndex).MiddleDown)) + "         ": iCol = iCol + 9
                                       
                                        ' DISPLAY VALUES
                                        PrintString1 iRow, iCol, sLine + "         ": iCol = iCol + 9
                                    Case cMouseRightDown:
                                        '' READ RAW VALUE
                                        'arrInfo(iIndex).RightDown = Val(sLine)
                                        'PrintString1 iRow, iCol, _Trim$(Str$(arrInfo(iIndex).RightDown)) + "         ": iCol = iCol + 9
                                       
                                        ' DISPLAY VALUES
                                        PrintString1 iRow, iCol, sLine + "         ": iCol = iCol + 9
                                    Case Else:
                                        ' Unknown
                                End Select
                            End If
                           
                            If Len(m_sError) <> 0 Then
                                DebugPrint "        ERROR AT Line Input #1: " + m_sError
                               
                                ' SOME OTHER ERROR HAPPENED
                                ' (OUTPUT ERROR TO LOG HERE)
                                ErrorClear
                            End If
                           
                        Else
                            DebugPrint "        ERROR AT While Not EOF(1): " + m_sError
                           
                            ' ERROR READING LINE...
                           
                            ' (OUTPUT ERROR TO LOG HERE)
                            ErrorClear
                        End If
                       
                        ' EXIT IF VALUES HAVEN'T CHANGED
                        If arrInfo(iIndex).UpdateCount = arrInfo(iIndex).OldUpdateCount Then
                            ' STOP THE MOUSE DX / DY
                            arrInfo(iIndex).mouseY = 0
                            arrInfo(iIndex).mouseX = 0
                           
                            ' WE CAN STOP READING THE FILE
                            Exit While
                        End If
                       
                    Wend
                    Close #1
                   
                    ' UPDATE OLD VALUE FOR NEXT CHANGE TEST
                    If arrInfo(iIndex).UpdateCount <> arrInfo(iIndex).OldUpdateCount Then
                        arrInfo(iIndex).OldUpdateCount = arrInfo(iIndex).UpdateCount
                    End If
                   
                Else
                    DebugPrint "    ERROR OPENING FILE: " + m_sError
                   
                    ' ERROR OPENING FILE...
                   
                    ' (OUTPUT ERROR TO LOG HERE)
                    'color cLtRed, cBlack
                    'PrintString1 1, 1, "Error opening file " + chr$(34) + arrFile(iIndex, cFileName) + chr$(34)
                    'PrintString1 1, 1, m_sError
                    ErrorClear
                End If
            Else
                DebugPrint "    FILE NOT FOUND"
                ' FILE NOT FOUND
                ' JUST IGNORE
               
                '' DEBUG OUTPUT:
                'color cLtRed, cBlack
                ''PrintString1 1,1, m_sError
                ''Print "File not found: " + chr$(34) + arrFile(iIndex, cFileName) + chr$(34)
                'PrintString1 1, 1, "File not found: " + chr$(34) + arrFile(iIndex, cFileName) + chr$(34)
            End If
           
            ' -----------------------------------------------------------------------------
            ' GET KEYBOARD INPUT
            While _DeviceInput(1): Wend ' clear and update the keyboard buffer
            If _KeyDown(27) Then
                DebugPrint "DETECTED ESC = _KeyDown(27) = EXITING"
               
                Exit Do ' leave loop when ESC key pressed
            End If
           
        Next iIndex
       
        _Limit 60 ' run 60 fps
    Loop
   
End Sub ' main

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END MAIN ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN ERROR HANDLING HELPER FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub ErrorClear
    m_sError = ""
    m_sIncludeError = ""
End Sub ' ErrorClear
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END ERROR HANDLING HELPER FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GRAPHIC PRINTING ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' /////////////////////////////////////////////////////////////////////////////
' Does a _PrintString at the specified row+column.
' iRow and iCol are 0-based.
' See also: PrintString1

Sub PrintString0 (iRow As Integer, iCol As Integer, MyString As String)
    Dim iX As Integer
    Dim iY As Integer
    iX = _FontWidth * iCol
    iY = _FontHeight * iRow ' (iRow + 1)
    _PrintString (iX, iY), MyString
End Sub ' PrintString0

' /////////////////////////////////////////////////////////////////////////////
' Does a _PrintString at the specified row+column.
' iRow and iCol are 1-based.
' See also: PrintString0

Sub PrintString1g (iRow As Integer, iCol As Integer, MyString As String)
    Dim iX As Integer
    Dim iY As Integer
    iX = _FontWidth * (iCol - 1)
    iY = _FontHeight * (iRow - 1)
    _PrintString (iX, iY), MyString
End Sub ' PrintString1g

' /////////////////////////////////////////////////////////////////////////////
' Prints a string at the specified row+column.
' iRow and iCol are 1-based.
' See also: PrintString0

Sub PrintString1 (iRow As Integer, iCol As Integer, MyString As String)
    Locate iRow, iCol
    Print MyString;
End Sub ' PrintString1

' /////////////////////////////////////////////////////////////////////////////
' Eliminates the math.

' Text resolution:
'  648 x  480:  80 x 30
'  720 x  480:  90 x 30
'  800 x  600: 100 x 37
' 1024 x  768: 128 x 48
' 1280 x 1024: 160 x 64
' 1920 x 1080: 240 x 67
' 2048 x 1152: 256 x 72 (truncated after 70 rows, 255 columns)
' 3840 x 2160: 480 x135 (truncated after 133 rows, 479 columns)

Sub PrintStringCR1 (iCol As Integer, iRow As Integer, MyString As String)
    Dim iCols As Integer
    Dim iRows As Integer
    Dim iX As Integer
    Dim iY As Integer
    iCols = _Width(0) \ _FontWidth
    iRows = _Height(0) \ _FontHeight
    iX = _FontWidth * (iCol - 1)
    iY = _FontHeight * (iRow - 1)
    _PrintString (iX, iY), MyString
End Sub ' PrintStringCR1

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GRAPHIC PRINTING ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' /////////////////////////////////////////////////////////////////////////////
' FOR BITWISE OPERATIONS

Function HasBit% (iByte As Integer, iBit As Integer)
    ''TODO: precalculate
    'dim shared m_arrBitValue(1 To 8) As Integer
    'dim iLoop as Integer
    'For iLoop = 0 To 7
    '   m_arrBitValue(iLoop + 1) = 2 ^ iLoop
    'Next iLoop
    'HasBit% = ((iByte And m_arrBitValue(iBit)) = m_arrBitValue(iBit))
    Dim iBitValue As Integer
    iBitValue = 2 ^ (iBit - 1)
    HasBit% = ((iByte And iBitValue) = iBitValue)
End Function ' HasBit%

' /////////////////////////////////////////////////////////////////////////////
' Returns TRUE if value OriginalString$ is numeric.

' Re: Does a Is Number function exist in QB64?
' https://www.qb64.org/forum/index.php?topic=896.15

' Version 2 by madscijr
' Returns TRUE (-1) if string is an integer, FALSE (0) if not

' Version 1 by MWheatley
' Reply #18 on: January 01, 2019, 11:24:30 AM
' returns 1 if string is an integer, 0 if not

Function IsNumber% (OriginalString$)
    Dim bResult%: bResult% = FALSE
    Dim iLoop%
    Dim TestString$
    'Dim bNegative%
    Dim iDecimalCount%
    Dim sNextChar$

    'THEY SHOULD TRIM OUTSIDE THE FUNCTION!
    'TestString$ = _TRIM$(OriginalString$)

    If Len(OriginalString$) > 0 Then
        TestString$ = ""
        If Left$(OriginalString$, 1) = "+" Then
            TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
            'bNegative% = FALSE
        ElseIf Left$(OriginalString$, 1) = "-" Then
            TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
            'bNegative% = TRUE
        Else
            TestString$ = OriginalString$
            'bNegative% = FALSE
        End If
        If Len(TestString$) > 0 Then
            bResult% = TRUE
            iDecimalCount% = 0
            For iLoop% = 1 To Len(TestString$)
                sNextChar$ = Mid$(TestString$, iLoop%, 1)
                If sNextChar$ = "." Then
                    iDecimalCount% = iDecimalCount% + 1
                    If iDecimalCount% > 1 Then
                        ' TOO MANY DECIMAL POINTS, INVALID!
                        bResult% = FALSE
                        Exit For
                    End If
                ElseIf Asc(sNextChar$) < 48 Or Asc(sNextChar$) > 57 Then
                    ' NOT A NUMERAL OR A DECIMAL, INVALID!
                    bResult% = FALSE
                    Exit For
                End If
            Next iLoop%
        End If
    End If
    IsNumber% = bResult%
End Function ' IsNumber%

' /////////////////////////////////////////////////////////////////////////////
' 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$)
    Dim result$
    Dim iLoop%
    result$ = in$(LBound(in$))
    For iLoop% = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(iLoop%)
    Next iLoop%
    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

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ################################################################################################################################################################
' BEGIN DEBUGGING ROUTINES #DEBUG
' ################################################################################################################################################################

' /////////////////////////////////////////////////////////////////////////////
' Prints MyString to console with linebreaks.

' Thanks to:
' SpriggsySpriggs for how to use the QB64 debug console:
' https://www.qb64.org/forum/index.php?topic=3949.0

Sub DebugPrint (MyString As String)
    If m_bDebug = TRUE Then
        ReDim arrLines(-1) As String
        Dim iLoop As Integer
        split MyString, Chr$(13), arrLines()
        For iLoop = LBound(arrLines) To UBound(arrLines)
            _Echo arrLines(iLoop)
        Next iLoop
    End If
End Sub ' DebugPrint

' /////////////////////////////////////////////////////////////////////////////
' Simply prints s$ to console (no linebreaks).

Sub DebugPrint1 (s$)
    If m_bDebug = TRUE Then
        _Echo s$
    End If
End Sub ' DebugPrint1

' ################################################################################################################################################################
' END DEBUGGING ROUTINES @DEBUG
' ################################################################################################################################################################

' ################################################################################################################################################################
' #REFERENCE

' =============================================================================
' SOME USEFUL STUFF FOR REFERENCE:

' Type Name               Type suffix symbol   Minimum value                  Maximum value                Size in Bytes
' ---------------------   ------------------   ----------------------------   --------------------------   -------------
' _BIT                    `                    -1                             0                            1/8
' _BIT * n                `n                   -128                           127                          n/8
' _UNSIGNED _BIT          ~`                   0                              1                            1/8
' _BYTE                   %%                   -128                           127                          1
' _UNSIGNED _BYTE         ~%%                  0                              255                          1
' INTEGER                 %                    -32,768                        32,767                       2
' _UNSIGNED INTEGER       ~%                   0                              65,535                       2
' LONG                    &                    -2,147,483,648                 2,147,483,647                4
' _UNSIGNED LONG          ~&                   0                              4,294,967,295                4
' _INTEGER64              &&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    8
' _UNSIGNED _INTEGER64    ~&&                  0                              18,446,744,073,709,551,615   8
' SINGLE                  ! or none            -2.802597E-45                  +3.402823E+38                4
' DOUBLE                  #                    -4.490656458412465E-324        +1.797693134862310E+308      8
' _FLOAT                  ##                   -1.18E-4932                    +1.18E+4932                  32(10 used)
' _OFFSET                 %&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    Use LEN
' _UNSIGNED _OFFSET       ~%&                  0                              18,446,744,073,709,551,615   Use LEN
' _MEM                    none                 combined memory variable type  N/A                          Use LEN

' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%

' @END
Reply
#2
I would agree that the file input like that is likely to cause problems, files really aren't made for that kind of task. Your best QB64 option would be a TCP/IP connection between the two programs, which overall is fairly easy to implement. If you have the main program start the mouse program then you can even pass the connection details as an argument to avoid hard-coding them between the programs.

I have two simple examples here, the `host` would be your main program and the `client` would be the mouse program:

Host:
Code: (Select All)

Dim port As _Unsigned Integer

' between 40000 and 50000
port = Rnd * 10000 + 40000

h& = _OpenHost("tcp/ip:" + _Trim$(Str$(port)))
Print h&

Shell _DontWait "client " + Str$(port)

c& = 0
While c& = 0
    _Limit 60
    c& = _OpenConnection(h&)
Wend

Do
    _Limit 60
    'main loop
    Get #c&, , s$

    Print s$
Loop While _Connected(c&)

Client:
Code: (Select All)

Dim port As _Unsigned Integer

port = Val(Command$(1))
Print "port: "; port

c& = _OpenClient("tcp/ip:" + _Trim$(Str$(port)) + ":localhost")
Print c&

Do
    _Limit 120
    ' send mouse info
    i = i + 1
    s$ = "hi there! " + Str$(i)
    Put #c&, , s$
Loop

You probably already deal with this with the files, but one thing to note is that there's no guarantee on the batching of the bytes sent by the other program. You'll see this if you run my example programs, sometimes the Host receives multiple lines of input and sometimes only one. Effectively the best approach is to simply buffer up all the `Get` strings until you have enough bytes to have a full mouse message, rather than expect to receive whole mouse events one at a time.

Using a "pipe" is another option, but those aren't exposed in QB64 so it would be a bit more complex.
Reply
#3
(05-23-2024, 04:26 AM)DSMan195276 Wrote: I would agree that the file input like that is likely to cause problems, files really aren't made for that kind of task. Your best QB64 option would be a TCP/IP connection between the two programs, which overall is fairly easy to implement. If you have the main program start the mouse program then you can even pass the connection details as an argument to avoid hard-coding them between the programs.

...

Using a "pipe" is another option, but those aren't exposed in QB64 so it would be a bit more complex.
Thanks for your reply - those examples are nice and short, I look forward to giving them a try. 
By "pipe" do you mean one prog calling another with command line args, or something else, like a program sending args to a different application already running? 
Thanks again!
Reply
#4
One thing you might consider is to write a "Last Used By" Variable at the top of the code.

PUT #1, , UsedBY 
PUT #1, , Data_to_Transfer

Now, whenever you look at the file, you can tell from that first set of bytes if it's available for read/write or not.

If those bytes are:

00 -- then there's no read/writing going on.  The file is in a blank slate and either side can write to the file.  There's nothing to read.
01 -- the first file is now accessing this data.  The 2nd one should wait for it to finish whatever it's doing.
10 -- the second file is now accessing the data.  The 1st program should now wait for it to finish whatever it's doing.

When one file needs to do something, it always checks the status of that first byte to make certain that the file is ready for it to send/recieve data, and thus doesn't try to access it while the other program is manipulating the data in that file, until its finished.
Reply
#5
(05-23-2024, 04:44 AM)madscijr Wrote: Thanks for your reply - those examples are nice and short, I look forward to giving them a try. 
By "pipe" do you mean one prog calling another with command line args, or something else, like a program sending args to a different application already running? 
Thanks again!
"pipe" refers to either a Unix pipe or a Windows Anonymous Pipe. They have different APIs but functionally achieve the same thing, you call a function that gives you back two handles that make up a "pipe", where one is the "read handle" and the other the "write handle". You can read/write to these handles like regular files, and any data written to the "write handle" will show up as data to read from the "read handle".

Through various methods you can pass the "write handle" to your client program and keep the "read handle" in your host program, this allows the client program to write data to the "write handle" that the host can receive via reading from the "read handle". It effectively achieves exactly what my example did but removes the need to introduce any networking (which simplifies the process and removes some potential failure points).
Reply
#6
(05-23-2024, 04:59 AM)SMcNeill Wrote: One thing you might consider is to write a "Last Used By" Variable at the top of the code.

PUT #1, , UsedBY 
PUT #1, , Data_to_Transfer

Now, whenever you look at the file, you can tell from that first set of bytes if it's available for read/write or not.

If those bytes are:

00 -- then there's no read/writing going on.  The file is in a blank slate and either side can write to the file.  There's nothing to read.
01 -- the first file is now accessing this data.  The 2nd one should wait for it to finish whatever it's doing.
10 -- the second file is now accessing the data.  The 1st program should now wait for it to finish whatever it's doing.

When one file needs to do something, it always checks the status of that first byte to make certain that the file is ready for it to send/recieve data, and thus doesn't try to access it while the other program is manipulating the data in that file, until its finished.
Not sure I understand... How can it read bytes without crashing if the file isn't available? 
Could you maybe post a full concrete example so I can see what you mean? 
Thanks!
Reply
#7
I've got code somewhere for doing named pipes. Can't remember where it is :|

Found my code for communicating between processes but this is not with a named pipe:
Child Processes in QB64 using WinAPI (alephc.xyz)
Tread on those who tread on you

Reply
#8
Quote:Not sure I understand... How can it read bytes without crashing if the file isn't available? 
Could you maybe post a full concrete example so I can see what you mean? 
One could almost compare it with a traffic light at an intersection: If North - South is green, then West - East has to wait (red) until it itself is green. If all road users stick to it, there won't be crashed.  Wink
Reply
#9
(05-23-2024, 05:45 PM)Kernelpanic Wrote: One could almost compare it with a traffic light at an intersection: If North - South is green, then West - East has to wait (red) until it itself is green. If all road users stick to it, there won't be crashed.  Wink
Unfortunately Steve's approach can't prevent both programs from reading and writing at the same time, I don't think there's a way to do it with read/write file interactions alone. Both programs can read the `00` at the same time and will simply write over each-other when updating the status. Then you'll have the main program reading the mouse data while the second program is writing it, and it falls apart.

That said an alternative for madscijr's original approach could be to have the mouse program write to a completely separate temporary file and then use `NAME` to rename the file to be the correct one. That has two advantages that 1. There's no period where the file is created but doesn't have the correct contents, and 2. There's no period where the file exists but is open by the mouse program (since the mouse program closes it before renaming). Over in the main program you can have it use `KILL` to delete the file after reading the contents, that would signal to the mouse program that the file is available to be used again.

It's still not as good as a proper IPC approach like using networking or a pipe, but might solve the problem.
Reply
#10
I might have another thought.
I'm not particularly a fan of constantly writing to a file and deleting it again.
Since it looks like it's just a Windows program, how about writing stad to a file just using the clipboard?
It would all be in RAM and no HDD access.
Reply




Users browsing this thread: 3 Guest(s)