(09-08-2022, 07:27 PM)Spriggsy Wrote: You don't have to put the headers in the same folder as the other includes. All you have to do is either have it with QB64 or just put it into a subfolder and use the relative path. I typically just keep headers and bas files in the QB64 parent directory. Or I make a subfolder and reference them using the relative paths. For instance, if I have a header in a folder called "Headers" and that folder is in the QB64 parent directory, the declare can look like this:
DECLARE LIBRARY ".\Headers\headername". Also, since you put the headers in the other header folders, you shouldn't use the absolute paths anyways. Just get rid of everything in the path up until the first subfolder of the QB64 parent directory.
For instance:
DECLARE LIBRARY ".\internal\c\c_compiler\x86_64-w64-mingw32\include\headername"
However, I always recommend keeping bas and header files with QB64. Not everyone likes that. I prefer it that way.
Got it, thanks.
Now for the fun part!
The code flow seems to be set up like the C program, which is event-driven.
I see around line 211 there is a DrawText to write the mousemessage to the screen (inside Function MainWndProc).
How might this be restructured to work like a regular QB64 program that uses a more straightforward linear flow?
Specifically, how would we merge your mouse magic into the below program, to make option 4 work with it?
Option 4 calls Sub MouseRawInputTest at line 104, which reads the mice to move some text characters around the screen.
That routine can be left alone, but we would need to alter these 3 routines to work with your API functions:
At line 290: Function GetRawMouseCount% ()
At line 304: Sub GetRawMouseIDs (arrRawMouseID( 8) As Long)
At line 340: Sub ReadRawMouse (MouseID&, x%, y%, left%, middle%, right%, wheel%, wheelmin%, wheelmax%)
Any thoughts?
Code: (Select All)
' #############################################################################
' MULTIMOUSE
' ----------
' A proof of concept / experiment to try to get the computer to read
' 2 or mice plugged into the computer, as separate devices,
' to control 2 or more cursors on the screen (for multiplayer games, etc.)
'
' This lets you try 3 different methods:
' 1. _MOUSEX, _MOUSEY, etc.
' 2. _DEVICE commands
' 3. RawInput API
'
' #############################################################################
' CONSTANTS
Const FALSE = 0
Const TRUE = Not FALSE
' UDT TO HOLD THE INFO FOR EACH MOUSE
Type InfoType
c As String ' cursor character
x As Integer ' screen x position
y As Integer ' screen y position
wheel As Integer ' mouse wheel value
LeftDown As Integer ' tracks left mouse button state, TRUE=down
MiddleDown As Integer ' tracks middle mouse button state, TRUE=down
RightDown As Integer ' tracks right mouse button state, TRUE=down
LeftCount As Integer ' counts left clicks
MiddleCount As Integer ' counts middle clicks
RightCount As Integer ' counts right clicks
End Type ' InfoType
' 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)
' TRY THE MOUSE
main
' FINISH
System ' return control to the operating system
Print m_ProgramName$ + " finished."
End
' =============================================================================
' BEGIN DATA
' MOUSE CURSORS (JUST SOME LETTERS)
CData:
Data A,b,C,D,E,f,G,H
' DEFAULT/INTIAL X COORDINATE OF EACH CURSOR ON SCREEN
XData:
Data 5,15,25,35,45,55,65,75
' DEFAULT/INTIAL Y COORDINATE OF EACH CURSOR ON SCREEN
YData:
Data 17,17,19,19,21,21,23,23
' DEFAULT/INITIAL VALUE OF EACH SCROLL WHEEL
WData:
Data 224,192,160,128,96,64,32,0
' END DATA
' =============================================================================
' /////////////////////////////////////////////////////////////////////////////
Sub main
Dim in$: in$ = ""
Do
Cls
Print m_ProgramName$
Print
Print "How can we get separate input from 2 or more USB mice "
Print "plugged into one computer?"
Print
Print "1. Test using _MOUSEX, _MOUSEY, etc."
Print
Print "2. Test using _DEVICE commands"
Print
Print "3. Enumerate devices with _DEVICES to try and detect >1 mouse"
Print
Print "4. Test using RawInput API"
Print
Print "What to do ('q' to exit)"
Input in$: in$ = LCase$(Left$(in$, 1))
If in$ = "1" Then
MouseInputTest in$
ElseIf in$ = "2" Then
MouseInputTest in$
ElseIf in$ = "3" Then
EnumerateDevices: _KeyClear: '_DELAY 1
ElseIf in$ = "4" Then
MouseRawInputTest
End If
Loop Until in$ = "q"
End Sub ' main
' /////////////////////////////////////////////////////////////////////////////
' Gets mouse input using RawInput API
Sub MouseRawInputTest
' MIN/MAX VALUES
Const cMinX = 2
Const cMaxX = 79
Const cMinY = 16
Const cMaxY = 24
Const cMinWheel = 0
Const cMaxWheel = 255
' MAIN VARIABLES
Dim iCount As Integer ' # OF MICE ATTACHED
Dim arrRawMouseID(8) As Integer ' device IDs for mice connected to system (guessing this would be a string, dunno)
Dim arrInfo(8) As InfoType ' STORES INFO FOR EACH MOUSE
Dim left%, middle%, right% ' temp mouse variables
Dim iLoop As Integer
Dim iIndex As Integer
' TEMP VARIABLES FOR DISPLAYING FORMATTED VALUES TO SCREEN
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
' COUNT # OF MICE CONNECTED + GET DEVICE IDs
iCount = GetRawMouseCount% ' THIS FUNCTION WOULD ENUMERATE MICE, SHOULD RETURN 0 FOR NONE
If (iCount > 8) Then iCount = 8: ' FOR NOW ONLY SUPPORT UPTO 8 MICE
GetRawMouseIDs arrRawMouseID() ' GET MOUSE IDs
' INITIALIZE CURSORS, MOUSE STATE, ETC.
Restore CData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iCount
iIndex = iIndex + 1
Read arrInfo(iIndex).c
' INITIALIZED BELOW: arrInfo(iIndex).x = 0
' INITIALIZED BELOW: arrInfo(iIndex).y = 0
' INITIALIZED BELOW: arrInfo(iIndex).wheel = 127
arrInfo(iIndex).LeftDown = FALSE
arrInfo(iIndex).MiddleDown = FALSE
arrInfo(iIndex).RightDown = FALSE
arrInfo(iIndex).LeftCount = 0
arrInfo(iIndex).MiddleCount = 0
arrInfo(iIndex).RightCount = 0
Next iLoop
' INITIALIZE X COORDINATES
Restore XData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iCount
iIndex = iIndex + 1
Read arrInfo(iIndex).x
Next iLoop
' INITIALIZE Y COORDINATES
Restore YData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iCount
iIndex = iIndex + 1
Read arrInfo(iIndex).y
Next iLoop
' INITIALIZE SCROLL WHEEL
Restore WData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iCount
iIndex = iIndex + 1
Read arrInfo(iIndex).wheel
Next iLoop
' DRAW PLAYING FIELD
_ScreenMove _Middle
Cls ' clear screen
Locate 1, 1: Print "1. PLUG 1-8 MICE INTO THE COMPUTER"
Locate 2, 1: Print "2. USE MICE TO POSITION LETTERS ON SCREEN"
Locate 3, 1: Print "3. PRESS <ESC> TO QUIT"
Locate 4, 1: Print "--------------------------------------------------------------------------------";
Locate 5, 1: Print "# X Y Wheel LeftDown MiddleDown RightDown LeftCount MiddleCount RightCount "
Locate 6, 1: Print "--------------------------------------------------------------------------------";
' NOTE: LEAVE THE NEXT 8 LINES FREE (ROWS 8-15)
' TO DISPLAY TEST VALUES FOR UPTO 8 MICE
' DRAW BORDER AROUND PLAYING FIELD
DrawTextLine cMinX - 1, cMinY - 1, cMinX - 1, cMaxY + 1, "#"
DrawTextLine cMinX - 1, cMinY - 1, cMaxX + 1, cMinY - 1, "#"
DrawTextLine cMaxX + 1, cMaxY + 1, cMaxX + 1, cMinY - 1, "#"
DrawTextLine cMaxX + 1, cMaxY + 1, cMinX - 1, cMaxY + 1, "#"
' GET INPUT AND MOVE PLAYERS
Do
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iCount
iIndex = iIndex + 1
' ERASE CURSORS AT CURRENT POSITION
Locate arrInfo(iIndex).y, arrInfo(iIndex).x: Print " ";
' GET NEXT MOUSE INPUT
ReadRawMouse arrRawMouseID(iIndex), x%, y%, left%, middle%, right%, wheel%, wheelmin%, wheelmax%
' HANDLE LEFT MOUSE BUTTON
If left% Then
If arrInfo(iIndex).LeftDown = FALSE Then
' BUTTON DOWN EVENT
arrInfo(iIndex).LeftDown = TRUE
arrInfo(iIndex).LeftCount = arrInfo(iIndex).LeftCount + 1
End If
Else
If arrInfo(iIndex).LeftDown = TRUE Then
' BUTTON UP EVENT
arrInfo(iIndex).LeftDown = FALSE
End If
End If
' HANDLE MIDDLE MOUSE BUTTON (SCROLL WHEEL BUTTON)
If middle% Then
If arrInfo(iIndex).MiddleDown = FALSE Then
' BUTTON DOWN EVENT
arrInfo(iIndex).MiddleDown = TRUE
arrInfo(iIndex).MiddleCount = arrInfo(iIndex).MiddleCount + 1
End If
Else
If arrInfo(iIndex).MiddleDown = TRUE Then
' BUTTON UP EVENT
arrInfo(iIndex).MiddleDown = FALSE
End If
End If
' HANDLE RIGHT MOUSE BUTTON
If right% Then
If arrInfo(iIndex).RightDown = FALSE Then
' BUTTON DOWN EVENT
arrInfo(iIndex).RightDown = TRUE
arrInfo(iIndex).RightCount = arrInfo(iIndex).RightCount + 1
End If
Else
If arrInfo(iIndex).RightDown = TRUE Then
' BUTTON UP EVENT
arrInfo(iIndex).RightDown = FALSE
End If
End If
' CHECK BOUNDARIES
If arrInfo(iIndex).x < cMinX Then arrInfo(iIndex).x = cMinX
If arrInfo(iIndex).x > cMaxX Then arrInfo(iIndex).x = cMaxX
If arrInfo(iIndex).y < cMinY Then arrInfo(iIndex).y = cMinY
If arrInfo(iIndex).y > cMaxY Then arrInfo(iIndex).y = cMaxY
' PLOT CURSOR
Locate arrInfo(iIndex).y, arrInfo(iIndex).x: Print arrInfo(iIndex).c;
' DISPLAY VARIABLES
iLen = 3: sCount = Left$(LTrim$(RTrim$(Str$(iLoop))) + String$(iLen, " "), iLen)
iLen = 3: sX = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).x))) + String$(iLen, " "), iLen)
iLen = 3: sY = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).y))) + String$(iLen, " "), iLen)
iLen = 6: sWheel = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).wheel))) + String$(iLen, " "), iLen)
iLen = 9: sLeftDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).LeftDown))) + String$(iLen, " "), iLen)
iLen = 11: sMiddleDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).MiddleDown))) + String$(iLen, " "), iLen)
iLen = 10: sRightDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).RightDown))) + String$(iLen, " "), iLen)
iLen = 10: sLeftCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).LeftCount))) + String$(iLen, " "), iLen)
iLen = 12: sMiddleCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).MiddleCount))) + String$(iLen, " "), iLen)
iLen = 11: sRightCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).RightCount))) + String$(iLen, " "), iLen)
'LOCATE 5, 1: PRINT "# X Y Wheel LeftDown MiddleDown RightDown LeftCount MiddleCount RightCount "
Locate 6 + iLoop, 1: Print sCount + sX + sY + sWheel + sLeftDown + sMiddleDown + sRightDown + sLeftCount + sMiddleCount + sRightCount
Next iLoop
_Limit 100 ' keep loop at 100 frames per second
Loop Until _KeyDown(27) ' escape key exit
_KeyClear: '_DELAY 1
End Sub ' MouseRawInputTest
' /////////////////////////////////////////////////////////////////////////////
' 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 (really just the index)
' of each RawInput mouse device connected to the system (for now upto 8)
' and returns the IDs in an array of LONG
' If no mouse found, the ID will just be 0.
' *****************************************************************************
' 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)
Dim iLoop As Integer
' CLEAR OUT IDs
For iLoop = 1 To 8
arrRawMouseID(iLoop) = 0
Next iLoop
' GET IDs
'TODO: get this from RawInput API
arrRawMouseID(1) = 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 wheel% to be decremented to
' wheelmax% = maximum value to allow wheel% to be incremened to
' Parameters (values returned):
' x% = mouse x position
' y% = mouse y position
' left% = current state of left mouse button (up or down)
' middle% = current state of middle mouse button / scroll wheel button (up or down)
' right% = current state of right mouse button (up or down)
' wheel% = value of mouse scroll wheel (passed in and incremented/decremented by 1 if wheel move detected)
Sub ReadRawMouse (MouseID%, x%, y%, left%, middle%, right%, wheel%, 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
left% = FALSE
middle% = FALSE
right% = 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 (wheel% > wheelmin%) THEN
' wheel% = wheel% + scrollAmount%
' ELSEIF (scrollAmount% = 1) AND (wheel% < wheelmax%) THEN
' wheel% = wheel% + scrollAmount%
' END IF
'WEND
'
'' determine mouse x position
'x% = _MOUSEX
'
'' determine mouse y position
'y% = _MOUSEY
'
'' read mouse buttons
'left% = _MOUSEBUTTON(1)
'middle% = _MOUSEBUTTON(3)
'right% = _MOUSEBUTTON(2)
'
' END READ MOUSE THE OLD QB64 WAY:
' =============================================================================
End Sub ' ReadRawMouse
' /////////////////////////////////////////////////////////////////////////////
' Gets mouse input using _MOUSEX, _MOUSEY, _MOUSEBUTTON commands.
Sub MouseInputTest (in$)
' MIN/MAX VALUES
Const cMinX = 2
Const cMaxX = 79
Const cMinY = 16
Const cMaxY = 24
Const cMinWheel = 0
Const cMaxWheel = 255
' MAIN VARIABLES
Dim iCount As Integer ' # OF MICE ATTACHED
Dim arrMouseID(8) As String ' device IDs for mice connected to system (guessing this would be a string, dunno)
Dim arrInfo(8) As InfoType ' STORES INFO FOR EACH MOUSE
Dim left%, middle%, right% ' temp mouse variables
Dim iLoop As Integer
Dim iIndex As Integer
' TEMP VARIABLES FOR DISPLAYING FORMATTED VALUES TO SCREEN
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
' COUNT # OF MICE CONNECTED + GET DEVICE IDs
iCount = GetMouseCount% ' THIS FUNCTION WOULD ENUMERATE MICE, SHOULD RETURN 1+
If (iCount > 8) Then iCount = 8: ' FOR NOW ONLY SUPPORT UPTO 8 MICE
GetMouseIDs arrMouseID() ' GET MOUSE IDs
' INITIALIZE CURSORS, MOUSE STATE, ETC.
Restore CData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iCount
iIndex = iIndex + 1
Read arrInfo(iIndex).c
' INITIALIZED BELOW: arrInfo(iIndex).x = 0
' INITIALIZED BELOW: arrInfo(iIndex).y = 0
' INITIALIZED BELOW: arrInfo(iIndex).wheel = 127
arrInfo(iIndex).LeftDown = FALSE
arrInfo(iIndex).MiddleDown = FALSE
arrInfo(iIndex).RightDown = FALSE
arrInfo(iIndex).LeftCount = 0
arrInfo(iIndex).MiddleCount = 0
arrInfo(iIndex).RightCount = 0
Next iLoop
' INITIALIZE X COORDINATES
Restore XData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iCount
iIndex = iIndex + 1
Read arrInfo(iIndex).x
Next iLoop
' INITIALIZE Y COORDINATES
Restore YData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iCount
iIndex = iIndex + 1
Read arrInfo(iIndex).y
Next iLoop
' INITIALIZE SCROLL WHEEL
Restore WData
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iCount
iIndex = iIndex + 1
Read arrInfo(iIndex).wheel
Next iLoop
' DRAW PLAYING FIELD
_ScreenMove _Middle
Cls ' clear screen
Locate 1, 1: Print "1. PLUG 1-8 MICE INTO THE COMPUTER"
Locate 2, 1: Print "2. USE MICE TO POSITION LETTERS ON SCREEN"
Locate 3, 1: Print "3. PRESS <ESC> TO QUIT"
Locate 4, 1: Print "--------------------------------------------------------------------------------";
Locate 5, 1: Print "# X Y Wheel LeftDown MiddleDown RightDown LeftCount MiddleCount RightCount "
Locate 6, 1: Print "--------------------------------------------------------------------------------";
' NOTE: LEAVE THE NEXT 8 LINES FREE (ROWS 8-15)
' TO DISPLAY TEST VALUES FOR UPTO 8 MICE
' DRAW BORDER AROUND PLAYING FIELD
DrawTextLine cMinX - 1, cMinY - 1, cMinX - 1, cMaxY + 1, "#"
DrawTextLine cMinX - 1, cMinY - 1, cMaxX + 1, cMinY - 1, "#"
DrawTextLine cMaxX + 1, cMaxY + 1, cMaxX + 1, cMinY - 1, "#"
DrawTextLine cMaxX + 1, cMaxY + 1, cMinX - 1, cMaxY + 1, "#"
' GET INPUT AND MOVE PLAYERS
Do
iIndex = LBound(arrInfo) - 1
For iLoop = 1 To iCount
iIndex = iIndex + 1
' ERASE CURSORS AT CURRENT POSITION
Locate arrInfo(iIndex).y, arrInfo(iIndex).x: Print " ";
' GET NEXT MOUSE INPUT
If in$ = "1" Then
ReadMouse1 arrMouseID(iIndex), arrInfo(iIndex).x, arrInfo(iIndex).y, left%, middle%, right%, arrInfo(iIndex).wheel, cMinWheel, cMaxWheel
ElseIf in$ = "2" Then
ReadMouse2 arrMouseID(iIndex), arrInfo(iIndex).x, arrInfo(iIndex).y, left%, middle%, right%, arrInfo(iIndex).wheel, cMinWheel, cMaxWheel
End If
' HANDLE LEFT MOUSE BUTTON
If left% Then
If arrInfo(iIndex).LeftDown = FALSE Then
' BUTTON DOWN EVENT
arrInfo(iIndex).LeftDown = TRUE
arrInfo(iIndex).LeftCount = arrInfo(iIndex).LeftCount + 1
End If
Else
If arrInfo(iIndex).LeftDown = TRUE Then
' BUTTON UP EVENT
arrInfo(iIndex).LeftDown = FALSE
End If
End If
' HANDLE MIDDLE MOUSE BUTTON (SCROLL WHEEL BUTTON)
If middle% Then
If arrInfo(iIndex).MiddleDown = FALSE Then
' BUTTON DOWN EVENT
arrInfo(iIndex).MiddleDown = TRUE
arrInfo(iIndex).MiddleCount = arrInfo(iIndex).MiddleCount + 1
End If
Else
If arrInfo(iIndex).MiddleDown = TRUE Then
' BUTTON UP EVENT
arrInfo(iIndex).MiddleDown = FALSE
End If
End If
' HANDLE RIGHT MOUSE BUTTON
If right% Then
If arrInfo(iIndex).RightDown = FALSE Then
' BUTTON DOWN EVENT
arrInfo(iIndex).RightDown = TRUE
arrInfo(iIndex).RightCount = arrInfo(iIndex).RightCount + 1
End If
Else
If arrInfo(iIndex).RightDown = TRUE Then
' BUTTON UP EVENT
arrInfo(iIndex).RightDown = FALSE
End If
End If
' CHECK BOUNDARIES
If arrInfo(iIndex).x < cMinX Then arrInfo(iIndex).x = cMinX
If arrInfo(iIndex).x > cMaxX Then arrInfo(iIndex).x = cMaxX
If arrInfo(iIndex).y < cMinY Then arrInfo(iIndex).y = cMinY
If arrInfo(iIndex).y > cMaxY Then arrInfo(iIndex).y = cMaxY
' PLOT CURSOR
Locate arrInfo(iIndex).y, arrInfo(iIndex).x: Print arrInfo(iIndex).c;
' DISPLAY VARIABLES
iLen = 3: sCount = Left$(LTrim$(RTrim$(Str$(iLoop))) + String$(iLen, " "), iLen)
iLen = 3: sX = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).x))) + String$(iLen, " "), iLen)
iLen = 3: sY = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).y))) + String$(iLen, " "), iLen)
iLen = 6: sWheel = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).wheel))) + String$(iLen, " "), iLen)
iLen = 9: sLeftDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).LeftDown))) + String$(iLen, " "), iLen)
iLen = 11: sMiddleDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).MiddleDown))) + String$(iLen, " "), iLen)
iLen = 10: sRightDown = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).RightDown))) + String$(iLen, " "), iLen)
iLen = 10: sLeftCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).LeftCount))) + String$(iLen, " "), iLen)
iLen = 12: sMiddleCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).MiddleCount))) + String$(iLen, " "), iLen)
iLen = 11: sRightCount = Left$(LTrim$(RTrim$(Str$(arrInfo(iIndex).RightCount))) + String$(iLen, " "), iLen)
'LOCATE 5, 1: PRINT "# X Y Wheel LeftDown MiddleDown RightDown LeftCount MiddleCount RightCount "
Locate 6 + iLoop, 1: Print sCount + sX + sY + sWheel + sLeftDown + sMiddleDown + sRightDown + sLeftCount + sMiddleCount + sRightCount
Next iLoop
_Limit 100 ' keep loop at 100 frames per second
Loop Until _KeyDown(27) ' escape key exit
_KeyClear: '_DELAY 1
End Sub ' MouseInputTest
' /////////////////////////////////////////////////////////////////////////////
' Returns a count of # of mouse devices connected to the system
' *** Currently hardcoded to 1 until we figure out how to do this. ***
Function GetMouseCount% ()
GetMouseCount% = 1
End Function ' GetMouseCount%
' /////////////////////////////////////////////////////////////////////////////
' Gets ID of each mouse device connected to the system (for now upto 8)
' and returns the IDs in an array of strings
' (assuming the ID is a string and not numeric?).
' If no mouse found, the ID will just be a blank string.
' *** Currently hardcoded to "1" until we figure out how to do this. ***
Sub GetMouseIDs (arrMouseID( 8) As String)
Dim iLoop As Integer
' CLEAR OUT IDs
For iLoop = 1 To 8
arrMouseID(iLoop) = ""
Next iLoop
' GET IDs
arrMouseID(1) = "1" ' for now just fudge it!
End Sub ' GetMouseCount%
' /////////////////////////////////////////////////////////////////////////////
' Read mouse method #1, using _MOUSEX, _MOUSEY, etc.
' Gets input from mouse identified by deviceid$
' (or does that needs to be an ordinal position?)
' For version 1 we only return the input from the one mouse
' regardless of deviceid$.
' 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 (values returned):
' x% = x position of mouse pointer
' y% = y position of mouse pointer
' left% = current state of left mouse button (up or down)
' middle% = current state of middle mouse button / scroll wheel button (up or down)
' right% = current state of right mouse button (up or down)
' wheel% = value of mouse scroll wheel (passed in and incremented/decremented by 1 if wheel move detected)
' Parameters (input only):
' wheelmin% = minimum value to allow wheel% to be decremented to
' wheelmax% = maximum value to allow wheel% to be incremened to
Sub ReadMouse1 (deviceid$, x%, y%, left%, middle%, right%, wheel%, wheelmin%, wheelmax%)
Dim scrollAmount%
' 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 (wheel% > wheelmin%) Then
wheel% = wheel% + scrollAmount%
ElseIf (scrollAmount% = 1) And (wheel% < wheelmax%) Then
wheel% = wheel% + scrollAmount%
End If
Wend
' read x position
x% = _MouseX
' read y position
y% = _MouseY
' read mouse buttons
left% = _MouseButton(1)
middle% = _MouseButton(3)
right% = _MouseButton(2)
End Sub ' ReadMouse1
' /////////////////////////////////////////////////////////////////////////////
' Read mouse method #2, using _DEVICE commands.
' Gets input from mouse identified by deviceid$
' (or does that needs to be an ordinal position?)
' For version 1 we only return the input from the one mouse
' regardless of deviceid$.
' 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 (values returned):
' x% = x position of mouse pointer
' y% = y position of mouse pointer
' left% = current state of left mouse button (up or down)
' middle% = current state of middle mouse button / scroll wheel button (up or down)
' right% = current state of right mouse button (up or down)
' wheel% = value of mouse scroll wheel (passed in and incremented/decremented by 1 if wheel move detected)
' Parameters (input only):
' wheelmin% = minimum value to allow wheel% to be decremented to
' wheelmax% = maximum value to allow wheel% to be incremened to
Sub ReadMouse2 (deviceid$, x%, y%, left%, middle%, right%, wheel%, wheelmin%, wheelmax%)
Dim scrollAmount%
Dim ScreenWidth% ' screen width
Dim ScreenHeight% ' screen height
' read scroll wheel
While _DeviceInput(2) ' clear and update the mouse buffer
scrollAmount% = _Wheel(3)
If (scrollAmount% = -1) And (wheel% > wheelmin%) Then
wheel% = wheel% + scrollAmount%
ElseIf (scrollAmount% = 1) And (wheel% < wheelmax%) Then
wheel% = wheel% + scrollAmount%
End If
Wend ' clear and update the mouse buffer
' read x position
ScreenWidth% = _Width \ 2
x% = _Axis(1) * ScreenWidth% + ScreenWidth%
' read y position
ScreenHeight% = _Height \ 2
y% = _Axis(2) * ScreenHeight% + ScreenHeight%
' read mouse buttons
left% = _Button(1)
middle% = _Button(2)
right% = _Button(3)
End Sub ' ReadMouse2
' /////////////////////////////////////////////////////////////////////////////
' ORIGINAL VERSION OF FUNCTION FOR READING MOUSE WITH _DEVICE:
' Gets mouse input using _DEVICE commands (part 2 of 2, subroutine)
' SOURCE : https://www.qb64.org/forum/index.php?topic=1087.0
' Subject: Mouse demo using _DEVICE commands
' From : SMcNeill
' Date : February 21, 2019, 06:15:28 AM »
Sub UpdateMouseInfo (MouseX As Integer, MouseY As Integer, MOUSEWHEEL As Integer, LeftMouse As Integer, RightMouse As Integer, MiddleMouse As Integer, ClickThreshold As Single)
Dim SW As Integer, SH As Integer
Dim LM As Integer, MM As Integer, RM As Integer
Static leftdown As Single, middledown As Single, rightdown As Single
While _DeviceInput(2): MOUSEWHEEL = MOUSEWHEEL + _Wheel(3): Wend 'clear and update the mouse buffer
SW = _Width \ 2: SH = _Height \ 2
MouseX = _Axis(1) * SW + SW: MouseY = _Axis(2) * SH + SH
LM = _Button(1): MM = _Button(2): RM = _Button(3)
If leftdown Then 'if it was down
If LM = 0 Then 'and is now up
If Timer - leftdown < ClickThreshold Then
LeftMouse = 2 'clicked
Else 'if it's still down
LeftMouse = 0 'the mouse was just released
End If
leftdown = 0 'timer is cleared either way
Else
LeftMouse = 1 'the left mouse is down , timer should have already been set
End If
Else
If LM Then
leftdown = Timer 'set the timer to see if we have click or hold events
LeftMouse = 1 'the left mouse is down
Else
LeftMouse = 0
End If
End If
If middledown Then 'if it was down
If MM = 0 Then 'and is now up
If Timer - middledown < ClickThreshold Then
MiddleMouse = 2 'clicked
Else 'if it's still down
MiddleMouse = 0 'the mouse was just released
End If
middledown = 0 'timer is cleared either way
Else
MiddleMouse = 1 'the middle mouse is down , timer should have already been set
End If
Else
If MM Then
middledown = Timer 'set the timer to see if we have click or hold events
MiddleMouse = 1 'the middle mouse is down
Else
MiddleMouse = 0
End If
End If
If rightdown Then 'if it was down
If RM = 0 Then 'and is now up
If Timer - rightdown < ClickThreshold Then
RightMouse = 2 'clicked
Else 'if it's still down
RightMouse = 0 'the mouse was just released
End If
rightdown = 0 'timer is cleared either way
Else
RightMouse = 1 'the right mouse is down , timer should have already been set
End If
Else
If RM Then
rightdown = Timer 'set the timer to see if we have click or hold events
RightMouse = 1 'the right mouse is down
Else
RightMouse = 0
End If
End If
End Sub ' UpdateMouseInfo
' /////////////////////////////////////////////////////////////////////////////
' Example: Checking for the system's input devices.
' _DEVICES FUNCTION (QB64 REFERENCE)
' http://www.qb64.net/wiki/index_title_DEVICES/
'
' The _DEVICES function returns the number of INPUT devices on your computer
' including keyboard, mouse and game devices.
'
' Syntax:
'
' device_count% = _DEVICES
'
' Returns the number of devices that can be listed separately with the _DEVICE$
' function by the device number.
' Devices include keyboard, mouse, joysticks, game pads and multiple stick game
' controllers.
' Note: This function MUST be read before trying to use the _DEVICE$,
' _DEVICEINPUT or _LAST control functions!
' Note: The STRIG/STICK commands won't read from the keyboard
' or mouse device the above example lists.
Sub EnumerateDevices
Dim devices%
Dim iLoop%
Dim sCount$
Dim iLen As Integer
devices% = _Devices ' MUST be read in order for other 2 device functions to work!
Cls
Print "Total devices found: "; Str$(devices%)
For iLoop% = 1 To devices%
iLen = 4
sCount$ = Left$(LTrim$(RTrim$(Str$(iLoop%))) + String$(iLen, " "), iLen)
Print sCount$ + _Device$(iLoop%) + " (" + LTrim$(RTrim$(Str$(_LastButton(iLoop%)))) + " buttons)"
Next iLoop%
Print
Print "PRESS <ESC> TO CONTINUE"
Do: Loop Until _KeyDown(27) ' leave loop when ESC key pressed
_KeyClear: '_DELAY 1
End Sub ' EnumerateDevices
' /////////////////////////////////////////////////////////////////////////////
' 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$)
'bError% = FALSE
'LOCATE 2, 2: PRINT "(" + STR$(x%) + "," + STR$(y%) + ") to (" + STR$(x2%) + "," + STR$(y2%) + ") of " + CHR$(34) + c$ + CHR$(34);
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$;
Else
'PSET (x%, y%), c%
Locate x%, y%
Print 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$;
End Sub ' DrawTextLine
' ################################################################################################################################################################
' #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