09-12-2022, 08:33 PM
(09-12-2022, 08:07 PM)Spriggsy Wrote: All programs have window handles so you'll definitely have one even when full screen. InForm probably won't look very nice in full screen, though. Scaling issues and whatnot. All controls in InForm are created with BMPs, I think. With Win32, the resources scale with the client. We could make a Win32 version that goes full screen. I'm not sure about what you're wanting to do, however.
If it's okay with you, for now I'm not going to jump into InForm, which I have no experience with yet.
I think I understand how the events are working the way you have it set up.
The problem I'm having is controlling the display, screen resolution and window size.
I tweaked the code so that it still has all the events, but in Sub MouseRawInputTest
there is a main loop that runs concurrently with the events, and updates the screen
(with old fashioned CLS and PRINT statements).
However when it runs, the program just displays a blank white window.
I remembered there was some manual screen updating going on in
Function MainWndProc%&
at Case WM_PAINT,
so I tried disabling the lines there,
so QB64 could just do the screen updating itself,
but the screen is still blank.
I think if we can get the display stuff working, then we're possibly done!
Any ideas how to give control of the display back to QB64?
Here is the latest code:
Code: (Select All)
' ################################################################################################################################################################
' Multimouse
' ################################################################################################################################################################
' Working proof of concept! (Windows only so far)
' Plug in 2 or more USB mice and try moving them around
' -------------------------------------------------------------------------------
' TO DO
' -------------------------------------------------------------------------------
' DONE:
' * detect mouse button clicks (left, middle, right buttons)
' Some issues and things to fix:
' * 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.
Option Explicit
_Title "multimouse"
$NoPrefix
$Console:Only
Console Off
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CONSTANTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Const FALSE = 0
Const TRUE = Not FALSE
Const CS_HREDRAW = &H0002
Const CS_VREDRAW = &H0001
Const IDI_APPLICATION = 32512
Const IDC_ARROW = 32512
Const COLOR_WINDOW = 5
Const WS_OVERLAPPED = &H00000000
Const WS_CAPTION = &H00C00000
Const WS_SYSMENU = &H00080000
Const WS_THICKFRAME = &H00040000
Const WS_MINIMIZEBOX = &H00020000
Const WS_MAXIMIZEBOX = &H00010000
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Const CW_USEDEFAULT = &H80000000
Const WM_DESTROY = &H0002
Const WM_INPUT = &H00FF
Const SW_SHOW = 5
Const RID_INPUT = &H10000003
Const RIM_TYPEMOUSE = 0
Const MOUSE_MOVE_RELATIVE = &H00
Const MOUSE_MOVE_ABSOLUTE = &H01
Const MOUSE_VIRTUAL_DESKTOP = &H02
Const MOUSE_ATTRIBUTES_CHANGED = &H04
Const MOUSE_MOVE_NOCOALESCE = &H08
Const WM_MOUSEMOVE = &H0200
Const WM_PAINT = &H000F
Const DT_CENTER = &H00000001
' MIN/MAX VALUES FOR MOUSE TEST
Const cMinX = 2
Const cMaxX = 79
Const cMinY = 16
Const cMaxY = 24
Const cMinWheel = 0
Const cMaxWheel = 255
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END CONSTANTS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN UDTs
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Type RAWINPUTDEVICE
As Unsigned Integer usUsagePage, usUsage
As Unsigned Long dwFlags
As Offset hwndTarget
End Type
Type RAWINPUTDEVICELIST
As Offset hDevice
As Unsigned Long dwType
$If 64BIT Then
As String * 4 alignment
$End If
End Type
Type POINT
As Long x, y
End Type
Type MSG
As Offset hwnd
As Unsigned Long message
As Unsigned Offset wParam
As Offset lParam
As Long time
As POINT pt
As Long lPrivate
End Type
Type WNDCLASSEX
As Unsigned Long cbSize, style
As Offset lpfnWndProc
As Long cbClsExtra, cbWndExtra
As Offset hInstance, hIcon, hCursor, hbrBackground, lpszMenuName, lpszClassName, hIconSm
End Type
Type RECT
As Long left, top, right, bottom
End Type
Type PAINTSTRUCT
As Offset hdc
As Long fErase
$If 64BIT Then
As String * 4 alignment
$End If
As RECT rcPaint
As Long fRestore, fIncUpdate
As String * 32 rgbReserved
End Type
Type RAWINPUTHEADER
As Unsigned Long dwType, dwSize
As Offset hDevice
As Unsigned Offset wParam
End Type
Type RAWMOUSE
As Unsigned Integer usFlags
$If 64BIT Then
As String * 2 alignment
$End If
'As Unsigned Long ulButtons 'commented out because I'm creating this value using MAKELONG
As Unsigned Integer usButtonFlags, usButtonData
As Unsigned Long ulRawButtons
As Long lLastX, lLastY
As Unsigned Long ulExtraInformation
End Type
Type RAWINPUT
As RAWINPUTHEADER header
As RAWMOUSE mouse
End Type
' UDT TO HOLD THE INFO FOR EACH MOUSE
Type MouseInfoType
ID As String ' mouse device ID
c As String ' text cursor character
x As Integer ' text x position
y As Integer ' text y position
xPos As Long ' hires x position
yPos As Long ' hires y position
dx As Long ' dx
dy As Long ' dy
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
'OldLeftDown As Integer ' tracks left mouse button state, TRUE=down
'OldMiddleDown As Integer ' tracks middle mouse button state, TRUE=down
'OldRightDown 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
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END UDTs
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN API DECLARATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Declare CustomType Library
Function GetRawInputDeviceList~& (ByVal pRawInputDeviceList As Offset, Byval puiNumDevices As Offset, Byval cbSize As Unsigned Long)
Sub GetRawInputDeviceList (ByVal pRawInputDeviceList As Offset, Byval puiNumDevices As Offset, Byval cbSize As Unsigned Long)
Function RegisterRawInputDevices& (ByVal pRawInputDevices As Offset, Byval uiNumDevices As Unsigned Long, Byval cbSize As Unsigned Long)
Function GetModuleHandle%& (ByVal lpModulename As Offset)
Function LoadIcon%& (ByVal hInstance As Offset, Byval lpIconName As Offset)
Function LoadCursor%& (ByVal hInstance As Offset, Byval lpCursorName As Offset)
Function RegisterClassEx~% (ByVal wndclassex As Offset)
Function CreateWindowEx%& (ByVal dwExStyle As Unsigned Long, Byval lpClassName As Offset, Byval lpWindowName As Offset, Byval dwStyle As Unsigned Long, Byval x As Long, Byval y As Long, Byval nWidth As Long, Byval nHeight As Long, Byval hWndParent As Offset, Byval hMenu As Offset, Byval hInstance As Offset, Byval lpParam As Offset)
Sub ShowWindow (ByVal hWnd As Offset, Byval nCmdShow As Long)
Sub UpdateWindow (ByVal hWnd As Offset)
Function GetMessage& (ByVal lpMsg As Offset, Byval hWnd As Offset, Byval wMsgFilterMin As Unsigned Long, Byval wMsgFilterMax As Unsigned Long)
Sub TranslateMessage (ByVal lpMsg As Offset)
Sub DispatchMessage (ByVal lpMsg As Offset)
Sub PostQuitMessage (ByVal nExitCode As Long)
Function DefWindowProc%& (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
Sub GetRawInputData (ByVal hRawInput As Offset, Byval uiCommand As Unsigned Long, Byval pData As Offset, Byval pcbSize As Offset, Byval cbSizeHeader As Unsigned Long)
Function GetRawInputData~& (ByVal hRawInput As Offset, Byval uiCommand As Unsigned Long, Byval pData As Offset, Byval pcbSize As Offset, Byval cbSizeHeader As Unsigned Long)
Sub InvalidateRect (ByVal hWnd As Offset, Byval lpRect As Offset, Byval bErase As Long)
Sub SendMessage (ByVal hWnd As Offset, Byval Msg As Unsigned Long, Byval wParam As Unsigned Offset, Byval lParam As Offset)
Function BeginPaint%& (ByVal hWnd As Offset, Byval lpPaint As Offset)
Sub GetClientRect (ByVal hWnd As Offset, Byval lpRect As Offset)
Sub DrawText (ByVal hdc As Offset, Byval lpchText As Offset, Byval cchText As Long, Byval lprc As Offset, Byval format As Unsigned Long)
Sub OffsetRect (ByVal lprc As Offset, Byval dx As Long, Byval dy As Long)
Sub EndPaint (ByVal hWnd As Offset, Byval lpPaint As Offset)
End Declare
' Header file "makeint.h" must be in same folder as this program.
Declare CustomType Library ".\makeint"
Function MAKEINTRESOURCE%& Alias "MAKEINTRSC" (ByVal i As _Offset)
End Declare
Declare Library
Function MAKELPARAM%& (ByVal l As Integer, Byval h As Integer)
Function MAKELONG~& (ByVal l As Unsigned Integer, Byval h As Unsigned Integer)
End Declare
$If 64BIT Then
Declare Library ".\internal\c\c_compiler\x86_64-w64-mingw32\include\windowsx"
$Else
Declare Library ".\internal\c\c_compiler\i686-w64-mingw32\include\windowsx"
$End If
Function GET_Y_LPARAM& (ByVal lp As Offset)
Function GET_X_LPARAM& (ByVal lp As Offset)
End Declare
' Header file "winproc.h" must be in same folder as this program.
Declare Library ".\winproc"
Function WindowProc%& ()
End Declare
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END API DECLARATIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GLOBAL VARIABLES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bDebug As Integer: m_bDebug = FALSE
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
' HOLDS STATUS MESSAGES SAVED INSIDE EVENTS
Dim Shared m_EventMessage As String
' RAW INPUT VARIABLES
Dim Shared m_MouseMessage As String
Dim Shared m_RawInputMessage As String
' MOUSE TEST VARIABLES
Dim Shared m_arrMouseInfo(8) As MouseInfoType ' STORES INFO FOR EACH MOUSE
Dim Shared m_iMouseCount As Integer ' # OF MICE ATTACHED
Dim Shared m_iMinX As Long
Dim Shared m_iMaxX As Long
Dim Shared m_iMinY As Long
Dim Shared m_iMaxY As Long
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GLOBAL VARIABLES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ****************************************************************************************************************************************************************
' BEGIN ACTIVATE DEBUGGING WINDOW
' ****************************************************************************************************************************************************************
'If m_bDebug = TRUE Then
' $Console
' _Delay 4
' _Console On
' _Echo "Started " + m_ProgramName$
' _Echo "Debugging on..."
'End If
' ****************************************************************************************************************************************************************
' END ACTIVATE DEBUGGING WINDOW
' ****************************************************************************************************************************************************************
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' EXECUTION STARTS HERE!
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
main
' ****************************************************************************************************************************************************************
' BEGIN DEACTIVATE DEBUGGING WINDOW
' ****************************************************************************************************************************************************************
'If m_bDebug = TRUE Then
' _Console Off
'End If
' ****************************************************************************************************************************************************************
' END DEACTIVATE DEBUGGING WINDOW
' ****************************************************************************************************************************************************************
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CLEANUP + FINISH
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
System ' return control to the operating system
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END CLEANUP + FINISH
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DATA
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' MOUSE CURSORS (JUST SOME LETTERS)
CData:
Data A,b,C,D,E,f,G,H
' DEFAULT/INTIAL X COORDINATE OF EACH CURSOR ON SCREEN
XData:
Data 5,15,25,35,45,55,65,75
' DEFAULT/INTIAL Y COORDINATE OF EACH CURSOR ON SCREEN
YData:
Data 17,17,19,19,21,21,23,23
' DEFAULT/INITIAL VALUE OF EACH SCROLL WHEEL
WData:
Data 224,192,160,128,96,64,32,0
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DATA
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN MAIN PROGRAM
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
Sub main
' INITIALIZE NON-EVENT VALUES
InitMouseVars
' SETUP WINDOW EVENTS AND RAWINPUT
System Val(Str$(WinMain))
' TEST READING MULTIPLE MICE
MouseRawInputTest
End Sub ' main
' /////////////////////////////////////////////////////////////////////////////
Sub InitMouseVars
Dim iIndex As Integer
Dim iLoop As Integer
' INITIALIZE
m_iMinX = 0
m_iMaxX = 3583
m_iMinY = 0
m_iMaxY = 8202
' INITIALIZE CURSORS, MOUSE STATE, ETC.
Restore CData
iIndex = LBound(m_arrMouseInfo) - 1
For iLoop = 1 To m_iMouseCount
iIndex = iIndex + 1
Read m_arrMouseInfo(iIndex).c
' INITIALIZED BELOW: m_arrMouseInfo(iIndex).x = 0
' INITIALIZED BELOW: m_arrMouseInfo(iIndex).y = 0
m_arrMouseInfo(iIndex).xPos = 0
m_arrMouseInfo(iIndex).yPos = 0
m_arrMouseInfo(iIndex).dx = 0
m_arrMouseInfo(iIndex).dy = 0
' INITIALIZED BELOW: m_arrMouseInfo(iIndex).wheel = 127
m_arrMouseInfo(iIndex).LeftDown = FALSE
m_arrMouseInfo(iIndex).MiddleDown = FALSE
m_arrMouseInfo(iIndex).RightDown = FALSE
'm_arrMouseInfo(iIndex).OldLeftDown = FALSE
'm_arrMouseInfo(iIndex).OldMiddleDown = FALSE
'm_arrMouseInfo(iIndex).OldRightDown = FALSE
m_arrMouseInfo(iIndex).LeftCount = 0
m_arrMouseInfo(iIndex).MiddleCount = 0
m_arrMouseInfo(iIndex).RightCount = 0
Next iLoop
' INITIALIZE X COORDINATES
Restore XData
iIndex = LBound(m_arrMouseInfo) - 1
For iLoop = 1 To m_iMouseCount
iIndex = iIndex + 1
Read m_arrMouseInfo(iIndex).x
Next iLoop
' INITIALIZE Y COORDINATES
Restore YData
iIndex = LBound(m_arrMouseInfo) - 1
For iLoop = 1 To m_iMouseCount
iIndex = iIndex + 1
Read m_arrMouseInfo(iIndex).y
Next iLoop
' INITIALIZE SCROLL WHEEL
Restore WData
iIndex = LBound(m_arrMouseInfo) - 1
For iLoop = 1 To m_iMouseCount
iIndex = iIndex + 1
Read m_arrMouseInfo(iIndex).wheel
Next iLoop
End Sub ' InitMouseVars
' /////////////////////////////////////////////////////////////////////////////
' 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 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
Dim iRowOffset As Integer
' 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
iRowOffset = 0
For iIndex = LBound(m_arrMouseInfo) To UBound(m_arrMouseInfo)
' ERASE CURSORS AT CURRENT POSITION
Locate m_arrMouseInfo(iIndex).y, m_arrMouseInfo(iIndex).x: Print " ";
' HANDLE LEFT MOUSE BUTTON
If m_arrMouseInfo(iIndex).LeftDown = TRUE Then
' (DO SOMETHING)
End If
' HANDLE MIDDLE MOUSE BUTTON (SCROLL WHEEL BUTTON)
If m_arrMouseInfo(iIndex).MiddleDown = TRUE Then
' (DO SOMETHING)
End If
' HANDLE RIGHT MOUSE BUTTON
If m_arrMouseInfo(iIndex).RightDown = TRUE Then
' (DO SOMETHING)
End If
' ****************************************************************************************************************************************************************
' HANDLE MOUSE MOVEMENT
'' UPDATE ABSOLUTE POSITION
'm_arrMouseInfo(iIndex).xPos = GET_X_LPARAM(lParam)
'm_arrMouseInfo(iIndex).yPos = GET_Y_LPARAM(lParam)
'iNewX = ( (GET_X_LPARAM(lParam) + 1) * 80) \ (iMaxX+1)
'iNewY = ( (GET_Y_LPARAM(lParam) + 1) * 25) \ (iMaxY+1)
' UPDATE DELTA
'm_arrMouseInfo(iIndex).dx = raw.mouse.lLastX
'm_arrMouseInfo(iIndex).dy = raw.mouse.lLastY
If m_arrMouseInfo(iIndex).dx < 0 Then
m_arrMouseInfo(iIndex).x = m_arrMouseInfo(iIndex).x - 1
ElseIf m_arrMouseInfo(iIndex).dx > 0 Then
m_arrMouseInfo(iIndex).x = m_arrMouseInfo(iIndex).x + 1
End If
If m_arrMouseInfo(iIndex).dy < 0 Then
m_arrMouseInfo(iIndex).y = m_arrMouseInfo(iIndex).y - 1
ElseIf m_arrMouseInfo(iIndex).dy > 0 Then
m_arrMouseInfo(iIndex).y = m_arrMouseInfo(iIndex).y + 1
End If
' ****************************************************************************************************************************************************************
' CHECK BOUNDARIES
If m_arrMouseInfo(iIndex).x < cMinX Then m_arrMouseInfo(iIndex).x = cMinX
If m_arrMouseInfo(iIndex).x > cMaxX Then m_arrMouseInfo(iIndex).x = cMaxX
If m_arrMouseInfo(iIndex).y < cMinY Then m_arrMouseInfo(iIndex).y = cMinY
If m_arrMouseInfo(iIndex).y > cMaxY Then m_arrMouseInfo(iIndex).y = cMaxY
' PLOT CURSOR
Locate m_arrMouseInfo(iIndex).y, m_arrMouseInfo(iIndex).x: Print m_arrMouseInfo(iIndex).c;
' DISPLAY VARIABLES
iLen = 3: sCount = Left$(LTrim$(RTrim$(Str$(iLoop))) + String$(iLen, " "), iLen)
iLen = 3: sX = Left$(LTrim$(RTrim$(Str$(m_arrMouseInfo(iIndex).x))) + String$(iLen, " "), iLen)
iLen = 3: sY = Left$(LTrim$(RTrim$(Str$(m_arrMouseInfo(iIndex).y))) + String$(iLen, " "), iLen)
iLen = 6: sWheel = Left$(LTrim$(RTrim$(Str$(m_arrMouseInfo(iIndex).wheel))) + String$(iLen, " "), iLen)
iLen = 9: sLeftDown = Left$(LTrim$(RTrim$(Str$(m_arrMouseInfo(iIndex).LeftDown))) + String$(iLen, " "), iLen)
iLen = 11: sMiddleDown = Left$(LTrim$(RTrim$(Str$(m_arrMouseInfo(iIndex).MiddleDown))) + String$(iLen, " "), iLen)
iLen = 10: sRightDown = Left$(LTrim$(RTrim$(Str$(m_arrMouseInfo(iIndex).RightDown))) + String$(iLen, " "), iLen)
iLen = 10: sLeftCount = Left$(LTrim$(RTrim$(Str$(m_arrMouseInfo(iIndex).LeftCount))) + String$(iLen, " "), iLen)
iLen = 12: sMiddleCount = Left$(LTrim$(RTrim$(Str$(m_arrMouseInfo(iIndex).MiddleCount))) + String$(iLen, " "), iLen)
iLen = 11: sRightCount = Left$(LTrim$(RTrim$(Str$(m_arrMouseInfo(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 iIndex
_Limit 100 ' keep loop at 100 frames per second
Loop Until _KeyDown(27) ' escape key exit
_KeyClear: '_DELAY 1
End Sub ' MouseRawInputTest
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END MAIN PROGRAM
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN RAW INPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Runs first, initializes the RawMouse stuff and events.
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)
wndclass.lpszClassName = Offset(szMainWndClass)
wndclass.cbSize = Len(wndclass)
wndclass.style = CS_HREDRAW Or CS_VREDRAW
wndclass.lpfnWndProc = WindowProc
wndclass.hInstance = hInst 'GetModuleHandle(0) will return the hInstance of this EXE
wndclass.hIcon = LoadIcon(0, MAKEINTRESOURCE(IDI_APPLICATION))
wndclass.hIconSm = LoadIcon(0, MAKEINTRESOURCE(IDI_APPLICATION))
wndclass.hCursor = LoadCursor(0, MAKEINTRESOURCE(IDC_ARROW))
wndclass.hbrBackground = COLOR_WINDOW + 1
reg = RegisterClassEx(Offset(wndclass)) 'I prefer to use the output of RegisterClassEx rather than the window name
'DEBUG: SUBSTITUTE _WindowHandle
hwndMain = CreateWindowEx(0, MAKELPARAM(reg, 0), Offset(szWinTitle), WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, hInst, 0)
'hwndMain = _WindowHandle
'DEBUG: SUBSTITUTE _WindowHandle
ShowWindow hwndMain, SW_SHOW
'ShowWindow _WindowHandle, SW_SHOW
'DEBUG: SUBSTITUTE _WindowHandle
UpdateWindow hwndMain
'UpdateWindow _WindowHandle
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 iLen As Integer
Dim sCount As String
Dim sX As String
Dim sY As String
Dim sWheel As String
Dim sLeftDown As String
Dim sMiddleDown As String
Dim sRightDown As String
Dim sLeftCount As String
Dim sMiddleCount As String
Dim sRightCount As String
Dim sNext As String
Dim iNewX As Integer
Dim iNewY As Integer
Dim iDX As Integer
Dim iDY As Integer
' HANDLE EVENTS
Select Case nMsg
Case WM_DESTROY
PostQuitMessage 0
MainWndProc = 0
Exit Function
Case WM_INPUT
GetRawInputData lParam, RID_INPUT, 0, Offset(dwSize), Len(rih)
lpb = MemNew(dwSize)
If lpb.SIZE = 0 Then
MainWndProc = 0
Exit Function
End If
If GetRawInputData(lParam, RID_INPUT, lpb.OFFSET, Offset(dwSize), Len(rih)) <> dwSize Then
m_EventMessage = "GetRawInputData doesn't return correct size!"
End If
MemGet lpb, lpb.OFFSET, raw
If raw.header.dwType = RIM_TYPEMOUSE Then
' GET MOUSE INFO
tmpx = raw.mouse.lLastX
tmpy = raw.mouse.lLastY
maxx = tmpx
' UPDATE RANGE OF MOUSE COORDINATES
If GET_X_LPARAM(lParam) < m_iMinX Then m_iMinX = GET_X_LPARAM(lParam)
If GET_X_LPARAM(lParam) > m_iMaxX Then m_iMaxX = GET_X_LPARAM(lParam)
If GET_Y_LPARAM(lParam) < m_iMinY Then m_iMinY = GET_Y_LPARAM(lParam)
If GET_Y_LPARAM(lParam) > m_iMaxY Then m_iMaxY = GET_Y_LPARAM(lParam)
' IDENTIFY WHICH MOUSE IT IS
strNextID = _Trim$(Str$(raw.header.hDevice))
iIndex = GetMouseIndex%(strNextID)
If iIndex >= LBound(m_arrMouseInfo) Then
If iIndex <= UBound(m_arrMouseInfo) Then
' =============================================================================
' SAVE MOUSE POINTER POSITION
' UPDATE ABSOLUTE POSITION
m_arrMouseInfo(iIndex).xPos = GET_X_LPARAM(lParam)
m_arrMouseInfo(iIndex).yPos = GET_Y_LPARAM(lParam)
' UPDATE DELTA
m_arrMouseInfo(iIndex).dx = raw.mouse.lLastX
m_arrMouseInfo(iIndex).dy = raw.mouse.lLastY
' =============================================================================
' SAVE SCROLL WHEEL
' (TBD)
' usButtonData changes value when scroll wheel moved (just stays at one value):
' "usButtonData=" + Hex$(raw.mouse.usButtonData)
' SAVE SCROLL WHEEL POSITION TO:
' m_arrMouseInfo(iIndex).wheel
' =============================================================================
' DETECT BUTTON PRESS / RELEASE
' left button = 1 when down, 2 when released
If ((raw.mouse.usButtonFlags And 1) = 1) Then
m_arrMouseInfo(iIndex).LeftDown = TRUE
m_arrMouseInfo(iIndex).LeftCount = m_arrMouseInfo(iIndex).LeftCount + 1
ElseIf ((raw.mouse.usButtonFlags And 2) = 2) Then
m_arrMouseInfo(iIndex).LeftDown = FALSE
End If
' middle button = 16 when down, 32 when released
If ((raw.mouse.usButtonFlags And 16) = 16) Then
m_arrMouseInfo(iIndex).MiddleDown = TRUE
m_arrMouseInfo(iIndex).MiddleCount = m_arrMouseInfo(iIndex).MiddleCount + 1
ElseIf ((raw.mouse.usButtonFlags And 32) = 32) Then
m_arrMouseInfo(iIndex).MiddleDown = FALSE
End If
' right button = 4 when down, 8 when released
If ((raw.mouse.usButtonFlags And 4) = 4) Then
m_arrMouseInfo(iIndex).RightDown = TRUE
m_arrMouseInfo(iIndex).RightCount = m_arrMouseInfo(iIndex).RightCount + 1
ElseIf ((raw.mouse.usButtonFlags And 8) = 8) Then
m_arrMouseInfo(iIndex).RightDown = FALSE
End If
End If
End If
InvalidateRect hwnd, 0, -1
SendMessage hwnd, WM_PAINT, 0, 0
MainWndProc = 0
End If
MemFree lpb
MainWndProc = 0
Exit Function
Case WM_MOUSEMOVE
' SAVE RANGE OF MOUSE COORDINATES
If GET_X_LPARAM(lParam) < m_iMinX Then m_iMinX = GET_X_LPARAM(lParam)
If GET_X_LPARAM(lParam) > m_iMaxX Then m_iMaxX = GET_X_LPARAM(lParam)
If GET_Y_LPARAM(lParam) < m_iMinY Then m_iMinY = GET_Y_LPARAM(lParam)
If GET_Y_LPARAM(lParam) > m_iMaxY Then m_iMaxY = GET_Y_LPARAM(lParam)
' IDENTIFY WHICH MOUSE IT IS
strNextID = _Trim$(Str$(raw.header.hDevice))
iIndex = GetMouseIndex%(strNextID)
If iIndex >= LBound(m_arrMouseInfo) Then
If iIndex <= UBound(m_arrMouseInfo) Then
' (DO NOTHING)
End If
End If
InvalidateRect hwnd, 0, -1
SendMessage hwnd, WM_PAINT, 0, 0
MainWndProc = 0
Exit Function
Case WM_PAINT
hdc = BeginPaint(hwnd, Offset(ps))
GetClientRect hwnd, Offset(rc)
DrawText hdc, Offset(m_MouseMessage), Len(m_MouseMessage), Offset(rc), DT_CENTER
OffsetRect Offset(rc), 0, 200
' PRINT LIST OF RawInput DEVICES
'DrawText hdc, Offset(m_RawInputMessage), Len(m_RawInputMessage), Offset(rc), DT_CENTER
EndPaint hwnd, Offset(ps)
MainWndProc = 0
Exit Function
Case Else
MainWndProc = DefWindowProc(hwnd, nMsg, wParam, lParam)
End Select
End Function ' MainWndProc
' /////////////////////////////////////////////////////////////////////////////
' Initializes raw input stuff
Sub InitRawInput ()
Dim As RAWINPUTDEVICE Rid(0 To 49)
Dim As Unsigned Long nDevices
Dim As RAWINPUTDEVICELIST RawInputDeviceList
Dim As MEM pRawInputDeviceList
ReDim As RAWINPUTDEVICELIST rawdevs(-1)
Dim As Unsigned Long x
Dim strNextID As String
'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 INFO
m_iMouseCount = 0
m_RawInputMessage = "Number of raw input devices:" + Str$(nDevices) + Chr$(13)
For x = 0 To UBound(rawdevs)
m_RawInputMessage = m_RawInputMessage + Str$(rawdevs(x).hDevice) + ":" + Str$(rawdevs(x).dwType) + Chr$(13)
' Is it a mouse?
'TODO: SAVE_MOUSE_INFO
If rawdevs(x).dwType = 0 Then
m_iMouseCount = m_iMouseCount + 1
strNextID = _Trim$(Str$(rawdevs(x).hDevice))
'lngNextID = Val(strNextID)
'm_arrMouseInfo(m_iMouseCount-1).ID = lngNextID
m_arrMouseInfo(m_iMouseCount - 1).ID = strNextID
End If
Next x
m_RawInputMessage = m_RawInputMessage + 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
m_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 (m_iMouseCount > 8) Then m_iMouseCount = 8
' INITIALIZE CURSORS, MOUSE STATE, ETC.
Restore CData
iIndex = LBound(m_arrMouseInfo) - 1
For iLoop = 1 To m_iMouseCount
iIndex = iIndex + 1
Read m_arrMouseInfo(iIndex).c
' INITIALIZED BELOW: m_arrMouseInfo(iIndex).x = 0
' INITIALIZED BELOW: m_arrMouseInfo(iIndex).y = 0
' INITIALIZED BELOW: m_arrMouseInfo(iIndex).wheel = 127
m_arrMouseInfo(iIndex).LeftDown = FALSE
m_arrMouseInfo(iIndex).MiddleDown = FALSE
m_arrMouseInfo(iIndex).RightDown = FALSE
m_arrMouseInfo(iIndex).LeftCount = 0
m_arrMouseInfo(iIndex).MiddleCount = 0
m_arrMouseInfo(iIndex).RightCount = 0
Next iLoop
' INITIALIZE X COORDINATES
Restore XData
iIndex = LBound(m_arrMouseInfo) - 1
For iLoop = 1 To m_iMouseCount
iIndex = iIndex + 1
Read m_arrMouseInfo(iIndex).x
Next iLoop
' INITIALIZE Y COORDINATES
Restore YData
iIndex = LBound(m_arrMouseInfo) - 1
For iLoop = 1 To m_iMouseCount
iIndex = iIndex + 1
Read m_arrMouseInfo(iIndex).y
Next iLoop
' INITIALIZE SCROLL WHEEL
Restore WData
iIndex = LBound(m_arrMouseInfo) - 1
For iLoop = 1 To m_iMouseCount
iIndex = iIndex + 1
Read m_arrMouseInfo(iIndex).wheel
Next iLoop
End Sub ' InitMouseTest
' /////////////////////////////////////////////////////////////////////////////
' Finds position in array m_arrMouseInfo where .ID = MouseID
Function GetMouseIndex% (MouseID As String)
Dim iLoop As Integer
Dim iIndex%
iIndex% = LBound(m_arrMouseInfo) - 1
For iLoop = LBound(m_arrMouseInfo) To UBound(m_arrMouseInfo)
If m_arrMouseInfo(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
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' 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
Locate y%, x%
Print c$;
Else
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
Locate x2%, y2%
Print c$;
End Sub ' DrawTextLine
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END TEST OUTPUT FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' FOR BITWISE OPERATIONS
Function HasBit% (iByte As Integer, iBit As Integer)
Dim iBitValue As Integer
iBitValue = 2 ^ (iBit - 1)
HasBit% = ((iByte And iBitValue) = iBitValue)
End Function ' HasBit%
' /////////////////////////////////////////////////////////////////////////////
' 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 #DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'' /////////////////////////////////////////////////////////////////////////////
'
'Sub DebugPrint (MyString As String)
' If m_bDebug = TRUE Then
' '_Echo MyString
' 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
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DEBUGGING ROUTINES @DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' #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