seperate input from multiple mice v0.54 graphic demo

seperate input from multiple mice v0.54 graphic demo - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: seperate input from multiple mice v0.54 graphic demo (/showthread.php?tid=2814)

seperate input from multiple mice v0.54 graphic demo - madscijr - 06-20-2024

I updated the graphic demo with the keyboard and absolute position code, and it's coming along.

Windows only so far, resolution 1024x768 or greater.

Give it a try!

Plug 2-8 USB mice into your PC.
Place "makeint.h" and "winproc.h" in same folder as programs.
Compile the mouse reader program "ReadMiceSub" first (or run it once, it will run briefly then exit).
Run the front end program "ReadMiceMain".
The main program will automatically start the subprogram "ReadMiceSub" which should have the focus.
If your PC prompts for permission say Yes.
Be patient, the program takes a few seconds to start everything up and get "situated"!
Click the mouse to make sure "ReadMiceSub" has the focus (it's invisible but sitting on top of "ReadMiceMain").
Try moving each mouse.
Each mouse should control a different colored numbered block.
Try clicking the left / middle / right mouse buttons.
You should see the button states on the screen for each mouse.
Try pressing some keys on the keyboard.
The last keys pressed + released are displayed at the top.
Press Esc to quit, or delete the file "ReadMiceSub.DELETE-TO-CLOSE".
The main program creates this file at startup, and both the main and sub programs periodically check that it is present.
If it is missing, both programs shut down.

Some issues and things to fix:

The subprogram "ReadMiceSub" sends its data back to "ReadMiceMain" via TCPIP in the form of a tab-delimited string. Tab is chr$(9). Sometimes it sends multiple messages, which are separated by chr$(13). Currently "ReadMiceMain" just processes the first line. Need to split the input by chr$(13) and process each line seperately, which should make concurrent input smoother.
Hide the real mouse cursor and reactivate it when program closes.
Detect moving the scroll wheel.
Get it working with _FullScreen _SquarePixels. When I tried that mode things got really weird.
Read input from multiple keyboards - need to figure out how to do the unions in the RAWINPUT structure type in "ReadMicesub". (Just need someone to figure this out, I have tried.)
Figure out how to get the same functionality for Mac & Linux.

For anyone who doesn't want to download a zip file, here's the code for the 4 files you'll need:

"makeint.h":

Code: (Select All)
LPSTR MAKEINTRSC(ptrszint i){

    return MAKEINTRESOURCE(i);

}

"winproc.h":

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

LRESULT CALLBACK MainWndProc(HWND hwnd, UINT nMsg, WPARAM wParam, LPARAM lParam){

    return FUNC_MAINWNDPROC((ptrszint *) (&hwnd), &nMsg, &wParam, (ptrszint *)(&lParam));

}

void * WindowProc(){

    return (void *) MainWndProc;

}

"readmicemain54.bas":

Code: (Select All)
' ################################################################################################################################################################

' Multimouse main program "ReadMiceMain.bas" v0.54

' ################################################################################################################################################################

' -------------------------------------------------------------------------------

' ABOUT

' -------------------------------------------------------------------------------

' Working proof of concept! (Windows only so far)

'

' HOW TO USE:

'

' 1. Plug 2-8 USB mice into your PC.

'

' 2. Place "makeint.h" and "winproc.h" in same folder as programs.

'

' 3. Compile the mouse reader program "ReadMiceSub" first

'    (or run it once and exit).

'

' 4. Run the front end program "ReadMiceMain".

'    The main program will automatically start the subprogram "ReadMiceSub"

'    which should have the focus. If your PC prompts for permission say Yes.

'

' 5. Click the mouse to make sure "ReadMiceSub" has the focus

'    (it's invisible but sitting on top of "ReadMiceMain").

'

' 6. Try moving each mouse. Each one should move a different colored numberd block.

'

' 7. Try clicking the left / middle / right mouse buttons.

'    You should see the button states on the screen for each mouse.

'

' 8. Try pressing some keys on the keyboard

'    The last key pressed + released is displayed at the top.

'

' 9. Press Esc to quit, or delete the file "ReadMiceSub.DELETE-TO-CLOSE".

'    The main program creates this at startup, and both the main and sub

'    programs check for this file. If it is missing, both programs shut down.

'

' DEBUGGING CODE:

' There is currently a ton of commented out debugging code - sorry about the

' mess! There were some horribly elusive problems to figure out.

' To enable debugging output: change Const cDebugEnabled to TRUE

' and search for "debug" and uncomment those lines.

' DebugPrint outputs to the console, DebugLog outputs to a file.

' Enabling console in "ReadMiceSub" caused all sorts of problems,

' so to debug that, just use DebugLog.

' -------------------------------------------------------------------------------

' TO DO

' -------------------------------------------------------------------------------

' Some issues and things to fix:

' * The subprogram "ReadMiceSub" sends its data back to "ReadMiceMain"

'   via TCPIP in the form of a tab-delimited string. Tab is chr$(9).

'   Sometimes it sends multiple messages, which are separated by chr$(13).

'   Currently "ReadMiceMain" just processes the first line. Need to split the

'   input by chr$(13) and process each line seperately, which should make

'   concurrent input smoother.

' * Read input from multiple keyboards - need to figure out how to do the

'   unions in the RAWINPUT structure type in "ReadMicesub".

' * Hide the real mouse cursor and reactivate it when program closes.

' * Detect moving the scroll wheel.

' * Get it working with _FullScreen _SquarePixels.

' * Figure out how to get the same functionality for Mac & Linux.

' -------------------------------------------------------------------------------

' THANK YOU

' -------------------------------------------------------------------------------

' Much credit and thanks are due to:

' * jstookey who started the work that made this possible

' * SpriggsySpriggs who ported the hard stuff (APIs, events) to QB64 & QB64PE

' * SMcNeill who helped with so many things, most recently keeping the main window on top, getting file attributes

' * Steffan-68 for feedback, code for managing windows and ideas

' * DSMan195276 for the network code that lets the reader and main program talk smoothly

' * euklides, Ed Davis, mdijkens for file attributes code

' * grymmjack for words of encouragement

' * the QB64 and QB64PE communities for help with everything

' * (if I forgot anyone let me know!)

' -------------------------------------------------------------------------------

' 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.

'                        Code at: https://jstookey.com/multiple-mice-raw-input/

' 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.

' 2024-05-23  madscijr   Now we get mice coordinates from subprogram via TCPIP.

'                        A lot faster than using files!

'                        Thanks to DSMan195276 for the networking code.

' 2024-06-19  madscijr   Now we get absolute mouse coordinates not just dx, dy

'                        and can read the keyboard (just a single keyboard).

'                        Updated the graphics / display code to use layers.

' -------------------------------------------------------------------------------

' RESOURCES:

'

' Multiple Mice in Windows using Raw Input by jstookey

' * https://jstookey.com/multiple-mice-raw-input/

'

' One of the original QB64 threads

' * https://qb64phoenix.com/forum/showthread.php?tid=864

'

' Using Raw Input from C# to handle multiple keyboards by Emma Burrows, Steve Messer

' * https://www.codeproject.com/Articles/17123/Using-Raw-Input-from-C-to-handle-multiple-keyboard

'

' Microsoft's Raw Input API docs at pages around:

' * https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputheader

' * https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevicelist

'

' Looking at RAWINPUT for more detail (HACKADAY.IO)

' * https://hackaday.io/project/5364-cheap-windows-jogkeyboard-controller-for-cncs/log/16843-looking-at-rawinput-for-more-detail

'

' TimothyTimbers Raw Input Class for indie Game Developers:

' * https://www.unknowncheats.me/forum/c-and-c-/64318-raw-input-class-indie-game-developers.html

'

' WINDOWS PROGRAMMING: ACCESSING RAW INPUT by DAVID OREJUELA

' * https://davidorejuela.blogspot.com/2013/12/windows-programming-accessing-raw-input.html

'

' Explorations in Game Development: Why Raw Input?

' * https://explore-gamedev.blogspot.com/2013/09/why-raw-input.html

' Forum threads:

' * https://stackoverflow.com/questions/44935905/why-i-can-not-retrieve-rawinput-data-from-mouse

' * https://stackoverflow.com/questions/6423729/get-current-cursor-position

' * https://www.gamedev.net/forums/topic/700010-winapi-raw-input-confusion/

' * https://cplusplus.com/forum/windows/95700/

' * https://www.codeproject.com/Questions/118950/Raw-input-in-QT-library

' * https://docs.unity3d.com/ScriptReference/Windows.Input.ForwardRawInput.html

' * https://forum.freecad.org/viewtopic.php?style=2&t=28306&start=40

' * https://java-native-access.github.io/jna/5.4.0/javadoc/com/sun/jna/platform/win32/WinUser.RAWINPUTDEVICELIST.html

' * https://community.appeon.com/index.php/qna/q-a/how-can-i-catch-tab-key

' * https://forum.3dconnexion.com/viewtopic.php?t=2698

' * https://en.sfml-dev.org/forums/index.php?topic=15879.0

' * https://www.autoitscript.com/forum/topic/95105-hid-human-interface-device-communications-in-xp/page/2/

' * https://forum.unity.com/threads/new-input-system-get-raw-mouse-delta-from-wm_input.1177393/

' * https://forums.codeguru.com/showthread.php?541051-WM_Input-runtime-crash

' * https://discourse.libsdl.org/t/sdl-fixed-allocation-and-alignment-of-raw-input-buffers/48112

' * https://microsoft.public.dotnet.framework.interop.narkive.com/gWykTvfJ/reading-raw-data-from-a-hid-device

' * https://forum.qt.io/topic/66064/how-to-get-mouse-actual-position

' * https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/55985-raw-keyboard-hid-input-discussion

' * https://handmade.network/forums/t/7638-how_to_read_joystick_data_from_raw_input

' * https://microsoft.public.development.device.drivers.narkive.com/UWm0qmMb/getrawinputdata-usb-keyboard-with-power-keys

' * https://www.quakeworld.nu/forum/topic/3634/46374/getting-sensitivity-to-match-quake-

' * https://discourse.libsdl.org/t/sdl-fixed-windows-rawinput-crash/50150

' * https://squid.nt.tuwien.ac.at/gitlab/platzgummer/qgroundcontrol/commit/779f13f4e38c8d06fc2a74e594017d984e42c58e.diff

' * https://forums.codeguru.com/showthread.php?511656-How-to-get-interpreted-mouse-coords-from-raw-mouse-input

' * https://blog.naver.com/promaker72/50102194598

' * https://ubuntuforums.org/showthread.php?t=1543385

' Other pages with Raw Input info:

' * https://dev.to/igorsegallafa/avoiding-the-use-of-auto-clicker-keyboard-tools-5469

' * https://dev.opencascade.org/doc/refman/html/class_w_n_t___h_i_d_space_mouse.html

' * https://chromium.googlesource.com/experimental/chromium/src/+/refs/wip/bajones/webvr/device/gamepad/raw_input_data_fetcher_win.cc

' * https://bobobobo.wordpress.com/2010/04/21/rawinput/

' * https://sidestore.io/SideSource/interfaces/RawInput.html

Option Explicit

_Title "ReadMiceMain"

$NoPrefix

'$Console:Only

'Console Off

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN CONSTANTS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Const cProgName = "ReadMiceMain"

Const FALSE = 0

Const TRUE = Not FALSE

Const cDebugEnabled = FALSE

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' TEXT MODE COLORS:

Const c_Black = 0: Const c_Blue = 1: Const c_Green = 2: Const c_LtBlue = 3

Const c_Red = 4: Const c_Purple = 5: Const c_Orange = 6: Const c_White = 7

Const c_Gray = 8: Const c_Periwinkle = 9: Const c_LtGreen = 10: Const c_Cyan = 11

Const c_LtRed = 12: Const c_Pink = 13: Const c_Yellow = 14: Const c_LtGray = 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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' FOR CONTROLLING WINDOW FOCUS

Const SW_SHOW = 5

'' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'' 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 cForPlayer = 1

'Const cUpdateCount = 2

Const cMouseDX = 2

Const cMouseDY = 3

Const cMousePosX = 4

Const cMousePosY = 5

Const cMouseWheel = 6

Const cMouseLeftDown = 7

Const cMouseMiddleDown = 8

Const cMouseRightDown = 9

Const cMouseSpeedX = 0 ' smaller = faster

Const cMouseSpeedY = 2 ' smaller = faster

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' BEGIN Virtual-Key Codes

' https://learn.microsoft.com/en-us/windows/win32/inputdev/virtual-key-codes

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' NOTE: raw.data.Keyboard.vKey may require set extended bit

Const VK_LBUTTON = &H01 ' dec = 1, Left mouse button

Const VK_RBUTTON = &H02 ' dec = 2, Right mouse button

Const VK_CANCEL = &H03 ' dec = 3, Control-break processing

Const VK_MBUTTON = &H04 ' dec = 4, Middle mouse button

Const VK_XBUTTON1 = &H05 ' dec = 5, X1 mouse button

Const VK_XBUTTON2 = &H06 ' dec = 6, X2 mouse button

'??? = &H07 ' dec = 7, Reserved

Const VK_BACK = &H08 ' dec = 8, BACKSPACE key

Const VK_TAB = &H09 ' dec = 9, TAB key

'??? = &H0A-0B ' dec = 10-11, Reserved

Const VK_CLEAR = &H0C ' dec = 12, CLEAR key

Const VK_RETURN = &H0D ' dec = 13, ENTER key

'??? = &H0E-0F ' dec = 14-15, Unassigned

Const VK_SHIFT = &H10 ' dec = 16, SHIFT key

Const VK_CONTROL = &H11 ' dec = 17, CTRL key

Const VK_MENU = &H12 ' dec = 18, ALT key

Const VK_PAUSE = &H13 ' dec = 19, PAUSE key

Const VK_CAPITAL = &H14 ' dec = 20, CAPS LOCK key

Const VK_KANA = &H15 ' dec = 21, IME Kana mode

Const VK_HANGUL = &H15 ' dec = 21, IME Hangul mode

Const VK_IME_ON = &H16 ' dec = 22, IME On

Const VK_JUNJA = &H17 ' dec = 23, IME Junja mode

Const VK_FINAL = &H18 ' dec = 24, IME final mode

Const VK_HANJA = &H19 ' dec = 25, IME Hanja mode

Const VK_KANJI = &H19 ' dec = 25, IME Kanji mode

Const VK_IME_OFF = &H1A ' dec = 26, IME Off

Const VK_ESCAPE = &H1B ' dec = 27, ESC key

Const VK_CONVERT = &H1C ' dec = 28, IME convert

Const VK_NONCONVERT = &H1D ' dec = 29, IME nonconvert

Const VK_ACCEPT = &H1E ' dec = 30, IME accept

Const VK_MODECHANGE = &H1F ' dec = 31, IME mode change request

Const VK_SPACE = &H20 ' dec = 32, SPACEBAR

Const VK_PRIOR = &H21 ' dec = 33, PAGE UP key

Const VK_NEXT = &H22 ' dec = 34, PAGE DOWN key

Const VK_END = &H23 ' dec = 35, END key

Const VK_HOME = &H24 ' dec = 36, HOME key

Const VK_LEFT = &H25 ' dec = 37, LEFT ARROW key

Const VK_UP = &H26 ' dec = 38, UP ARROW key

Const VK_RIGHT = &H27 ' dec = 39, RIGHT ARROW key

Const VK_DOWN = &H28 ' dec = 40, DOWN ARROW key

Const VK_SELECT = &H29 ' dec = 41, SELECT key

Const VK_PRINT = &H2A ' dec = 42, PRINT key

Const VK_EXECUTE = &H2B ' dec = 43, EXECUTE key

Const VK_SNAPSHOT = &H2C ' dec = 44, PRINT SCREEN key

Const VK_INSERT = &H2D ' dec = 45, INS key

Const VK_DELETE = &H2E ' dec = 46, DEL key

Const VK_HELP = &H2F ' dec = 47, HELP key

' MADE OUR OWN CONSTANTS FOR THESE:

Const VK_0 = &H30 ' dec = 48, 0 key

Const VK_1 = &H31 ' dec = 49, 1 key

Const VK_2 = &H32 ' dec = 50, 2 key

Const VK_3 = &H33 ' dec = 51, 3 key

Const VK_4 = &H34 ' dec = 52, 4 key

Const VK_5 = &H35 ' dec = 53, 5 key

Const VK_6 = &H36 ' dec = 54, 6 key

Const VK_7 = &H37 ' dec = 55, 7 key

Const VK_8 = &H38 ' dec = 56, 8 key

Const VK_9 = &H39 ' dec = 57, 9 key

'??? = &H3A-40 ' dec = 58-64, Undefined

Const VK_A = &H41 ' dec = 65, A key

Const VK_B = &H42 ' dec = 66, B key

Const VK_C = &H43 ' dec = 67, C key

Const VK_D = &H44 ' dec = 68, D key

Const VK_E = &H45 ' dec = 69, E key

Const VK_F = &H46 ' dec = 70, F key

Const VK_G = &H47 ' dec = 71, G key

Const VK_H = &H48 ' dec = 72, H key

Const VK_I = &H49 ' dec = 73, I key

Const VK_J = &H4A ' dec = 74, J key

Const VK_K = &H4B ' dec = 75, K key

Const VK_L = &H4C ' dec = 76, L key

Const VK_M = &H4D ' dec = 77, M key

Const VK_N = &H4E ' dec = 78, N key

Const VK_O = &H4F ' dec = 79, O key

Const VK_P = &H50 ' dec = 80, P key

Const VK_Q = &H51 ' dec = 81, Q key

Const VK_R = &H52 ' dec = 82, R key

Const VK_S = &H53 ' dec = 83, S key

Const VK_T = &H54 ' dec = 84, T key

Const VK_U = &H55 ' dec = 85, U key

Const VK_V = &H56 ' dec = 86, V key

Const VK_W = &H57 ' dec = 87, W key

Const VK_X = &H58 ' dec = 88, X key

Const VK_Y = &H59 ' dec = 89, Y key

Const VK_Z = &H5A ' dec = 90, Z key

' Microsoft's Virtual-Key Codes constants (continued):

Const VK_LWIN = &H5B ' dec = 91, Left Windows key

Const VK_RWIN = &H5C ' dec = 92, Right Windows key

Const VK_APPS = &H5D ' dec = 93, Applications key

'??? = &H5E ' dec = 94, Reserved

Const VK_SLEEP = &H5F ' dec = 95, Computer Sleep key

Const VK_NUMPAD0 = &H60 ' dec = 96, Numeric keypad 0 key

Const VK_NUMPAD1 = &H61 ' dec = 97, Numeric keypad 1 key

Const VK_NUMPAD2 = &H62 ' dec = 98, Numeric keypad 2 key

Const VK_NUMPAD3 = &H63 ' dec = 99, Numeric keypad 3 key

Const VK_NUMPAD4 = &H64 ' dec = 100, Numeric keypad 4 key

Const VK_NUMPAD5 = &H65 ' dec = 101, Numeric keypad 5 key

Const VK_NUMPAD6 = &H66 ' dec = 102, Numeric keypad 6 key

Const VK_NUMPAD7 = &H67 ' dec = 103, Numeric keypad 7 key

Const VK_NUMPAD8 = &H68 ' dec = 104, Numeric keypad 8 key

Const VK_NUMPAD9 = &H69 ' dec = 105, Numeric keypad 9 key

Const VK_MULTIPLY = &H6A ' dec = 106, Multiply key

Const VK_ADD = &H6B ' dec = 107, Add key

Const VK_SEPARATOR = &H6C ' dec = 108, Separator key

Const VK_SUBTRACT = &H6D ' dec = 109, Subtract key

Const VK_DECIMAL = &H6E ' dec = 110, Decimal key

Const VK_DIVIDE = &H6F ' dec = 111, Divide key

Const VK_F1 = &H70 ' dec = 112, F1 key

Const VK_F2 = &H71 ' dec = 113, F2 key

Const VK_F3 = &H72 ' dec = 114, F3 key

Const VK_F4 = &H73 ' dec = 115, F4 key

Const VK_F5 = &H74 ' dec = 116, F5 key

Const VK_F6 = &H75 ' dec = 117, F6 key

Const VK_F7 = &H76 ' dec = 118, F7 key

Const VK_F8 = &H77 ' dec = 119, F8 key

Const VK_F9 = &H78 ' dec = 120, F9 key

Const VK_F10 = &H79 ' dec = 121, F10 key

Const VK_F11 = &H7A ' dec = 122, F11 key

Const VK_F12 = &H7B ' dec = 123, F12 key

Const VK_F13 = &H7C ' dec = 124, F13 key

Const VK_F14 = &H7D ' dec = 125, F14 key

Const VK_F15 = &H7E ' dec = 126, F15 key

Const VK_F16 = &H7F ' dec = 127, F16 key

Const VK_F17 = &H80 ' dec = 128, F17 key

Const VK_F18 = &H81 ' dec = 129, F18 key

Const VK_F19 = &H82 ' dec = 130, F19 key

Const VK_F20 = &H83 ' dec = 131, F20 key

Const VK_F21 = &H84 ' dec = 132, F21 key

Const VK_F22 = &H85 ' dec = 133, F22 key

Const VK_F23 = &H86 ' dec = 134, F23 key

Const VK_F24 = &H87 ' dec = 135, F24 key

'??? = &H88-8F ' dec = 136-143, Reserved

Const VK_NUMLOCK = &H90 ' dec = 144, NUM LOCK key

Const VK_SCROLL = &H91 ' dec = 145, SCROLL LOCK key

'??? = &H92-96 ' dec = 146-150, OEM specific

'??? = &H97-9F ' dec = 151-159, Unassigned

Const VK_LSHIFT = &HA0 ' dec = 160, Left SHIFT key

Const VK_RSHIFT = &HA1 ' dec = 161, Right SHIFT key

Const VK_LCONTROL = &HA2 ' dec = 162, Left CONTROL key

Const VK_RCONTROL = &HA3 ' dec = 163, Right CONTROL key

Const VK_LMENU = &HA4 ' dec = 164, Left ALT key

Const VK_RMENU = &HA5 ' dec = 165, Right ALT key

Const VK_BROWSER_BACK = &HA6 ' dec = 166, Browser Back key

Const VK_BROWSER_FORWARD = &HA7 ' dec = 167, Browser Forward key

Const VK_BROWSER_REFRESH = &HA8 ' dec = 168, Browser Refresh key

Const VK_BROWSER_STOP = &HA9 ' dec = 169, Browser Stop key

Const VK_BROWSER_SEARCH = &HAA ' dec = 170, Browser Search key

Const VK_BROWSER_FAVORITES = &HAB ' dec = 171, Browser Favorites key

Const VK_BROWSER_HOME = &HAC ' dec = 172, Browser Start and Home key

Const VK_VOLUME_MUTE = &HAD ' dec = 173, Volume Mute key

Const VK_VOLUME_DOWN = &HAE ' dec = 174, Volume Down key

Const VK_VOLUME_UP = &HAF ' dec = 175, Volume Up key

Const VK_MEDIA_NEXT_TRACK = &HB0 ' dec = 176, Next Track key

Const VK_MEDIA_PREV_TRACK = &HB1 ' dec = 177, Previous Track key

Const VK_MEDIA_STOP = &HB2 ' dec = 178, Stop Media key

Const VK_MEDIA_PLAY_PAUSE = &HB3 ' dec = 179, Play/Pause Media key

Const VK_LAUNCH_MAIL = &HB4 ' dec = 180, Start Mail key

Const VK_LAUNCH_MEDIA_SELECT = &HB5 ' dec = 181, Select Media key

Const VK_LAUNCH_APP1 = &HB6 ' dec = 182, Start Application 1 key

Const VK_LAUNCH_APP2 = &HB7 ' dec = 183, Start Application 2 key

'??? = &HB8-B9 ' dec = 184-137, Reserved

Const VK_OEM_1 = &HBA ' dec = 186, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the ;: key

Const VK_OEM_PLUS = &HBB ' dec = 187, For any country/region, the + key

Const VK_OEM_COMMA = &HBC ' dec = 188, For any country/region, the , key

Const VK_OEM_MINUS = &HBD ' dec = 189, For any country/region, the - key

Const VK_OEM_PERIOD = &HBE ' dec = 190, For any country/region, the . key

Const VK_OEM_2 = &HBF ' dec = 191, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the /? key

Const VK_OEM_3 = &HC0 ' dec = 192, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the `~ key

'??? = &HC1-DA ' dec = 193-218, Reserved

Const VK_OEM_4 = &HDB ' dec = 219, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the [{ key

Const VK_OEM_5 = &HDC ' dec = 220, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the \\| key

Const VK_OEM_6 = &HDD ' dec = 221, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the ]} key

Const VK_OEM_7 = &HDE ' dec = 222, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the '" key

Const VK_OEM_8 = &HDF ' dec = 223, Used for miscellaneous characters; it can vary by keyboard.

'??? = &HE0 ' dec = 224, Reserved

'??? = &HE1 ' dec = 225, OEM specific

Const VK_OEM_102 = &HE2 ' dec = 226, The <> keys on the US standard keyboard, or the \\| key on the non-US 102-key keyboard

'??? = &HE3-E4 ' dec = 227-228, OEM specific

Const VK_PROCESSKEY = &HE5 ' dec = 229, IME PROCESS key

'??? = &HE6 ' dec = 230, OEM specific

Const VK_PACKET = &HE7 ' dec = 231, Used to pass Unicode characters as if they were keystrokes. The VK_PACKET key is the low word of a 32-bit Virtual Key value used for non-keyboard input methods. For more information, see Remark in KEYBDINPUT, SendInput, WM_KEYDOWN, and WM_KEYUP

'??? = &HE8 ' dec = 232, Unassigned

'??? = &HE9-F5 ' dec = 233-245, OEM specific

Const VK_ATTN = &HF6 ' dec = 246, Attn key

Const VK_CRSEL = &HF7 ' dec = 247, CrSel key

Const VK_EXSEL = &HF8 ' dec = 248, ExSel key

Const VK_EREOF = &HF9 ' dec = 249, Erase EOF key

Const VK_PLAY = &HFA ' dec = 250, Play key

Const VK_ZOOM = &HFB ' dec = 251, Zoom key

Const VK_NONAME = &HFC ' dec = 252, Reserved

Const VK_PA1 = &HFD ' dec = 253, PA1 key

Const VK_OEM_CLEAR = &HFE ' dec = 254, Clear key

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' END Virtual-Key Codes

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END CONSTANTS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN TYPE DECLARATIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' UDT TO HOLD THE INFO FOR EACH MOUSE (READ MICE MAIN)

Type MouseInfoType

    ' ReadMiceMain, ReadMiceSub:

    ID As String ' player identifier or mouse device ID

    ' ReadMiceMain:

    char As String ' cursor character

    ' ReadMiceMain:

    color As _Unsigned Long ' character color = ~&MyColor (OLD=Integer)

    row As Integer ' line to display values at

    ' ReadMiceMain, ReadMiceSub:

    UpdateCount As Integer ' if this value changes we know a value changed

    ' ReadMiceMain:

    OldUpdateCount As Integer ' if this value changes we know a value changed

    ' ReadMiceMain:

    x As Integer ' screen x position

    y As Integer ' screen y position

    ' ReadMiceMain, ReadMiceSub:

    dx As Integer ' mouse x movement -1=left, 1=right, 0=none

    dy As Integer ' mouse y movement -1=up  , 1=down , 0=none

    ' ReadMiceMain:

    oldX As Integer ' tracks old x position to erase screen

    oldY As Integer ' tracks old y position to erase screen

    ' ReadMiceMain:

    countX As Integer ' increments by 1 every time mouse moves, when x movement count exceeds threshold cMouseSpeedX, send dx

    countY As Integer ' increments by 1 every time mouse moves, when y movement count exceeds threshold cMouseSpeedY, send dy

    ' ReadMiceMain, ReadMiceSub:

    pdx As Long ' x delta (hires) for absolute position of mouse from raw input api

    pdy As Long ' y delta (hires) for absolute position of mouse from raw input api

    ' ReadMiceMain, ReadMiceSub:

    px As Long ' pointer x position (hires) for absolute position of mouse from raw input api

    py As Long ' pointer y position (hires) for absolute position of mouse from raw input api

    ' ReadMiceMain:

    pxOld As Long ' old pointer x position (hires) for absolute position of mouse from raw input api

    pyOld As Long ' old pointer y position (hires) for absolute position of mouse from raw input api

    ' ReadMiceMain, ReadMiceSub:

    wheel As Integer ' mouse wheel value

    ' ReadMiceMain, ReadMiceSub:

    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

    ' ReadMiceMain

    wheelOld As Integer ' old mouse wheel value

    LeftDownOld As Integer ' tracks left mouse button state, TRUE=down

    MiddleDownOld As Integer ' tracks middle mouse button state, TRUE=down

    RightDownOld As Integer ' tracks right mouse button state, TRUE=down

    ' ReadMiceMain

    LeftCount As Integer ' counts left clicks

    MiddleCount As Integer ' counts middle clicks

    RightCount As Integer ' counts right clicks

    ' Text to display

    Message As String

End Type ' MouseInfoType

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END TYPE DECLARATIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN API DECLARATIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ================================================================================================================================================================

' BEGIN Dynamic Library definitions

' ================================================================================================================================================================

Declare Dynamic Library "user32"

    ' FOR CONTROLLING WINDOW ON TOP, ETC.:

    Function FindWindowA%& (ByVal lpClassName%&, Byval lpWindowName%&)

    Function SetWindowPos& (ByVal hWnd%&, Byval hWndInsertAfter%&, Byval X&, Byval Y&, Byval cx&, Byval cy&, Byval uFlags~&)

    Function GetForegroundWindow%&

    ' FOR CONTROLLING SUB WINDOW FOCUS:

    Sub ShowWindow (ByVal hWnd As _Offset, Byval nCmdShow As Long)

End Declare

Declare Dynamic Library "kernel32"

    Function GetLastError~& ()

End Declare

' ================================================================================================================================================================

' END Dynamic Library definitions

' ================================================================================================================================================================

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' 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)

Dim Shared m_VersionNum$: m_VersionNum$ = GetVersionNum$(m_ProgramName$)

' GLOBAL VARIABLES TO TRACK ERROR STATE

Dim Shared m_sError As String: m_sError = ""

Dim Shared m_sIncludeError As String: m_sIncludeError = ""

Dim Shared m_sTriggerFile As String: m_sTriggerFile = m_ProgramPath$ + "ReadMiceSub.DELETE-TO-CLOSE"

Dim Shared m_sDebugFile As String: m_sDebugFile = m_ProgramPath$ + m_ProgramName$ + ".txt"

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END GLOBAL VARIABLES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ****************************************************************************************************************************************************************

' BEGIN DEBUG CONSOLE

' ****************************************************************************************************************************************************************

' ENABLE / DISABLE DEBUG CONSOLE WINDOW

If cDebugEnabled = 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 cDebugEnabled = 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 arrMouse(0 To 8) As MouseInfoType ' STORES INFO FOR EACH MOUSE

    Dim iMouseCount As Integer ' # OF MICE ATTACHED

    ' WINDOW VARIABLES

    Dim hWndThis As _Offset ' hWndThis%&

    Dim hWndTop As _Offset ' x%&

    ' OTHER VARS

    Dim iLoop1 As Integer

    Dim iLoop2 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 iStartRow As Integer

    Dim arrColor(0 To 40) As _Unsigned Long ' ~&arrColor (OLD=Integer)

    Dim in$

    Dim iNextX As Integer

    Dim iNextY As Integer

    ' VARIABLES FOR READING MICE FROM CLIENT

    Dim uintPort As _Unsigned Integer ' port

    Dim lngHost ' h&

    Dim lngConn ' c&

    Dim sInput As String ' s$

    Dim sMessageType As String

    Dim sValue As String

    ' FOR LOOPING THROUGH DATA

    ReDim arrMice(-1 To -1) As String

    ReDim arrValues(-1 To -1) As String

    Dim sNextChunk As String

    Dim sNextValue As String

    Dim iValuePosition As Integer

    Dim sText As String

    ' FOR CONTROLLING WINDOW FOCUS

    Dim hwndSub As _Offset

    ' MOUSE READER PROG

    Dim sMouseReaderProg As String

    ' CONTROLS MIN/MAX SCREEN POSITIONS

    Dim iMinX As Integer

    Dim iMaxX As Integer

    Dim iMinY As Integer

    Dim iMaxY As Integer

    ' BASELINE STARTING POSITION

    Dim iStartX As Integer

    Dim iStartY As Integer

    Dim iKeyLoop As Integer

    Dim iKeyCode As Integer

    Dim iLastKeyDown As Integer

    Dim iLastKeyUp As Integer

    Dim sLastKeyDown As String

    Dim sLastKeyUp As String

    Dim sResult As String

    Dim MyTime##

    Dim imgBackground& ' NEEDS _FREEIMAGE AT END

    Dim imgWalls& ' NEEDS _FREEIMAGE AT END

    Dim imgText& ' NEEDS _FREEIMAGE AT END

    Dim imgPlayers& ' NEEDS _FREEIMAGE AT END

    Dim imgScore& ' NEEDS _FREEIMAGE AT END

    Dim screen_color~&

    Dim wall_color~&

    Dim screen_width%

    Dim screen_height%

    Dim x%

    Dim y%

    Dim message$

    ' INITIALIZE

    screen_width% = 1024 ' _DesktopWidth

    screen_height% = 768 ' _DesktopHeight

    screen_color~& = cBlack~&

    wall_color~& = cWhite~&

    iMinX = 0 ' 1 ' 2

    iMaxX = screen_width% ' 1024 ' _DesktopWidth ' (_DesktopWidth \ _FontWidth) - 1 ' _Width(0) \ _FontWidth ' 128 ' 80 ' 79

    iMinY = 0 ' 14 ' 1

    iMaxY = screen_height% ' 768 ' _DesktopHeight ' (_DesktopHeight \ _FontHeight) - 1 ' _Height(0) \ _FontHeight ' 48 ' 30

    iStartX = iMinX + 75

    iStartY = iMaxY - 54

    iLastKeyDown = 0

    iLastKeyUp = 0

    sLastKeyDown = "(None)"

    sLastKeyUp = "(None)"

    iStartRow = 5 ' text row to display mouse info at

    ' =============================================================================

    ' SET ERROR TRAPPING

    On Error GoTo ErrorHandler

    ' =============================================================================

    ' OPEN A PORT TO TALK TO THE MOUSE READER

    Randomize Timer

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

    '' DEBUG! ***********************************************************************************************************************************************

    'If cDebugEnabled = TRUE Then

    '    'Print "uintPort = Rnd * 10000 + 40000 = " + _Trim$(Str$(uintPort))

    '    DebugLog "uintPort = Rnd * 10000 + 40000 = " + _Trim$(Str$(uintPort))

    'End If

    '' DEBUG! ***********************************************************************************************************************************************

    lngHost = _OpenHost("tcp/ip:" + _Trim$(Str$(uintPort)))

    'Print lngHost

    '' DEBUG! ***********************************************************************************************************************************************

    'If cDebugEnabled = TRUE Then

    '    'Print "lngHost = _OpenHost(" + Chr$(34) + "tcp/ip:" + Chr$(34) + "_Trim$(Str$(uintPort))) = " + _Trim$(Str$(lngHost))

    '    DebugLog "lngHost = _OpenHost(" + Chr$(34) + "tcp/ip:" + Chr$(34) + "_Trim$(Str$(uintPort))) = " + _Trim$(Str$(lngHost))

    'End If

    '' DEBUG! ***********************************************************************************************************************************************

    ' =============================================================================

    ' START THE MOUSE READER PROGRAM

    sMouseReaderProg = "readmicesub" + m_VersionNum$ + ".exe"

    If _FileExists(sMouseReaderProg) = FALSE Then

        'If cDebugEnabled = TRUE Then

        '    DebugLog "Subprogram " + Chr$(34) + sMouseReaderProg + Chr$(34) + " not found."

        '    DebugLog "Be sure to compile " + Chr$(34) + "readmicesub" + m_VersionNum$ + ".bas" + Chr$(34) + " before running this."

        'End If

        Print "Subprogram " + Chr$(34) + sMouseReaderProg + Chr$(34) + " not found."

        Print "Be sure to compile " + Chr$(34) + "readmicesub" + m_VersionNum$ + ".bas" + Chr$(34) + " before running this."

        Print "PRESS ANY KEY TO EXIT"

        Sleep

    End If

    'Shell _DontWait "readmicesub39.exe " + _Trim$(Str$(uintPort))

    Shell _DontWait "readmicesub" + m_VersionNum$ + ".exe " + _Trim$(Str$(uintPort))

    ' =============================================================================

    ' GET CONNECTION WITH MOUSE READER

    lngConn = 0

    While lngConn = 0

        lngConn = _OpenConnection(lngHost)

        _Limit 60

    Wend

    '' DEBUG! ***********************************************************************************************************************************************

    'If cDebugEnabled = TRUE Then

    '    Print "lngConn = _OpenConnection(lngHost) = " + _Trim$(Str$(lngConn))

    '    DebugLog "lngConn = _OpenConnection(lngHost) = " + _Trim$(Str$(lngConn))

    'End If

    '' DEBUG! ***********************************************************************************************************************************************

    ' =============================================================================

    'GET SUB WINDOW HANDLE FROM CONNECTION...

    '_Delay 2

    'Get #lngConn, , sInput

    ' TRY FOR 30 SECONDS

    MyTime## = ExtendedTimer + 30

    sInput = ""

    Do

        '_Delay 2

        Get #lngConn, , sInput

        If Left$(sInput, 2) = "w:" Then Exit Do

    Loop Until Timer > MyTime##

    If Right$(sInput, 1) = Chr$(13) Then sInput = Left$(sInput, Len(sInput) - 1)

    '' DEBUG! ***********************************************************************************************************************************************

    'If cDebugEnabled = TRUE Then

    '    DebugLog "Get #lngConn, , sInput"

    '    DebugLog "Get #" + _Trim$(Str$(lngConn)) + ", , " + Chr$(34) + sInput + Chr$(34)

    '

    '    'Print "Get #lngConn, , sInput = " + Chr$(34) + sInput + Chr$(34)

    '    'Print "hwndSub = Val(sInput) = " + _Trim$(Str$(hwndSub))

    '    'Print "PRESS ENTER TO CONTINUE"

    '    'Sleep

    'End If

    '' DEBUG! ***********************************************************************************************************************************************

    If Left$(sInput, 2) = "w:" Then

        sValue = Right$(sInput, Len(sInput) - 2)

        'if len( Replace$(sValue, chr$(13), "") ) <> len(sValue) then DebugLog "response had chr$(13)"

        If IsNumber%(sValue) Then

            hwndSub = Val(sValue)

        Else

            m_sError = "Mouse reader subprogram failed to return a valid window handle."

            m_sError = m_sError + Chr$(13)

            m_sError = m_sError + "sInput=" + Chr$(34) + sInput + Chr$(34) + Chr$(13)

            m_sError = m_sError + "sValue=" + Chr$(34) + sValue + Chr$(34) + Chr$(13)

        End If

    ElseIf Left$(sInput, 2) = "e:" Then

        If Len(sInput) > 2 Then

            m_sError = Right$(sInput, Len(sInput) - 2)

        Else

            m_sError = "Unspecified error."

        End If

    Else

        m_sError = "Mouse reader subprogram failed to return a window handle."

        m_sError = m_sError + Chr$(13)

        m_sError = m_sError + "sInput=" + Chr$(34) + sInput + Chr$(34) + Chr$(13)

    End If

    ' IF NO ERRORS, CONTINUE

    If Len(m_sError) = 0 Then

        ' =============================================================================

        ' INITIALIZE VARIABLES

        ' INITALIZE COLORS

        arrColor(0) = cBlack

        arrColor(1) = cRed

        arrColor(2) = cDarkOrange

        arrColor(3) = cYellow

        arrColor(4) = cLime

        arrColor(5) = cCyan

        arrColor(6) = cBlue

        arrColor(7) = cDeepPurple

        arrColor(8) = cMagenta

        ' INITIALIZE USER DATA

        iNextX = iStartX

        iNextY = iStartY

        iCount = 0

        For iIndex = LBound(arrMouse) To UBound(arrMouse)

            iCount = iCount + 1

            arrMouse(iIndex).ID = "Mouse" + _Trim$(Str$(iCount))

            arrMouse(iIndex).char = Chr$(64 + iCount)

            arrMouse(iIndex).color = arrColor(iCount)

            arrMouse(iIndex).row = iCount + iStartRow

            arrMouse(iIndex).UpdateCount = 0

            arrMouse(iIndex).OldUpdateCount = 0

            arrMouse(iIndex).x = 0

            arrMouse(iIndex).y = 0

            arrMouse(iIndex).dx = 0

            arrMouse(iIndex).dy = 0

            arrMouse(iIndex).oldX = 0

            arrMouse(iIndex).oldY = 0

            arrMouse(iIndex).countX = 0

            arrMouse(iIndex).countY = 0

            arrMouse(iIndex).pdx = 0

            arrMouse(iIndex).pdy = 0

            arrMouse(iIndex).px = iNextX

            arrMouse(iIndex).py = iNextY

            arrMouse(iIndex).pxOld = arrMouse(iIndex).px

            arrMouse(iIndex).pyOld = arrMouse(iIndex).py

            ' POSITION NEXT PLAYER

            iNextX = iNextX + 75

            iNextY = iNextY - 54

            arrMouse(iIndex).wheel = 0

            arrMouse(iIndex).wheelOld = 0

            arrMouse(iIndex).LeftDown = FALSE

            arrMouse(iIndex).LeftDownOld = FALSE

            arrMouse(iIndex).MiddleDown = FALSE

            arrMouse(iIndex).MiddleDownOld = FALSE

            arrMouse(iIndex).RightDown = FALSE

            arrMouse(iIndex).RightDownOld = FALSE

            arrMouse(iIndex).LeftCount = 0

            arrMouse(iIndex).MiddleCount = 0

            arrMouse(iIndex).RightCount = 0

            arrMouse(iIndex).Message = ""

        Next iIndex

        ' ================================================================================================================================================================

        ' SETUP SCREEN + LAYERS

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' INIT SCREEN

        'Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)

        'Screen _NewImage(1024, 768, 32)

        Screen _NewImage(screen_width%, screen_height%, 32)

        ' window needs to be lined up directly under the main program, so the mouse coordinates align with the display

        _ScreenMove 0, 0

        ' CLEAR THE SCREEN

        _Dest 0: Cls , cEmpty

        ' update screen with changes & wait for next update

        _Display

        '' ATTEMPT FULLSCREEN <- NOT REALLY WORKING

        '_FULLSCREEN _STRETCH, _SMOOTH

        'IF _FULLSCREEN = 0 THEN _FULLSCREEN _OFF 'check that a full screen mode initialized

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' INIT LAYERS

        imgBackground& = _NewImage(screen_width%, screen_height%, 32)

        imgWalls& = _NewImage(screen_width%, screen_height%, 32)

        imgText& = _NewImage(screen_width%, screen_height%, 32)

        imgPlayers& = _NewImage(screen_width%, screen_height%, 32)

        imgScore& = _NewImage(screen_width%, screen_height%, 32)

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' DRAW THE BACKGROUND LAYER

        '_Dest 0: Cls , cBlack ' CLEAR THE SCREEN

        _Dest imgBackground&: Cls , screen_color~&

        'LINE (0, 0)-(screen_width%, screen_height%), screen_color~&, BF ' Draw a solid box

        ' DRAW CENTER LINE

        For y% = 44 To (screen_height% - 48) Step 20

            Line ((screen_width% / 2) - 2, y%)-((screen_width% / 2) + 2, y% + 10), wall_color~&, BF

        Next y%

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' DRAW THE WALLS LAYER

        _Dest imgWalls&: Cls , cEmpty

        ' DRAW WALLS AROUND EDGES

        For x% = 7 To screen_width% Step 20

            Line (x%, 40)-(x% + 10, 44), wall_color~&, BF

            Line (x%, screen_height% - 50)-(x% + 10, screen_height% - 54), wall_color~&, BF

        Next x%

        'DrawRectSolid (iX As Integer, iY As Integer, iSizeW As Integer, iSizeH As Integer, fgColor As _Unsigned Long)

        'DrawBoxSolid (iX As Integer, iY As Integer, iSize As Integer, fgColor As _Unsigned Long)

        '' GET BOUNDARIES

        'ball_min_x% = 1

        'ball_max_x% = screen_width%

        'ball_min_y% = 45

        'ball_max_y% = screen_height% - (54 + ball_size% + 1)

        'player_1_min_y% = 45

        'player_1_max_y% = screen_height% - (54 + player_1_height% + 1)

        'player_2_min_y% = 45

        'player_2_max_y% = screen_height% - (54 + player_2_height% + 1)

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' DRAW THE INSTRUCTIONS LAYER

        _Dest imgText&: Cls , cEmpty

        ' TEXT SCREEN AT 1024X768 IS 48 LINES X 128 CHARACTERS WIDE

        ' PRINT INSTRUCTIONS

        Color cWhite, cEmpty

        'message$ = "AVOID MISSING BALL FOR HIGH SCORE"

        message$ = "PLUG IN 2 OR MORE USB MICE, MOVE THEM AROUND, CLICK BUTTONS, PRESS KEYS ON KEYBOARD."

        Locate 1, 64 - (Len(message$) / 2): Print message$;

        ' SHOW MORE INSTRUCTIONS

        Color cWhite, cEmpty

        message$ = "TO EXIT PRESS <ESC> OR DELETE FILE " + Chr$(34) + "ReadMiceSub.DELETE-TO-CLOSE" + Chr$(34) + "."

        Locate 47, 64 - (Len(message$) / 2): Print message$;

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' DRAW THE SCORE LAYER

        _Dest imgScore&: Cls , cEmpty

        ' PRINT INITIAL SCORE

        Color cCyan, cEmpty

        Locate 2, 32: Print "LAST KEY DOWN: ";

        Locate 2, 96: Print "LAST KEY UP  : ";

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' DRAW THE PLAYERS LAYER

        _Dest imgPlayers&: Cls , cEmpty

        ' ================================================================================================================================================================

        ' MAIN LOOP

        Do

            ' KEEP READMICESUB WINDOW ON TOP

            If _WindowHasFocus = TRUE Then

                '_ScreenIcon

                ShowWindow hwndSub, 1

            End If

            ' -----------------------------------------------------------------------------

            ' READ MICE COORDINATES FROM CONNECTION...

            Get #lngConn, , sInput

            If Right$(sInput, 1) = Chr$(13) Then sInput = Left$(sInput, Len(sInput) - 1)

            ' DID IT WORK?

            If Len(m_sError) = 0 Then

                ''DebugPrint "    GOT DATA FROM CONNECTION"

                ''DebugPrint "    sInput=" + chr$(34) + sInput + chr$(34)

                ' HAVE DATA?

                If Len(sInput) > 0 Then

                    'DebugPrint "    GOT DATA FROM CONNECTION"

                    'DebugPrint "    sInput=" + chr$(34) + sInput + chr$(34)

                    ' WHAT KIND OF MESSAGE?

                    sMessageType = Left$(sInput, 2)

                    'DebugPrint "    sMessageType=" + chr$(34) + sMessageType + chr$(34)

                    If sMessageType = "d:" Then

                        ' KEY DOWN

                        sValue = Right$(sInput, Len(sInput) - 2)

                        If IsNumber%(sValue) Then

                            iLastKeyDown = Val(sValue)

                            sLastKeyDown = VirtualKeyCodeToString$(iLastKeyDown)

                        Else

                            iLastKeyDown = 0

                            sLastKeyDown = Chr$(34) + sValue + Chr$(34) + " IS NOT A NUMGBER"

                        End If

                    ElseIf sMessageType = "u:" Then

                        ' KEY UP

                        sValue = Right$(sInput, Len(sInput) - 2)

                        If IsNumber%(sValue) Then

                            iLastKeyUp = Val(sValue)

                            sLastKeyUp = VirtualKeyCodeToString$(iLastKeyUp)

                        Else

                            iLastKeyUp = 0

                            sLastKeyUp = Chr$(34) + sValue + Chr$(34) + " IS NOT A NUMGBER"

                        End If

                    ElseIf sMessageType = "m:" Then

                        ' SPLIT INPUT INTO VALUES

                        ' cForPlayer cMouseDX cMouseDY cMousePosX cMousePosY cMouseWheel cMouseLeftDown cMouseMiddleDown cMouseRightDown

                        ' {mouse #}\t{dx}\t{dy}\t{pos x}\t{pos y}\t{wheel}\t{leftDown}\t{middleDown}\t{rightDown}\n

                        sValue = Right$(sInput, Len(sInput) - 2)

                        split sValue, Chr$(9), arrValues() ' SPLIT OUTPUT INTO PAGES

                        ' PROCESS VALUES

                        iIndex = -1

                        iValuePosition = 0

                        For iLoop1 = LBound(arrValues) To UBound(arrValues)

                            ' TRACK WHAT VALUE # WE'RE ON

                            iValuePosition = iValuePosition + 1

                            'DebugPrint "            iValuePosition = " + _Trim$(Str$(iValuePosition))

                            'DebugPrint "            arrValues(" + _Trim$(Str$(iLoop1)) + ")"

                            ' GET VALUE

                            sNextValue = _Trim$(arrValues(iLoop1))

                            'DebugPrint "            sNextValue=" + Chr$(34) + sNextValue + Chr$(34)

                            ' IS IT A VALID INTEGER?

                            If IsNumber%(sNextValue) Then

                                ' DETERMINE WHICH VALUE IT IS FROM ORDINAL POSITION IN THE INPUT

                                ' AND WRITE TO APPROPRIATE VARIABLE

                                Select Case iValuePosition

                                    Case cForPlayer

                                        ' THIS VALUE TELLS US WHO IT'S FOR

                                        iIndex = Val(sNextValue)

                                        'DebugPrint "                PLAYER #" + _Trim$(Str$(iIndex))

                                        ''Case cUpdateCount

                                        ''   ' THIS VALUE TELLS US IF THERE IS NEW INPUT

                                        ''   arrMouse(iIndex).UpdateCount = Val(sNextValue)

                                        ''   DebugPrint "                UpdateCount = " + _Trim$(Str$(arrMouse(iIndex).UpdateCount))

                                    Case cMouseDX:

                                        ' READ RAW VALUE

                                        arrMouse(iIndex).dx = Val(sNextValue)

                                        'DebugPrint "                DX = " + _Trim$(Str$(arrMouse(iIndex).dx))

                                    Case cMouseDY:

                                        ' READ RAW VALUE

                                        arrMouse(iIndex).dy = Val(sNextValue)

                                        'DebugPrint "                DY = " + _Trim$(Str$(arrMouse(iIndex).dy))

                                    Case cMousePosX:

                                        ' READ RAW VALUE

                                        arrMouse(iIndex).px = Val(sNextValue)

                                    Case cMousePosY:

                                        ' READ RAW VALUE

                                        arrMouse(iIndex).py = Val(sNextValue)

                                    Case cMouseWheel:

                                        '' READ RAW VALUE

                                        'arrMouse(iIndex).wheel = Val(sNextValue)

                                    Case cMouseLeftDown:

                                        ' READ RAW VALUE

                                        arrMouse(iIndex).LeftDown = Val(sNextValue)

                                        ' DID VALUE CHANGE?

                                        If arrMouse(iIndex).LeftDown <> arrMouse(iIndex).LeftDownOld Then

                                            If arrMouse(iIndex).LeftDown = TRUE Then

                                                ' CLICKED BUTTON

                                            Else

                                                ' RELEASED BUTTON

                                            End If

                                            arrMouse(iIndex).LeftDownOld = arrMouse(iIndex).LeftDown

                                        End If

                                    Case cMouseMiddleDown:

                                        ' READ RAW VALUE

                                        arrMouse(iIndex).MiddleDown = Val(sNextValue)

                                        ' DID VALUE CHANGE?

                                        If arrMouse(iIndex).MiddleDown <> arrMouse(iIndex).MiddleDownOld Then

                                            If arrMouse(iIndex).MiddleDown = TRUE Then

                                                ' CLICKED BUTTON

                                            Else

                                                ' RELEASED BUTTON

                                            End If

                                            arrMouse(iIndex).MiddleDownOld = arrMouse(iIndex).MiddleDown

                                        End If

                                    Case cMouseRightDown:

                                        ' READ RAW VALUE

                                        arrMouse(iIndex).RightDown = Val(sNextValue)

                                        ' DID VALUE CHANGE?

                                        If arrMouse(iIndex).RightDown <> arrMouse(iIndex).RightDownOld Then

                                            If arrMouse(iIndex).RightDown = TRUE Then

                                                ' CLICKED BUTTON

                                            Else

                                                ' RELEASED BUTTON

                                            End If

                                            arrMouse(iIndex).RightDownOld = arrMouse(iIndex).RightDown

                                        End If

                                    Case Else:

                                        ' Unknown

                                End Select

                                ''' EXIT IF VALUES HAVEN'T CHANGED

                                ''If iLoop1 > cUpdateCount Then

                                ''   If arrMouse(iIndex).UpdateCount = arrMouse(iIndex).OldUpdateCount Then

                                ''       ' STOP THE MOUSE DX / DY

                                ''       arrMouse(iIndex).dy = 0

                                ''       arrMouse(iIndex).dx = 0

                                ''

                                ''       DebugPrint "                UpdateCount HASN'T CHANGED FROM OLD:"

                                ''       DebugPrint "                OldUpdateCount = " + _Trim$(Str$(arrMouse(iIndex).OldUpdateCount))

                                ''       DebugPrint "                EXITING CHUNK..."

                                ''

                                ''       ' WE CAN STOP PROCESSING THIS CHUNK

                                ''       Exit For

                                ''   End If

                                ''End If

                            Else

                                'DebugPrint "                " + _

                                '    "Value " + _

                                '    chr$(34) + sNextValue + chr$(34) + " " + _

                                '    "at position " + _

                                '    _Trim$(Str$(iLoop1)) + " " + _

                                '    "(" + MouseDataPositionToString(iLoop1) + ") " + _

                                '    "is not a number."

                                '

                                ''sNextValue

                                ''DebugPrint "                ** sNextValue NOT A NUMBER: " + chr$(34) + sNextValue + chr$(34)

                                '' (VALUE ISN'T A NUMBER)

                                '' (DO NOTHING)

                            End If

                        Next iLoop1

                        '' UPDATE OLD VALUE FOR NEXT CHANGE TEST

                        'If arrMouse(iIndex).UpdateCount <> arrMouse(iIndex).OldUpdateCount Then

                        '   arrMouse(iIndex).OldUpdateCount = arrMouse(iIndex).UpdateCount

                        'End If

                    ElseIf sMessageType = "e:" Then

                        sValue = Right$(sInput, Len(sInput) - 2)

                        'DebugPrint "    Received error message from subprogram: " + sValue

                    Else

                        'DebugPrint "    Message type from subprogram not recognized: " + sInput

                    End If

                Else

                    ' RETRIEVED DATA IS EMPTY

                    ''DebugPrint "    DATA IS EMPTY"

                    ' (JUST IGNORE FOR NOW)

                    ' TODO:

                    ' WE SHOULD QUIT IF NO DATA IS RETRIEVED IN A CERTAIN THRESHOLD OF TIME...

                End If

            Else

                ' ERROR RETRIEVING DATA...

                'DebugPrint "    ERROR RETRIEVING DATA FROM CONNECTION: " + m_sError

                ' (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

                ' TODO:

                ' WE SHOULD QUIT HERE, AND RESTART THE CLIENT...

            End If

            ' ================================================================================================================================================================

            ' UPDATE DISPLAY

            ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

            ' DRAW THE SCORE LAYER

            _Dest imgScore&: Cls , cEmpty

            ' SHOW HEADER ROW

            Color cWhite, cEmpty

            iRow = iStartRow: iCol = 5

            PrintString1 iRow, iCol, "MOUSE": iCol = iCol + 9

            PrintString1 iRow, iCol, "X POS": iCol = iCol + 9

            PrintString1 iRow, iCol, "Y POS": iCol = iCol + 9

            PrintString1 iRow, iCol, "LEFT": iCol = iCol + 9

            PrintString1 iRow, iCol, "MIDDLE": iCol = iCol + 9

            PrintString1 iRow, iCol, "RIGHT": iCol = iCol + 9

            ' SHOW VALUES FOR EACH MOUSE

            For iIndex = LBound(arrMouse) To UBound(arrMouse)

                If iIndex > -1 Then

                    Color arrMouse(iIndex).color, cEmpty

                    iRow = arrMouse(iIndex).row: iCol = 5

                    PrintString1 iRow, iCol, _Trim$(Str$(iIndex)): iCol = iCol + 9

                    PrintString1 iRow, iCol, _Trim$(Str$(arrMouse(iIndex).px)): iCol = iCol + 9

                    PrintString1 iRow, iCol, _Trim$(Str$(arrMouse(iIndex).py)): iCol = iCol + 9

                    If arrMouse(iIndex).LeftDown Then

                        Color cEmpty, arrMouse(iIndex).color

                    Else

                        Color arrMouse(iIndex).color, cEmpty

                    End If

                    PrintString1 iRow, iCol, "1": iCol = iCol + 9

                    If arrMouse(iIndex).MiddleDown Then

                        Color cEmpty, arrMouse(iIndex).color

                    Else

                        Color arrMouse(iIndex).color, cEmpty

                    End If

                    PrintString1 iRow, iCol, "2": iCol = iCol + 9

                    If arrMouse(iIndex).RightDown Then

                        Color cEmpty, arrMouse(iIndex).color

                    Else

                        Color arrMouse(iIndex).color, cEmpty

                    End If

                    PrintString1 iRow, iCol, "3": iCol = iCol + 9

                End If

            Next iIndex

            ' SHOW KEYBOARD INPUT

            Color cCyan, cEmpty

            Locate 2, 32: Print "LAST KEY DOWN: " + sLastKeyDown;

            Locate 2, 96: Print "LAST KEY UP  : " + sLastKeyUp;

            ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

            ' DRAW THE PLAYERS LAYER

            _Dest imgPlayers&: Cls , cEmpty

            For iIndex = LBound(arrMouse) To UBound(arrMouse)

                If iIndex > -1 Then

                    ' COLLECT VALUES FOR THIS MOUSE IN A STRING

                    sText = ""

                    sText = sText + _Trim$(Str$(iIndex))

                    'sText = sText + " ("

                    'sText = sText + _Trim$(Str$(arrMouse(iIndex).px))

                    'sText = sText + ","

                    'sText = sText + _Trim$(Str$(arrMouse(iIndex).py))

                    'sText = sText + ") "

                    'sText = sText + " "

                    'sText = sText + IIFS$(arrMouse(iIndex).LeftDown, "1", " ")

                    'sText = sText + IIFS$(arrMouse(iIndex).MiddleDown, "2", " ")

                    'sText = sText + IIFS$(arrMouse(iIndex).RightDown, "3", " ")

                    arrMouse(iIndex).Message = sText

                    'DrawRectSolid (iX As Integer, iY As Integer, iSizeW As Integer, iSizeH As Integer, fgColor As _Unsigned Long)

                    'DrawBoxSolid (iX As Integer, iY As Integer, iSize As Integer, fgColor As _Unsigned Long)

                    DrawBoxSolid arrMouse(iIndex).px, arrMouse(iIndex).py, 32, arrMouse(iIndex).color

                    Color cBlack, arrMouse(iIndex).color

                    _PrintString (arrMouse(iIndex).px + 8, arrMouse(iIndex).py + 8), arrMouse(iIndex).Message

                End If

            Next iIndex

            ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

            ' COPY LAYERS TO SCREEN AND UPDATE DISPLAY

            ' CLEAR THE SCREEN

            _Dest 0: Cls , cEmpty

            ' Add the background

            _PutImage , imgBackground&, 0

            ' Add the walls

            _PutImage , imgWalls&, 0

            ' Add the instructions

            _PutImage , imgText&, 0

            ' Add the score

            _PutImage , imgScore&, 0

            ' Add the players

            _PutImage , imgPlayers&, 0

            ' update screen with changes

            _Display

            ' ================================================================================================================================================================

            ' QUIT ONCE PLAYER PRESSES ESC KEY

            If iLastKeyDown = VK_ESCAPE Then

                DeleteFile m_sTriggerFile

            End If

            ' ================================================================================================================================================================

            ' QUIT IF TRIGGER FILE IS GONE

            If _FileExists(m_sTriggerFile) = FALSE Then

                'DebugLog "_FileExists(" + chr$(34) + m_sTriggerFile + chr$(34) + ") = FALSE, exiting"

                Exit Do

            End If

            '_Limit 60 ' run 60 fps

        Loop While _Connected(lngConn)

        ' RETURN TO AUTODISPLAY

        _AutoDisplay

    Else

        ' DELETE THE TRIGGER FILE SO THE SUBPROGRAM CLOSES

        DeleteFile m_sTriggerFile

        'If cDebugEnabled = TRUE Then

        '    DebugLog "ERROR:" + m_sError

        'End If

        ' SHOW EROR MESSAGE

        Screen 0

        Cls

        Print "ERROR:"

        Print

        Print m_sError

        Print

        Print "Press any key to exit."

        Sleep

    End If

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

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

Function GetVersionNum$ (sFileName$)

    Const cDigits = "1234567890"

    Dim sResult As String

    Dim sProgName As String

    Dim iLoop As Integer

    sResult$ = ""

    'sProgName$ = NoExt$(m_ProgramName$)

    sProgName$ = NoExt$(sFileName$)

    For iLoop = Len(sProgName) To 1 Step -1

        If InStr(1, cDigits, Mid$(sProgName, iLoop, 1)) = 0 Then

            Exit For

        Else

            sResult = Mid$(sProgName, iLoop, 1) + sResult

        End If

    Next iLoop

    GetVersionNum$ = sResult

End Function ' GetVersionNum$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN GRAPHIC PRINTING ROUTINES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' Does a _PrintString at the specified row+column.

'

' iRow% and iCol% are 0-based in this version

'

' See also: PrintString, PrintString1, PutCharXY

Sub PrintAt (iRow%, iCol%, sText$)

    '_PrintString (iCol% * 8, iRow% * 16), sText$

    _PrintString (iCol% * 8, iRow% * 16), sText$

    '_PrintString (iCol%, iRow%), sText$

End Sub ' PrintAt

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

' 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: PrintString

Sub PrintString1 (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 ' 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 COLOR FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Function cRed~& ()

    cRed = _RGB32(255, 0, 0)

End Function

Function cOrangeRed~& ()

    cOrangeRed = _RGB32(255, 69, 0)

End Function ' cOrangeRed~&

Function cDarkOrange~& ()

    cDarkOrange = _RGB32(255, 140, 0)

End Function ' cDarkOrange~&

Function cOrange~& ()

    cOrange = _RGB32(255, 165, 0)

End Function ' cOrange~&

Function cGold~& ()

    cGold = _RGB32(255, 215, 0)

End Function ' cGold~&

Function cYellow~& ()

    cYellow = _RGB32(255, 255, 0)

End Function ' cYellow~&

' LONG-HAIRED FRIENDS OF JESUS OR NOT,

' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)

' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:

Function cChartreuse~& ()

    cChartreuse = _RGB32(127, 255, 0)

End Function ' cChartreuse~&

' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:

Function cOliveDrab1~& ()

    cOliveDrab1 = _RGB32(192, 255, 62)

End Function ' cOliveDrab1~&

Function cLime~& ()

    cLime = _RGB32(0, 255, 0)

End Function ' cLime~&

Function cMediumSpringGreen~& ()

    cMediumSpringGreen = _RGB32(0, 250, 154)

End Function ' cMediumSpringGreen~&

' ADDED THIS FOR THE GAUGE COLOR:

Function cSpringGreen~& ()

    cSpringGreen = _RGB32(0, 255, 160)

End Function ' cSpringGreen~&

Function cCyan~& ()

    cCyan = _RGB32(0, 255, 255)

End Function ' cCyan~&

Function cDeepSkyBlue~& ()

    cDeepSkyBlue = _RGB32(0, 191, 255)

End Function ' cDeepSkyBlue~&

Function cDodgerBlue~& ()

    cDodgerBlue = _RGB32(30, 144, 255)

End Function ' cDodgerBlue~&

Function cSeaBlue~& ()

    cSeaBlue = _RGB32(0, 64, 255)

End Function ' cSeaBlue~&

Function cBlue~& ()

    cBlue = _RGB32(0, 0, 255)

End Function ' cBlue~&

Function cBluePurple~& ()

    cBluePurple = _RGB32(64, 0, 255)

End Function ' cBluePurple~&

Function cDeepPurple~& ()

    cDeepPurple = _RGB32(96, 0, 255)

End Function ' cDeepPurple~&

Function cPurple~& ()

    cPurple = _RGB32(128, 0, 255)

End Function ' cPurple~&

Function cPurpleRed~& ()

    cPurpleRed = _RGB32(128, 0, 192)

End Function ' cPurpleRed~&

Function cDarkRed~& ()

    cDarkRed = _RGB32(160, 0, 64)

End Function ' cDarkRed~&

Function cBrickRed~& ()

    cBrickRed = _RGB32(192, 0, 32)

End Function ' cBrickRed~&

Function cDarkGreen~& ()

    cDarkGreen = _RGB32(0, 100, 0)

End Function ' cDarkGreen~&

Function cGreen~& ()

    cGreen = _RGB32(0, 128, 0)

End Function ' cGreen~&

Function cOliveDrab~& ()

    cOliveDrab = _RGB32(107, 142, 35)

End Function ' cOliveDrab~&

Function cLightPink~& ()

    cLightPink = _RGB32(255, 182, 193)

End Function ' cLightPink~&

Function cHotPink~& ()

    cHotPink = _RGB32(255, 105, 180)

End Function ' cHotPink~&

Function cDeepPink~& ()

    cDeepPink = _RGB32(255, 20, 147)

End Function ' cDeepPink~&

Function cMagenta~& ()

    cMagenta = _RGB32(255, 0, 255)

End Function ' cMagenta~&

Function cBlack~& ()

    cBlack = _RGB32(0, 0, 0)

End Function ' cBlack~&

Function cDimGray~& ()

    cDimGray = _RGB32(105, 105, 105)

End Function ' cDimGray~&

Function cGray~& ()

    cGray = _RGB32(128, 128, 128)

End Function ' cGray~&

Function cDarkGray~& ()

    cDarkGray = _RGB32(169, 169, 169)

End Function ' cDarkGray~&

Function cSilver~& ()

    cSilver = _RGB32(192, 192, 192)

End Function ' cSilver~&

Function cLightGray~& ()

    cLightGray = _RGB32(211, 211, 211)

End Function ' cLightGray~&

Function cGainsboro~& ()

    cGainsboro = _RGB32(220, 220, 220)

End Function ' cGainsboro~&

Function cWhiteSmoke~& ()

    cWhiteSmoke = _RGB32(245, 245, 245)

End Function ' cWhiteSmoke~&

Function cWhite~& ()

    cWhite = _RGB32(255, 255, 255)

    'cWhite = _RGB32(254, 254, 254)

End Function ' cWhite~&

Function cDarkBrown~& ()

    cDarkBrown = _RGB32(128, 64, 0)

End Function ' cDarkBrown~&

Function cLightBrown~& ()

    cLightBrown = _RGB32(196, 96, 0)

End Function ' cLightBrown~&

Function cKhaki~& ()

    cKhaki = _RGB32(240, 230, 140)

End Function ' cKhaki~&

Function cEmpty~& ()

    'cEmpty~& = -1

    cEmpty = _RGB32(0, 0, 0, 0)

End Function ' cEmpty~&

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END COLOR FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN FILE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Help Me!

' Using shell to delete a file

' https://qb64phoenix.com/forum/showthread.php?tid=2618&pid=24683#pid24683

' a740g

' #5

' 04-24-2024, 06:05 AM

'

' There are no commands to directly make copies or backup of files.

' But you could write one with a few lines of code like:

'

' Copies src to dst

' Set overwite to true if dst should be overwritten if present

Sub CopyFile (src As String, dst As String, overwrite As _Byte)

    If _FileExists(src) Then

        If Not _FileExists(dst) Or (_FileExists(dst) And overwrite) Then

            _WriteFile dst, _ReadFile$(src)

        End If

    End If

End Sub ' CopyFile

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

' Convert a value to string and trim it (because normal Str$ adds spaces)

Function cstr$ (myValue)

    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))

    cstr$ = _Trim$(Str$(myValue))

End Function ' cstr$

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

Sub DebugLog (sText As String)

    Dim sTime As String

    Dim sResult As String

    ReDim arrLines(0) As String

    Dim iLoop As Integer

    Dim sNextLine As String

    If _FileExists(m_sDebugFile) = FALSE Then

        sResult = PrintFile$(m_sDebugFile, "", FALSE)

    End If

    If Len(sResult) = 0 Then

        sTime = GetCurrentDateTime$("{mm}/{dd}/{yyyy} {hh}:{nn}:{ss} {ampm}")

        split sText, Chr$(13), arrLines()

        For iLoop = LBound(arrLines) To UBound(arrLines)

            sNextLine = sTime + " " + arrLines(iLoop)

            sResult = PrintFile$(m_sDebugFile, sNextLine, TRUE)

        Next iLoop

    End If

End Sub ' DebugLog

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

Sub DebugLog1 (sText As String)

    Dim sResult As String

    If _FileExists(m_sDebugFile) Then

        sResult = PrintFile$(m_sDebugFile, sText, TRUE)

    Else

        sResult = PrintFile$(m_sDebugFile, sText, FALSE)

    End If

End Sub ' DebugLog

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

' QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Help Me!

' Using shell to delete a file

' https://qb64phoenix.com/forum/showthread.php?tid=2618

Sub DeleteFile (sFile As String)

    If _FileExists(sFile) Then

        'Shell "DELETE " + sFile

        'Shell "del " + sFile

        Kill sFile

    End If

End Sub ' DeleteFile

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

Function FileExt$ (sFile As String)

    Dim iPos As Integer

    iPos = _InStrRev(sFile, ".")

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                FileExt$ = Right$(sFile, Len(sFile) - iPos)

            Else

                ' dot is first character, return everything after it

                FileExt$ = Right$(sFile, Len(sFile) - 1)

            End If

        Else

            ' file only has one character, the dot, the file extension is blank

            FileExt$ = ""

        End If

    Else

        ' no dot found, the file extension is blank

        FileExt$ = ""

    End If

End Function ' FileExt$

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

Function NameOnly$ (sFile As String, sSlash As String)

    Dim iPos As Integer

    'sFile = Replace$(sFile, "/", "\")

    iPos = _InStrRev(sFile, sSlash)

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                NameOnly$ = Right$(sFile, Len(sFile) - iPos)

            Else

                ' slash is first character, return everything after it

                NameOnly$ = Right$(sFile, Len(sFile) - 1)

            End If

        Else

            ' file only has one character, the slash, name is blank

            NameOnly$ = ""

        End If

    Else

        ' slash not found, return the entire thing

        NameOnly$ = sFile

    End If

End Function ' NameOnly$

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

Function NoExt$ (sFile As String)

    Dim iPos As Integer

    iPos = _InStrRev(sFile, ".")

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                NoExt$ = Left$(sFile, iPos - 1)

            Else

                ' dot is first character, removing it returns blank!

                ' our version will just return the name unchanged

                ' but you can return blank if you prefer

                NoExt$ = sFile

            End If

        Else

            ' file only has one character, the dot, removing it returns blank!

            ' our version will just return the name unchanged

            ' but you can return blank if you prefer

            NoExt$ = sFile

        End If

    Else

        ' no dot found

        ' return the name unchanged

        NoExt$ = sFile

    End If

End Function ' NoExt$

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

Function PathOnly$ (sFile As String, sSlash As String)

    Dim iPos As Integer

    'sFile = Replace$(sFile, "/", "\")

    iPos = _InStrRev(sFile, sSlash)

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                PathOnly$ = Left$(sFile, iPos)

            Else

                ' slash is first character, so not much of a path, return blank

                PathOnly$ = ""

            End If

        Else

            ' file only has one character, the slash, name is blank

            PathOnly$ = ""

        End If

    Else

        ' slash not found, so not a path, return blank

        PathOnly$ = ""

    End If

End Function ' PathOnly$

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

' Writes sText to file sFileName.

' If bAppend=TRUE appends to file, else overwrites it.

' Returns blank if successful else returns error message.

' Example:

' ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))

' ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

' sFileName = ProgramPath$ + ProgramName$ + ".OUT.txt"

' sText = "This is a test." + chr$(13) + "Here is line 2." + chr$(13) + "End."

' sError = PrintFile$(sFileName, sText, FALSE)

Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)

    Dim sError As String: sError = ""

    If (bAppend = TRUE) Then

        If _FileExists(sFileName) Then

            Open sFileName For Append As #1 ' opens an existing file for appending

        Else

            sError = "Error in PrintFile$ : File not found. Cannot append."

        End If

    Else

        Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file

    End If

    If Len(sError) = 0 Then

        ' NOTE: WRITE places text in quotes in the file

        'WRITE #1, x, y, z$

        'WRITE #1, sText

        ' PRINT does not put text inside quotes

        Print #1, sText

        Close #1

    End If

    PrintFile$ = sError

End Function ' PrintFile$

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

' Fastest way is always to just read the whole life at once and then parse it.

Function ReadTextFile$ (sFileName As String, sDefault As String)

    Dim x$

    If _FileExists(sFileName) Then

        Open sFileName For Binary As #1

        x$ = Space$(LOF(1))

        Get #1, 1, x$

        Close #1

        ReadTextFile$ = x$

    Else

        ReadTextFile$ = sDefault

    End If

End Function ' ReadTextFile$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END FILE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN CONSTANT TO STRING FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

Function MouseDataPositionToString$ (MyInteger As Integer)

    Dim Mystring As String

    Select Case MyInteger

        Case cForPlayer:

            Mystring = "cForPlayer"

        Case cMouseDX:

            Mystring = "cMouseDX"

        Case cMouseDY:

            Mystring = "cMouseDY"

        Case cMousePosX:

            Mystring = "cMousePosX"

        Case cMousePosY:

            Mystring = "cMousePosY"

        Case cMouseWheel:

            Mystring = "cMouseWheel"

        Case cMouseLeftDown:

            Mystring = "cMouseLeftDown"

        Case cMouseMiddleDown:

            Mystring = "cMouseMiddleDown"

        Case cMouseRightDown:

            Mystring = "cMouseRightDown"

        Case Else:

            Mystring = _Trim$(Str$(MyInteger))

    End Select

    MouseDataPositionToString$ = Mystring

End Function ' MouseDataPositionToString$

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

Function VirtualKeyCodeToString$ (MyInteger As Integer)

    Dim Mystring As String

    Select Case MyInteger

        Case VK_LBUTTON:

            Mystring = "VK_LBUTTON"

        Case VK_RBUTTON:

            Mystring = "VK_RBUTTON"

        Case VK_CANCEL:

            Mystring = "VK_CANCEL"

        Case VK_MBUTTON:

            Mystring = "VK_MBUTTON"

        Case VK_XBUTTON1:

            Mystring = "VK_XBUTTON1"

        Case VK_XBUTTON2:

            Mystring = "VK_XBUTTON2"

        Case VK_BACK:

            Mystring = "VK_BACK"

        Case VK_TAB:

            Mystring = "VK_TAB"

        Case VK_CLEAR:

            Mystring = "VK_CLEAR"

        Case VK_RETURN:

            Mystring = "VK_RETURN"

        Case VK_SHIFT:

            Mystring = "VK_SHIFT"

        Case VK_CONTROL:

            Mystring = "VK_CONTROL"

        Case VK_MENU:

            Mystring = "VK_MENU"

        Case VK_PAUSE:

            Mystring = "VK_PAUSE"

        Case VK_CAPITAL:

            Mystring = "VK_CAPITAL"

        Case VK_KANA:

            Mystring = "VK_KANA"

        Case VK_HANGUL:

            Mystring = "VK_HANGUL"

        Case VK_IME_ON:

            Mystring = "VK_IME_ON"

        Case VK_JUNJA:

            Mystring = "VK_JUNJA"

        Case VK_FINAL:

            Mystring = "VK_FINAL"

        Case VK_HANJA:

            Mystring = "VK_HANJA"

        Case VK_KANJI:

            Mystring = "VK_KANJI"

        Case VK_IME_OFF:

            Mystring = "VK_IME_OFF"

        Case VK_ESCAPE:

            Mystring = "VK_ESCAPE"

        Case VK_CONVERT:

            Mystring = "VK_CONVERT"

        Case VK_NONCONVERT:

            Mystring = "VK_NONCONVERT"

        Case VK_ACCEPT:

            Mystring = "VK_ACCEPT"

        Case VK_MODECHANGE:

            Mystring = "VK_MODECHANGE"

        Case VK_SPACE:

            Mystring = "VK_SPACE"

        Case VK_PRIOR:

            Mystring = "VK_PRIOR"

        Case VK_NEXT:

            Mystring = "VK_NEXT"

        Case VK_END:

            Mystring = "VK_END"

        Case VK_HOME:

            Mystring = "VK_HOME"

        Case VK_LEFT:

            Mystring = "VK_LEFT"

        Case VK_UP:

            Mystring = "VK_UP"

        Case VK_RIGHT:

            Mystring = "VK_RIGHT"

        Case VK_DOWN:

            Mystring = "VK_DOWN"

        Case VK_SELECT:

            Mystring = "VK_SELECT"

        Case VK_PRINT:

            Mystring = "VK_PRINT"

        Case VK_EXECUTE:

            Mystring = "VK_EXECUTE"

        Case VK_SNAPSHOT:

            Mystring = "VK_SNAPSHOT"

        Case VK_INSERT:

            Mystring = "VK_INSERT"

        Case VK_DELETE:

            Mystring = "VK_DELETE"

        Case VK_HELP:

            Mystring = "VK_HELP"

        Case VK_0:

            Mystring = "VK_0"

        Case VK_1:

            Mystring = "VK_1"

        Case VK_2:

            Mystring = "VK_2"

        Case VK_3:

            Mystring = "VK_3"

        Case VK_4:

            Mystring = "VK_4"

        Case VK_5:

            Mystring = "VK_5"

        Case VK_6:

            Mystring = "VK_6"

        Case VK_7:

            Mystring = "VK_7"

        Case VK_8:

            Mystring = "VK_8"

        Case VK_9:

            Mystring = "VK_9"

        Case VK_A:

            Mystring = "VK_A"

        Case VK_B:

            Mystring = "VK_B"

        Case VK_C:

            Mystring = "VK_C"

        Case VK_D:

            Mystring = "VK_D"

        Case VK_E:

            Mystring = "VK_E"

        Case VK_F:

            Mystring = "VK_F"

        Case VK_G:

            Mystring = "VK_G"

        Case VK_H:

            Mystring = "VK_H"

        Case VK_I:

            Mystring = "VK_I"

        Case VK_J:

            Mystring = "VK_J"

        Case VK_K:

            Mystring = "VK_K"

        Case VK_L:

            Mystring = "VK_L"

        Case VK_M:

            Mystring = "VK_M"

        Case VK_N:

            Mystring = "VK_N"

        Case VK_O:

            Mystring = "VK_O"

        Case VK_P:

            Mystring = "VK_P"

        Case VK_Q:

            Mystring = "VK_Q"

        Case VK_R:

            Mystring = "VK_R"

        Case VK_S:

            Mystring = "VK_S"

        Case VK_T:

            Mystring = "VK_T"

        Case VK_U:

            Mystring = "VK_U"

        Case VK_V:

            Mystring = "VK_V"

        Case VK_W:

            Mystring = "VK_W"

        Case VK_X:

            Mystring = "VK_X"

        Case VK_Y:

            Mystring = "VK_Y"

        Case VK_Z:

            Mystring = "VK_Z"

        Case VK_LWIN:

            Mystring = "VK_LWIN"

        Case VK_RWIN:

            Mystring = "VK_RWIN"

        Case VK_APPS:

            Mystring = "VK_APPS"

        Case VK_SLEEP:

            Mystring = "VK_SLEEP"

        Case VK_NUMPAD0:

            Mystring = "VK_NUMPAD0"

        Case VK_NUMPAD1:

            Mystring = "VK_NUMPAD1"

        Case VK_NUMPAD2:

            Mystring = "VK_NUMPAD2"

        Case VK_NUMPAD3:

            Mystring = "VK_NUMPAD3"

        Case VK_NUMPAD4:

            Mystring = "VK_NUMPAD4"

        Case VK_NUMPAD5:

            Mystring = "VK_NUMPAD5"

        Case VK_NUMPAD6:

            Mystring = "VK_NUMPAD6"

        Case VK_NUMPAD7:

            Mystring = "VK_NUMPAD7"

        Case VK_NUMPAD8:

            Mystring = "VK_NUMPAD8"

        Case VK_NUMPAD9:

            Mystring = "VK_NUMPAD9"

        Case VK_MULTIPLY:

            Mystring = "VK_MULTIPLY"

        Case VK_ADD:

            Mystring = "VK_ADD"

        Case VK_SEPARATOR:

            Mystring = "VK_SEPARATOR"

        Case VK_SUBTRACT:

            Mystring = "VK_SUBTRACT"

        Case VK_DECIMAL:

            Mystring = "VK_DECIMAL"

        Case VK_DIVIDE:

            Mystring = "VK_DIVIDE"

        Case VK_F1:

            Mystring = "VK_F1"

        Case VK_F2:

            Mystring = "VK_F2"

        Case VK_F3:

            Mystring = "VK_F3"

        Case VK_F4:

            Mystring = "VK_F4"

        Case VK_F5:

            Mystring = "VK_F5"

        Case VK_F6:

            Mystring = "VK_F6"

        Case VK_F7:

            Mystring = "VK_F7"

        Case VK_F8:

            Mystring = "VK_F8"

        Case VK_F9:

            Mystring = "VK_F9"

        Case VK_F10:

            Mystring = "VK_F10"

        Case VK_F11:

            Mystring = "VK_F11"

        Case VK_F12:

            Mystring = "VK_F12"

        Case VK_F13:

            Mystring = "VK_F13"

        Case VK_F14:

            Mystring = "VK_F14"

        Case VK_F15:

            Mystring = "VK_F15"

        Case VK_F16:

            Mystring = "VK_F16"

        Case VK_F17:

            Mystring = "VK_F17"

        Case VK_F18:

            Mystring = "VK_F18"

        Case VK_F19:

            Mystring = "VK_F19"

        Case VK_F20:

            Mystring = "VK_F20"

        Case VK_F21:

            Mystring = "VK_F21"

        Case VK_F22:

            Mystring = "VK_F22"

        Case VK_F23:

            Mystring = "VK_F23"

        Case VK_F24:

            Mystring = "VK_F24"

        Case VK_NUMLOCK:

            Mystring = "VK_NUMLOCK"

        Case VK_SCROLL:

            Mystring = "VK_SCROLL"

        Case VK_LSHIFT:

            Mystring = "VK_LSHIFT"

        Case VK_RSHIFT:

            Mystring = "VK_RSHIFT"

        Case VK_LCONTROL:

            Mystring = "VK_LCONTROL"

        Case VK_RCONTROL:

            Mystring = "VK_RCONTROL"

        Case VK_LMENU:

            Mystring = "VK_LMENU"

        Case VK_RMENU:

            Mystring = "VK_RMENU"

        Case VK_BROWSER_BACK:

            Mystring = "VK_BROWSER_BACK"

        Case VK_BROWSER_FORWARD:

            Mystring = "VK_BROWSER_FORWARD"

        Case VK_BROWSER_REFRESH:

            Mystring = "VK_BROWSER_REFRESH"

        Case VK_BROWSER_STOP:

            Mystring = "VK_BROWSER_STOP"

        Case VK_BROWSER_SEARCH:

            Mystring = "VK_BROWSER_SEARCH"

        Case VK_BROWSER_FAVORITES:

            Mystring = "VK_BROWSER_FAVORITES"

        Case VK_BROWSER_HOME:

            Mystring = "VK_BROWSER_HOME"

        Case VK_VOLUME_MUTE:

            Mystring = "VK_VOLUME_MUTE"

        Case VK_VOLUME_DOWN:

            Mystring = "VK_VOLUME_DOWN"

        Case VK_VOLUME_UP:

            Mystring = "VK_VOLUME_UP"

        Case VK_MEDIA_NEXT_TRACK:

            Mystring = "VK_MEDIA_NEXT_TRACK"

        Case VK_MEDIA_PREV_TRACK:

            Mystring = "VK_MEDIA_PREV_TRACK"

        Case VK_MEDIA_STOP:

            Mystring = "VK_MEDIA_STOP"

        Case VK_MEDIA_PLAY_PAUSE:

            Mystring = "VK_MEDIA_PLAY_PAUSE"

        Case VK_LAUNCH_MAIL:

            Mystring = "VK_LAUNCH_MAIL"

        Case VK_LAUNCH_MEDIA_SELECT:

            Mystring = "VK_LAUNCH_MEDIA_SELECT"

        Case VK_LAUNCH_APP1:

            Mystring = "VK_LAUNCH_APP1"

        Case VK_LAUNCH_APP2:

            Mystring = "VK_LAUNCH_APP2"

        Case VK_OEM_1:

            Mystring = "VK_OEM_1"

        Case VK_OEM_PLUS:

            Mystring = "VK_OEM_PLUS"

        Case VK_OEM_COMMA:

            Mystring = "VK_OEM_COMMA"

        Case VK_OEM_MINUS:

            Mystring = "VK_OEM_MINUS"

        Case VK_OEM_PERIOD:

            Mystring = "VK_OEM_PERIOD"

        Case VK_OEM_2:

            Mystring = "VK_OEM_2"

        Case VK_OEM_3:

            Mystring = "VK_OEM_3"

        Case VK_OEM_4:

            Mystring = "VK_OEM_4"

        Case VK_OEM_5:

            Mystring = "VK_OEM_5"

        Case VK_OEM_6:

            Mystring = "VK_OEM_6"

        Case VK_OEM_7:

            Mystring = "VK_OEM_7"

        Case VK_OEM_8:

            Mystring = "VK_OEM_8"

        Case VK_OEM_102:

            Mystring = "VK_OEM_102"

        Case VK_PROCESSKEY:

            Mystring = "VK_PROCESSKEY"

        Case VK_PACKET:

            Mystring = "VK_PACKET"

        Case VK_ATTN:

            Mystring = "VK_ATTN"

        Case VK_CRSEL:

            Mystring = "VK_CRSEL"

        Case VK_EXSEL:

            Mystring = "VK_EXSEL"

        Case VK_EREOF:

            Mystring = "VK_EREOF"

        Case VK_PLAY:

            Mystring = "VK_PLAY"

        Case VK_ZOOM:

            Mystring = "VK_ZOOM"

        Case VK_NONAME:

            Mystring = "VK_NONAME"

        Case VK_PA1:

            Mystring = "VK_PA1"

        Case VK_OEM_CLEAR:

            Mystring = "VK_OEM_CLEAR"

        Case Else:

            Mystring = _Trim$(Str$(MyInteger))

    End Select

    VirtualKeyCodeToString$ = Mystring

End Function ' VirtualKeyCodeToString$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END CONSTANT TO STRING FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN DRAWING ROUTINES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' DRAW A 2-D BOX (SOLID)

' https://www.qb64.org/wiki/LINE

' Renamed DrawBox/DrawBoxLine to DrawSolidBox

Sub DrawBoxSolid (iX As Integer, iY As Integer, iSize As Integer, fgColor As _Unsigned Long)

    Line (iX, iY)-(iX + iSize, iY + iSize), fgColor, BF ' Draw a solid box

End Sub ' DrawBoxSolid

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

' DRAW A 2-D RECTANGLE (SOLID)

Sub DrawRectSolid (iX As Integer, iY As Integer, iSizeW As Integer, iSizeH As Integer, fgColor As _Unsigned Long)

    Line (iX, iY)-(iX + iSizeW, iY + iSizeH), fgColor, BF ' Draw a solid rectangle

End Sub ' DrawRectSolid

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END DRAWING ROUTINES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN GENERAL PURPOSE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' SMcNeill

' More efficient version of ExtendedTimer.

' This stores our day values and only updates them when necessary.

' We really don't need to figure out how many seconds are in today over and over endlessly

' -- just count them once, and when the clock swaps back to 0:0:0, add 24*60*60 seconds to the count.

' Re: how to time something (ie do loop for n seconds)

' https://forum.qb64.org/index.php?topic=4682.0

Function ExtendedTimer##

    'modified extendedtimer to store the old day's count, and not have to recalculate it every time the routine is called.

    Static olds As _Float, old_day As _Float

    Dim m As Integer, d As Integer, y As Integer

    Dim s As _Float, day As String

    Dim oldt As Single

    If olds = 0 Then 'calculate the day the first time the extended timer runs

        day = Date$

        m = Val(Left$(day, 2))

        d = Val(Mid$(day, 4, 2))

        y = Val(Right$(day, 4)) - 1970

        Select Case m 'Add the number of days for each previous month passed

            Case 2: d = d + 31

            Case 3: d = d + 59

            Case 4: d = d + 90

            Case 5: d = d + 120

            Case 6: d = d + 151

            Case 7: d = d + 181

            Case 8: d = d + 212

            Case 9: d = d + 243

            Case 10: d = d + 273

            Case 11: d = d + 304

            Case 12: d = d + 334

        End Select

        If (y Mod 4) = 2 And m > 2 Then d = d + 1 'add a day if this is leap year and we're past february

        d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year

        d = d + (y + 2) \ 4 'add in days for leap years passed

        s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds

        old_day = s

    End If

    If Timer < oldt Then 'we went from 23:59:59 (a second before midnight) to 0:0:0 (midnight)

        old_day = s + 83400 'add another worth of seconds to our counter

    End If

    oldt = Timer

    olds = old_day + oldt

    ExtendedTimer## = olds

End Function ' ExtendedTimer##

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

' Simple timestamp function

' Format: {YYYY}-{MM}-{DD} {hh}:[mm}:{ss}

' Uses:

'     TIME$

'         The TIME$ Function returns a STRING representation

'         of the current computer time in a 24 hour format.

'         https://qb64phoenix.com/qb64wiki/index.php/TIME$

'     DATE$

'         The DATE$ function returns the current computer date

'         as a string in the format "mm-dd-yyyy".

'         https://qb64phoenix.com/qb64wiki/index.php/DATE$

'

' TODO: support template where

'       {yyyy} = 4 digit year

'       {mm}   = 2 digit month

'       {dd}   = 2 digit day

'       {hh}   = 2 digit hour (12-hour)

'       {rr}   = 2 digit hour (24-hour)

'       {nn}   = 2 digit minute

'       {ss}   = 2 digit second

'       {ampm} = AM/PM

' We got the nn for minute from Microsoft > Office VBA Reference > DateDiff function

' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/datediff-function

' PRINT "Current date time (simple format) = " + Chr$(34) + GetCurrentDateTime$("{yyyy}-{mm}-{dd} {rr}:{nn}:{ss}") + Chr$(34)

' PRINT "Current date time (US format)     = " + Chr$(34) + GetCurrentDateTime$("{mm}/{dd}/{yyyy} {hh}:{nn}:{ss} {ampm}") + Chr$(34)

' PRINT "Filename timestamp                = " + Chr$(34) + GetCurrentDateTime$("{yyyy}{mm}{dd}_{rr}{nn}{ss}") + Chr$(34)

Function GetCurrentDateTime$ (sTemplate$)

    Dim sDate$: sDate$ = Date$

    Dim sTime$: sTime$ = Time$

    Dim sYYYY$: sYYYY$ = Mid$(sDate$, 7, 4)

    Dim sMM$: sMM$ = Mid$(sDate$, 1, 2)

    Dim sDD$: sDD$ = Mid$(sDate$, 4, 2)

    Dim sHH24$: sHH24$ = Mid$(sTime$, 1, 2)

    Dim sHH$: sHH$ = ""

    Dim sMI$: sMI$ = Mid$(sTime$, 4, 2)

    Dim sSS$: sSS$ = Mid$(sTime$, 7, 2)

    Dim iHour%: iHour% = Val(sHH24$)

    Dim sAMPM$: sAMPM$ = ""

    Dim result$: result$ = ""

    ' FIGURE OUT AM/PM

    If InStr(sTemplate$, "{ampm}") > 0 Then

        If iHour% = 0 Then

            sAMPM$ = "AM"

            iHour% = 12

        ElseIf iHour% > 0 And iHour% < 12 Then

            sAMPM$ = "AM"

        ElseIf iHour% = 12 Then

            sAMPM$ = "PM"

        Else

            sAMPM$ = "PM"

            iHour% = iHour% - 12

        End If

        sHH$ = Right$("00" + _Trim$(Str$(iHour%)), 2)

    End If

    ' POPULATE TEMPLATE

    result$ = sTemplate$

    result$ = Replace$(result$, "{yyyy}", sYYYY$)

    result$ = Replace$(result$, "{mm}", sMM$)

    result$ = Replace$(result$, "{dd}", sDD$)

    result$ = Replace$(result$, "{hh}", sHH$)

    result$ = Replace$(result$, "{rr}", sHH24$)

    result$ = Replace$(result$, "{nn}", sMI$)

    result$ = Replace$(result$, "{ss}", sSS$)

    result$ = Replace$(result$, "{ampm}", sAMPM$)

    ' RETURN RESULT

    GetCurrentDateTime$ = result$

End Function ' GetCurrentDateTime$

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

' 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%

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

' IIF function for QB for integers

Function IIF (Condition, IfTrue, IfFalse)

    If Condition Then IIF = IfTrue Else IIF = IfFalse

End Function

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

' IIF function for QB for strings

Function IIFS$ (Condition, IfTrue$, IfFalse$)

    If Condition Then IIFS$ = IfTrue$ Else IIFS$ = IfFalse$

End Function

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

' 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$

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

' FROM: String Manipulation

' found at abandoned, outdated and now likely malicious qb64 dot net website

' http://www.qb64.[net]/forum/index_topic_5964-0/

'

'SUMMARY:

'   Purpose:  A library of custom functions that transform strings.

'   Author:   Dustinian Camburides (dustinian@gmail.com)

'   Platform: QB64 (www.qb64.org)

'   Revision: 1.6

'   Updated:  5/28/2012

'SUMMARY:

'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.

'INPUT:

'Text: The input string; the text that's being manipulated.

'Find: The specified sub-string; the string sought within the [Text] string.

'Add: The sub-string that's being added to the [Text] string.

Function Replace$ (Text1 As String, Find1 As String, Add1 As String)

    ' VARIABLES:

    Dim Text2 As String

    Dim Find2 As String

    Dim Add2 As String

    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.

    Dim strBefore As String ' The characters before the string to be replaced.

    Dim strAfter As String ' The characters after the string to be replaced.

    ' INITIALIZE:

    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)

    Text2 = Text1

    Find2 = Find1

    Add2 = Add1

    lngLocation = InStr(1, Text2, Find2)

    ' PROCESSING:

    ' While [Find2] appears in [Text2]...

    While lngLocation

        ' Extract all Text2 before the [Find2] substring:

        strBefore = Left$(Text2, lngLocation - 1)

        ' Extract all text after the [Find2] substring:

        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))

        ' Return the substring:

        Text2 = strBefore + Add2 + strAfter

        ' Locate the next instance of [Find2]:

        lngLocation = InStr(1, Text2, Find2)

        ' Next instance of [Find2]...

    Wend

    ' OUTPUT:

    Replace$ = Text2

End Function ' Replace$

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

' 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 cDebugEnabled = 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 cDebugEnabled = 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

"readmicesub54.bas":

Code: (Select All)
' ################################################################################################################################################################

' Multimouse sub-program "ReadMiceSub.bas"

' ################################################################################################################################################################

' -------------------------------------------------------------------------------

' ABOUT

' -------------------------------------------------------------------------------

' (Subprogram for READMICEMAIN.BAS, see that for more info.)

' *****************************************************************************

' NOTES:

'

' The following header files must be in same folder as this program:

' "makeint.h"

' "winproc.h"

' This detects a "phantom mouse" which doesn't seem to work.

' I think it might be my laptop's touchpad or touchscreen,

' is there some way to get the input from this working,

' or if not, at least identify and ignore it?

'

' *****************************************************************************

Option Explicit

_Title "readmice"

$NoPrefix

'$Console:Only

'Console Off

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN CONSTANTS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Const cProgName = "ReadMiceSub"

Const FALSE = 0

Const TRUE = Not FALSE

Const cDebugEnabled = FALSE

' FORM ALPHA VALUES

Const cInvisible = 1 ' for some reason a value of 0 (fully invisible) doesn't let the window get the focus, so we use 1

Const cTransparent = 160

Const cVisible = 255

' MIN/MAX VALUES FOR MOUSE TEST

Const cMinX = 1

Const cMaxX = 354 ' 160 ' 79 ' 80

Const cMinY = 1 ' 16

Const cMaxY = 45 ' 30 24

Const cMinWheel = 0

Const cMaxWheel = 255

Const cMinPX = 1

Const cMaxPX = 1024

Const cMinPY = 1

Const cMaxPY = 768

' CONSTANT FOR 2ND DIMENSION OF arrFile ARRAY

Const cFileName = 0

Const cFileData = 1

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END CONSTANTS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ================================================================================================================================================================

' BEGIN API CONSTANTS

' ================================================================================================================================================================

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' 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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' FOR RAW INPUT API

Const COLOR_WINDOW = 5

Const CS_HREDRAW = &H0002

Const CS_VREDRAW = &H0001

Const CW_USEDEFAULT = &H80000000

Const DT_CENTER = &H00000001

Const DT_LEFT = &H00000000

Const DT_RIGHT = &H00000002

Const DT_VCENTER = &H00000004

Const DT_WORDBREAK = &H00000010

Const DT_SINGLELINE = &H00000020

Const Edit = 101

Const EM_GETSEL = &H00B0

Const EM_SETSEL = &H00B1

Const EN_CHANGE = &H0300

Const EN_KILLFOCUS = &H0200

Const EN_SETFOCUS = &H0100

Const GCL_HICON = -14

Const GCL_HICONSM = -34

Const Hid_Bottom = 66

Const Hid_Left = 33

Const Hid_Right = 34

Const HWND_DESKTOP = 0

Const ICON_BIG = 1

Const ICON_SMALL = 0

Const IDC_ARROW = 32512

Const IDI_APPLICATION = 32512

Const KEYEVENTF_KEYUP = &H0002

Const KL_NAMELENGTH = 9

Const LabelInfo = 201

Const MOUSE_ATTRIBUTES_CHANGED = &H04

Const MOUSE_MOVE_ABSOLUTE = &H01

Const MOUSE_MOVE_NOCOALESCE = &H08

Const MOUSE_MOVE_RELATIVE = &H00

Const MOUSE_VIRTUAL_DESKTOP = &H02

Const NULL = 0

Const RI_KEY_BREAK = 1

Const RI_KEY_E0 = 2

Const RI_KEY_E1 = 4

Const RI_KEY_MAKE = 0

Const RI_KEY_TERMSRV_SET_LED = 8

Const RI_KEY_TERMSRV_SHADOW = &H10

Const RID_INPUT = &H10000003

Const RIDEV_EXINPUTSINK = &H00001000

Const RIDI_DEVICEINFO = &H2000000B

Const RIM_TYPEMOUSE = 0

Const RIM_TYPEKEYBOARD = 1

Const RIM_TYPEHID = 2

Const RIM_TYPEUNKNOWN = -1 ' just a made up value to indicate type unknown

Const SIZE_MINIMIZED = 1

Const SW_SHOW = 5

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' BEGIN Virtual-Key Codes

' https://learn.microsoft.com/en-us/windows/win32/inputdev/virtual-key-codes

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' NOTE: raw.data.Keyboard.vKey may require set extended bit

Const VK_LBUTTON = &H01 ' dec = 1, Left mouse button

Const VK_RBUTTON = &H02 ' dec = 2, Right mouse button

Const VK_CANCEL = &H03 ' dec = 3, Control-break processing

Const VK_MBUTTON = &H04 ' dec = 4, Middle mouse button

Const VK_XBUTTON1 = &H05 ' dec = 5, X1 mouse button

Const VK_XBUTTON2 = &H06 ' dec = 6, X2 mouse button

'??? = &H07 ' dec = 7, Reserved

Const VK_BACK = &H08 ' dec = 8, BACKSPACE key

Const VK_TAB = &H09 ' dec = 9, TAB key

'??? = &H0A-0B ' dec = 10-11, Reserved

Const VK_CLEAR = &H0C ' dec = 12, CLEAR key

Const VK_RETURN = &H0D ' dec = 13, ENTER key

'??? = &H0E-0F ' dec = 14-15, Unassigned

Const VK_SHIFT = &H10 ' dec = 16, SHIFT key

Const VK_CONTROL = &H11 ' dec = 17, CTRL key

Const VK_MENU = &H12 ' dec = 18, ALT key

Const VK_PAUSE = &H13 ' dec = 19, PAUSE key

Const VK_CAPITAL = &H14 ' dec = 20, CAPS LOCK key

Const VK_KANA = &H15 ' dec = 21, IME Kana mode

Const VK_HANGUL = &H15 ' dec = 21, IME Hangul mode

Const VK_IME_ON = &H16 ' dec = 22, IME On

Const VK_JUNJA = &H17 ' dec = 23, IME Junja mode

Const VK_FINAL = &H18 ' dec = 24, IME final mode

Const VK_HANJA = &H19 ' dec = 25, IME Hanja mode

Const VK_KANJI = &H19 ' dec = 25, IME Kanji mode

Const VK_IME_OFF = &H1A ' dec = 26, IME Off

Const VK_ESCAPE = &H1B ' dec = 27, ESC key

Const VK_CONVERT = &H1C ' dec = 28, IME convert

Const VK_NONCONVERT = &H1D ' dec = 29, IME nonconvert

Const VK_ACCEPT = &H1E ' dec = 30, IME accept

Const VK_MODECHANGE = &H1F ' dec = 31, IME mode change request

Const VK_SPACE = &H20 ' dec = 32, SPACEBAR

Const VK_PRIOR = &H21 ' dec = 33, PAGE UP key

Const VK_NEXT = &H22 ' dec = 34, PAGE DOWN key

Const VK_END = &H23 ' dec = 35, END key

Const VK_HOME = &H24 ' dec = 36, HOME key

Const VK_LEFT = &H25 ' dec = 37, LEFT ARROW key

Const VK_UP = &H26 ' dec = 38, UP ARROW key

Const VK_RIGHT = &H27 ' dec = 39, RIGHT ARROW key

Const VK_DOWN = &H28 ' dec = 40, DOWN ARROW key

Const VK_SELECT = &H29 ' dec = 41, SELECT key

Const VK_PRINT = &H2A ' dec = 42, PRINT key

Const VK_EXECUTE = &H2B ' dec = 43, EXECUTE key

Const VK_SNAPSHOT = &H2C ' dec = 44, PRINT SCREEN key

Const VK_INSERT = &H2D ' dec = 45, INS key

Const VK_DELETE = &H2E ' dec = 46, DEL key

Const VK_HELP = &H2F ' dec = 47, HELP key

' MADE OUR OWN CONSTANTS FOR THESE:

Const VK_0 = &H30 ' dec = 48, 0 key

Const VK_1 = &H31 ' dec = 49, 1 key

Const VK_2 = &H32 ' dec = 50, 2 key

Const VK_3 = &H33 ' dec = 51, 3 key

Const VK_4 = &H34 ' dec = 52, 4 key

Const VK_5 = &H35 ' dec = 53, 5 key

Const VK_6 = &H36 ' dec = 54, 6 key

Const VK_7 = &H37 ' dec = 55, 7 key

Const VK_8 = &H38 ' dec = 56, 8 key

Const VK_9 = &H39 ' dec = 57, 9 key

'??? = &H3A-40 ' dec = 58-64, Undefined

Const VK_A = &H41 ' dec = 65, A key

Const VK_B = &H42 ' dec = 66, B key

Const VK_C = &H43 ' dec = 67, C key

Const VK_D = &H44 ' dec = 68, D key

Const VK_E = &H45 ' dec = 69, E key

Const VK_F = &H46 ' dec = 70, F key

Const VK_G = &H47 ' dec = 71, G key

Const VK_H = &H48 ' dec = 72, H key

Const VK_I = &H49 ' dec = 73, I key

Const VK_J = &H4A ' dec = 74, J key

Const VK_K = &H4B ' dec = 75, K key

Const VK_L = &H4C ' dec = 76, L key

Const VK_M = &H4D ' dec = 77, M key

Const VK_N = &H4E ' dec = 78, N key

Const VK_O = &H4F ' dec = 79, O key

Const VK_P = &H50 ' dec = 80, P key

Const VK_Q = &H51 ' dec = 81, Q key

Const VK_R = &H52 ' dec = 82, R key

Const VK_S = &H53 ' dec = 83, S key

Const VK_T = &H54 ' dec = 84, T key

Const VK_U = &H55 ' dec = 85, U key

Const VK_V = &H56 ' dec = 86, V key

Const VK_W = &H57 ' dec = 87, W key

Const VK_X = &H58 ' dec = 88, X key

Const VK_Y = &H59 ' dec = 89, Y key

Const VK_Z = &H5A ' dec = 90, Z key

' Microsoft's Virtual-Key Codes constants (continued):

Const VK_LWIN = &H5B ' dec = 91, Left Windows key

Const VK_RWIN = &H5C ' dec = 92, Right Windows key

Const VK_APPS = &H5D ' dec = 93, Applications key

'??? = &H5E ' dec = 94, Reserved

Const VK_SLEEP = &H5F ' dec = 95, Computer Sleep key

Const VK_NUMPAD0 = &H60 ' dec = 96, Numeric keypad 0 key

Const VK_NUMPAD1 = &H61 ' dec = 97, Numeric keypad 1 key

Const VK_NUMPAD2 = &H62 ' dec = 98, Numeric keypad 2 key

Const VK_NUMPAD3 = &H63 ' dec = 99, Numeric keypad 3 key

Const VK_NUMPAD4 = &H64 ' dec = 100, Numeric keypad 4 key

Const VK_NUMPAD5 = &H65 ' dec = 101, Numeric keypad 5 key

Const VK_NUMPAD6 = &H66 ' dec = 102, Numeric keypad 6 key

Const VK_NUMPAD7 = &H67 ' dec = 103, Numeric keypad 7 key

Const VK_NUMPAD8 = &H68 ' dec = 104, Numeric keypad 8 key

Const VK_NUMPAD9 = &H69 ' dec = 105, Numeric keypad 9 key

Const VK_MULTIPLY = &H6A ' dec = 106, Multiply key

Const VK_ADD = &H6B ' dec = 107, Add key

Const VK_SEPARATOR = &H6C ' dec = 108, Separator key

Const VK_SUBTRACT = &H6D ' dec = 109, Subtract key

Const VK_DECIMAL = &H6E ' dec = 110, Decimal key

Const VK_DIVIDE = &H6F ' dec = 111, Divide key

Const VK_F1 = &H70 ' dec = 112, F1 key

Const VK_F2 = &H71 ' dec = 113, F2 key

Const VK_F3 = &H72 ' dec = 114, F3 key

Const VK_F4 = &H73 ' dec = 115, F4 key

Const VK_F5 = &H74 ' dec = 116, F5 key

Const VK_F6 = &H75 ' dec = 117, F6 key

Const VK_F7 = &H76 ' dec = 118, F7 key

Const VK_F8 = &H77 ' dec = 119, F8 key

Const VK_F9 = &H78 ' dec = 120, F9 key

Const VK_F10 = &H79 ' dec = 121, F10 key

Const VK_F11 = &H7A ' dec = 122, F11 key

Const VK_F12 = &H7B ' dec = 123, F12 key

Const VK_F13 = &H7C ' dec = 124, F13 key

Const VK_F14 = &H7D ' dec = 125, F14 key

Const VK_F15 = &H7E ' dec = 126, F15 key

Const VK_F16 = &H7F ' dec = 127, F16 key

Const VK_F17 = &H80 ' dec = 128, F17 key

Const VK_F18 = &H81 ' dec = 129, F18 key

Const VK_F19 = &H82 ' dec = 130, F19 key

Const VK_F20 = &H83 ' dec = 131, F20 key

Const VK_F21 = &H84 ' dec = 132, F21 key

Const VK_F22 = &H85 ' dec = 133, F22 key

Const VK_F23 = &H86 ' dec = 134, F23 key

Const VK_F24 = &H87 ' dec = 135, F24 key

'??? = &H88-8F ' dec = 136-143, Reserved

Const VK_NUMLOCK = &H90 ' dec = 144, NUM LOCK key

Const VK_SCROLL = &H91 ' dec = 145, SCROLL LOCK key

'??? = &H92-96 ' dec = 146-150, OEM specific

'??? = &H97-9F ' dec = 151-159, Unassigned

Const VK_LSHIFT = &HA0 ' dec = 160, Left SHIFT key

Const VK_RSHIFT = &HA1 ' dec = 161, Right SHIFT key

Const VK_LCONTROL = &HA2 ' dec = 162, Left CONTROL key

Const VK_RCONTROL = &HA3 ' dec = 163, Right CONTROL key

Const VK_LMENU = &HA4 ' dec = 164, Left ALT key

Const VK_RMENU = &HA5 ' dec = 165, Right ALT key

Const VK_BROWSER_BACK = &HA6 ' dec = 166, Browser Back key

Const VK_BROWSER_FORWARD = &HA7 ' dec = 167, Browser Forward key

Const VK_BROWSER_REFRESH = &HA8 ' dec = 168, Browser Refresh key

Const VK_BROWSER_STOP = &HA9 ' dec = 169, Browser Stop key

Const VK_BROWSER_SEARCH = &HAA ' dec = 170, Browser Search key

Const VK_BROWSER_FAVORITES = &HAB ' dec = 171, Browser Favorites key

Const VK_BROWSER_HOME = &HAC ' dec = 172, Browser Start and Home key

Const VK_VOLUME_MUTE = &HAD ' dec = 173, Volume Mute key

Const VK_VOLUME_DOWN = &HAE ' dec = 174, Volume Down key

Const VK_VOLUME_UP = &HAF ' dec = 175, Volume Up key

Const VK_MEDIA_NEXT_TRACK = &HB0 ' dec = 176, Next Track key

Const VK_MEDIA_PREV_TRACK = &HB1 ' dec = 177, Previous Track key

Const VK_MEDIA_STOP = &HB2 ' dec = 178, Stop Media key

Const VK_MEDIA_PLAY_PAUSE = &HB3 ' dec = 179, Play/Pause Media key

Const VK_LAUNCH_MAIL = &HB4 ' dec = 180, Start Mail key

Const VK_LAUNCH_MEDIA_SELECT = &HB5 ' dec = 181, Select Media key

Const VK_LAUNCH_APP1 = &HB6 ' dec = 182, Start Application 1 key

Const VK_LAUNCH_APP2 = &HB7 ' dec = 183, Start Application 2 key

'??? = &HB8-B9 ' dec = 184-137, Reserved

Const VK_OEM_1 = &HBA ' dec = 186, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the ;: key

Const VK_OEM_PLUS = &HBB ' dec = 187, For any country/region, the + key

Const VK_OEM_COMMA = &HBC ' dec = 188, For any country/region, the , key

Const VK_OEM_MINUS = &HBD ' dec = 189, For any country/region, the - key

Const VK_OEM_PERIOD = &HBE ' dec = 190, For any country/region, the . key

Const VK_OEM_2 = &HBF ' dec = 191, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the /? key

Const VK_OEM_3 = &HC0 ' dec = 192, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the `~ key

'??? = &HC1-DA ' dec = 193-218, Reserved

Const VK_OEM_4 = &HDB ' dec = 219, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the [{ key

Const VK_OEM_5 = &HDC ' dec = 220, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the \\| key

Const VK_OEM_6 = &HDD ' dec = 221, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the ]} key

Const VK_OEM_7 = &HDE ' dec = 222, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the '" key

Const VK_OEM_8 = &HDF ' dec = 223, Used for miscellaneous characters; it can vary by keyboard.

'??? = &HE0 ' dec = 224, Reserved

'??? = &HE1 ' dec = 225, OEM specific

Const VK_OEM_102 = &HE2 ' dec = 226, The <> keys on the US standard keyboard, or the \\| key on the non-US 102-key keyboard

'??? = &HE3-E4 ' dec = 227-228, OEM specific

Const VK_PROCESSKEY = &HE5 ' dec = 229, IME PROCESS key

'??? = &HE6 ' dec = 230, OEM specific

Const VK_PACKET = &HE7 ' dec = 231, Used to pass Unicode characters as if they were keystrokes. The VK_PACKET key is the low word of a 32-bit Virtual Key value used for non-keyboard input methods. For more information, see Remark in KEYBDINPUT, SendInput, WM_KEYDOWN, and WM_KEYUP

'??? = &HE8 ' dec = 232, Unassigned

'??? = &HE9-F5 ' dec = 233-245, OEM specific

Const VK_ATTN = &HF6 ' dec = 246, Attn key

Const VK_CRSEL = &HF7 ' dec = 247, CrSel key

Const VK_EXSEL = &HF8 ' dec = 248, ExSel key

Const VK_EREOF = &HF9 ' dec = 249, Erase EOF key

Const VK_PLAY = &HFA ' dec = 250, Play key

Const VK_ZOOM = &HFB ' dec = 251, Zoom key

Const VK_NONAME = &HFC ' dec = 252, Reserved

Const VK_PA1 = &HFD ' dec = 253, PA1 key

Const VK_OEM_CLEAR = &HFE ' dec = 254, Clear key

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' END Virtual-Key Codes

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' Messages a window receives through or sends from its WindowProc function:

' DefWindowProcA function (winuser.h)

' https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-defwindowproca

Const WM_APP = &H08000 ' dec=32768

Const WM_APPCOMMAND = &H0319 ' dec=793

Const WM_CHAR = &H0102 ' dec=258

Const WM_COMMAND = &H0111 ' dec=273

Const WM_DEADCHAR = &H0103 ' dec=259

Const WM_DESTROY = &H0002 ' dec=2

Const WM_INITDIALOG = &H0110 ' dec=272

Const WM_INPUT = &H00FF ' dec=255

Const WM_KEYDOWN = &H0100 ' dec=256

Const WM_KEYUP = &H0101 ' dec=257

Const WM_MOUSEMOVE = &H0200 ' dec=512

Const WM_NCACTIVATE = &H0086 ' dec=134

Const WM_NEXTDLGCTL = &H28 ' dec=40

Const WM_PAINT = &H000F ' dec=15

Const WM_SETICON = &H0080 ' dec=128

Const WM_SIZE = &H0005 ' dec=5

Const WM_SYSCHAR = &H0106 ' dec=262

Const WM_SYSDEADCHAR = &H0107 ' dec=263

Const WM_SYSKEYDOWN = &H0104 ' dec=260

Const WM_SYSKEYUP = &H0105 ' dec=261

Const WM_UNICHAR = &H0109 ' dec=265

' CONSTANTS USED FOR WINDOWS STYLES & FEATURES, SEE:

' Window Styles

' https://learn.microsoft.com/en-us/windows/win32/winmsg/window-styles

' Window Features

' https://learn.microsoft.com/en-us/windows/win32/winmsg/window-features

Const WS_CAPTION = &H00C00000 ' dec=12582912

Const WS_CHILD = &H40000000 ' dec=1073741824

Const WS_MAXIMIZEBOX = &H00010000 ' dec=65536

Const WS_MINIMIZEBOX = &H00020000 ' dec=131072

Const WS_OVERLAPPED = &H00000000 ' dec=0

Const WS_SYSMENU = &H00080000 ' dec=524288

Const WS_THICKFRAME = &H00040000 ' dec=262144

Const WS_VISIBLE = &H10000000 ' dec=268435456

Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX

' CONSTANTS USED BY MapVirtualKey FOR PARAMETER uMapType

' https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-mapvirtualkeya

Const MAPVK_VK_TO_VSC = 0 ' The uCode parameter is a virtual-key code and is translated into a scan code. If it is a virtual-key code that does not distinguish between left- and right-hand keys, the left-hand scan code is returned. If there is no translation, the function returns 0.

Const MAPVK_VSC_TO_VK = 1 ' The uCode parameter is a scan code and is translated into a virtual-key code that does not distinguish between left- and right-hand keys. If there is no translation, the function returns 0. Windows Vista and later: the high byte of the uCode value can contain either 0xe0 or 0xe1 to specify the extended scan code.

Const MAPVK_VK_TO_CHAR = 2 ' The uCode parameter is a virtual-key code and is translated into an unshifted character value in the low order word of the return value. Dead keys (diacritics) are indicated by setting the top bit of the return value. If there is no translation, the function returns 0. See Remarks.

Const MAPVK_VSC_TO_VK_EX = 3 ' The uCode parameter is a scan code and is translated into a virtual-key code that distinguishes between left- and right-hand keys. If there is no translation, the function returns 0. Windows Vista and later: the high byte of the uCode value can contain either 0xe0 or 0xe1 to specify the extended scan code.

Const MAPVK_VK_TO_VSC_EX = 4 ' Windows Vista and later: The uCode parameter is a virtual-key code and is translated into a scan code. If it is a virtual-key code that does not distinguish between left- and right-hand keys, the left-hand scan code is returned. If the scan code is an extended scan code, the high byte of the returned value will contain either 0xe0 or 0xe1 to specify the extended scan code. If there is no translation, the function returns 0.

' ================================================================================================================================================================

' END API CONSTANTS

' ================================================================================================================================================================

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN RAW INPUT TYPES

' FOR TYPE CONVERSION SEE: "QB64PE C Libraries" at:

' https://qb64phoenix.com/qb64wiki/index.php/C_Libraries

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWINPUTDEVICE structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevice

'typedef struct tagRAWINPUTDEVICE {

'  USHORT usUsagePage;

'  USHORT usUsage;

'  DWORD  dwFlags;

'  HWND   hwndTarget;

'} RAWINPUTDEVICE, *PRAWINPUTDEVICE, *LPRAWINPUTDEVICE;

' Spriggsy's version:

Type RAWINPUTDEVICE

    As Unsigned Integer usUsagePage, usUsage

    As Unsigned Long dwFlags

    As Offset hwndTarget

End Type

' ^^^ Should "Unsigned Integer" be "_UNSIGNED INTEGER"

'     and    "Unsigned Long" be "_UNSIGNED LONG"

'     and    "Offset" be "_OFFSET" like this?:

'

'TYPE RAWINPUTDEVICE

'    usUsagePage AS _UNSIGNED INTEGER ' WORD

'    usUsage     AS _UNSIGNED INTEGER ' WORD

'    dwFlags     AS _UNSIGNED LONG ' DWORD

'    hwndTarget  AS _OFFSET ' DWORD

'END TYPE

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWINPUTDEVICELIST structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevicelist

'typedef struct tagRAWINPUTDEVICELIST {

'  HANDLE hDevice;

'  DWORD  dwType;

'} RAWINPUTDEVICELIST, *PRAWINPUTDEVICELIST;

' Spriggsy's version:

Type RAWINPUTDEVICELIST

    As Offset hDevice

    As Unsigned Long dwType

    $If 64BIT Then

        As String * 4 alignment

    $End If

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'POINT structure (windef.h)

'https://learn.microsoft.com/en-us/windows/win32/api/windef/ns-windef-point

'typedef struct tagPOINT {

'  LONG x;

'  LONG y;

'} POINT, *PPOINT, *NPPOINT, *LPPOINT;

Type POINT

    As Long x, y

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'MSG structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-msg

'typedef struct tagMSG {

'  HWND   hwnd;

'  UINT   message;

'  WPARAM wParam;

'  LPARAM lParam;

'  DWORD  time;

'  POINT  pt;

'  DWORD  lPrivate;

'} MSG, *PMSG, *NPMSG, *LPMSG;

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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'WNDCLASSEXA structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-wndclassexa

'typedef struct WNDCLASSEXA {

'  UINT      cbSize;

'  UINT      style;

'  WNDPROC   lpfnWndProc;

'  int       cbClsExtra;

'  int       cbWndExtra;

'  HINSTANCE hInstance;

'  HICON     hIcon;

'  HCURSOR   hCursor;

'  HBRUSH    hbrBackground;

'  LPCSTR    lpszMenuName;

'  LPCSTR    lpszClassName;

'  HICON     hIconSm;

'} WNDCLASSEXA, *PWNDCLASSEXA, *NPWNDCLASSEXA, *LPWNDCLASSEXA;

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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RECT structure (windef.h)

'https://learn.microsoft.com/en-us/windows/win32/api/windef/ns-windef-rect

'typedef struct tagRECT {

'  LONG left;     Specifies the x-coordinate of the upper-left corner of the rectangle.

'  LONG top;      Specifies the y-coordinate of the upper-left corner of the rectangle.

'  LONG right;    Specifies the x-coordinate of the lower-right corner of the rectangle.

'  LONG bottom;   Specifies the y-coordinate of the lower-right corner of the rectangle.

'} RECT, *PRECT, *NPRECT, *LPRECT;

Type RECT

    As Long left, top, right, bottom

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'PAINTSTRUCT structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-paintstruct

'typedef struct tagPAINTSTRUCT {

'  HDC  hdc;

'  BOOL fErase;

'  RECT rcPaint;

'  BOOL fRestore;

'  BOOL fIncUpdate;

'  BYTE rgbReserved[32];

'} PAINTSTRUCT, *PPAINTSTRUCT, *NPPAINTSTRUCT, *LPPAINTSTRUCT;

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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWINPUTHEADER structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputheader

'typedef struct tagRAWINPUTHEADER {

'  DWORD  dwType;

'  DWORD  dwSize;

'  HANDLE hDevice;

'  WPARAM wParam;

'} RAWINPUTHEADER, *PRAWINPUTHEADER, *LPRAWINPUTHEADER;

' Spriggsy's version:

Type RAWINPUTHEADER

    As Unsigned Long dwType, dwSize

    As Offset hDevice

    As Unsigned Offset wParam

End Type

' ^^^ Doesn't match the types I expected, should it be these?:

'TYPE RAWINPUTHEADER

'    dwType  AS _UNSIGNED LONG ' DWORD

'    dwSize  AS _UNSIGNED LONG ' DWORD

'    hDevice AS _UNSIGNED LONG ' DWORD <- should this be _OFFSET ?

'    wParam  AS LONG

'END TYPE

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWMOUSE structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawmouse

'typedef struct tagRAWMOUSE {

'  USHORT usFlags;

'  union {

'    ULONG ulButtons;

'    struct {

'      USHORT usButtonFlags;

'      USHORT usButtonData;

'    } DUMMYSTRUCTNAME;

'  } DUMMYUNIONNAME2;

'  ULONG  ulRawButtons;

'  LONG   lLastX;

'  LONG   lLastY;

'  ULONG  ulExtraInformation;

'} RAWMOUSE, *PRAWMOUSE, *LPRAWMOUSE;

' Spriggsy's simplified version:

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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWKEYBOARD structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawkeyboard

'typedef struct tagRAWKEYBOARD {

'  USHORT MakeCode;

'  USHORT Flags;

'  USHORT Reserved;

'  USHORT VKey;

'  UINT   Message;

'  ULONG  ExtraInformation;

'} RAWKEYBOARD, *PRAWKEYBOARD, *LPRAWKEYBOARD;

Type RAWKEYBOARD

    MakeCode As _Unsigned Integer ' USHORT

    Flags As _Unsigned Integer ' USHORT

    Reserved As _Unsigned Integer ' USHORT

    VKey As _Unsigned Integer ' USHORT

    Message As _Unsigned Long ' UINT

    ExtraInformation As _Unsigned _Offset ' ULONG

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWINPUT structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinput

'typedef struct tagRAWINPUT {

'  RAWINPUTHEADER header;

'  union {

'    RAWMOUSE    mouse;

'    RAWKEYBOARD keyboard;

'    RAWHID      hid;

'  } data;

'} RAWINPUT, *PRAWINPUT, *LPRAWINPUT;

' Spriggsy's simplified version:

Type RAWINPUT

    As RAWINPUTHEADER header

    As RAWMOUSE mouse

    'As RAWKEYBOARD keyboard <- ADDING THIS CAUSES THE PROGRAM TO CRASH ON MOUSE INPUT

End Type

' Simplified copy for keyboard:

Type RAWINPUT_K

    As RAWINPUTHEADER header

    As RAWKEYBOARD keyboard

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RID_DEVICE_INFO_MOUSE structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_mouse

'typedef struct tagRID_DEVICE_INFO_MOUSE {

'  DWORD dwId;

'  DWORD dwNumberOfButtons;

'  DWORD dwSampleRate;

'  BOOL  fHasHorizontalWheel;

'} RID_DEVICE_INFO_MOUSE, *PRID_DEVICE_INFO_MOUSE;

Type RID_DEVICE_INFO_MOUSE

    dwId As _Unsigned Long

    dwNumberOfButtons As _Unsigned Long

    dwSampleRate As _Unsigned Long

    fHasHorizontalWheel As Integer

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RID_DEVICE_INFO_KEYBOARD structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_keyboard

'typedef struct tagRID_DEVICE_INFO_KEYBOARD {

'  DWORD dwType;

'  DWORD dwSubType;

'  DWORD dwKeyboardMode;

'  DWORD dwNumberOfFunctionKeys;

'  DWORD dwNumberOfIndicators;

'  DWORD dwNumberOfKeysTotal;

'} RID_DEVICE_INFO_KEYBOARD, *PRID_DEVICE_INFO_KEYBOARD;

Type RID_DEVICE_INFO_KEYBOARD

    dwType As _Unsigned Long ' DWORD

    dwSubType As _Unsigned Long ' DWORD

    dwKeyboardMode As _Unsigned Long ' DWORD

    dwNumberOfFunctionKeys As _Unsigned Long ' DWORD

    dwNumberOfIndicators As _Unsigned Long ' DWORD

    dwNumberOfKeysTotal As _Unsigned Long ' DWORD

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RID_DEVICE_INFO_HID structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_hid

'typedef struct tagRID_DEVICE_INFO_HID {

'  DWORD  dwVendorId;

'  DWORD  dwProductId;

'  DWORD  dwVersionNumber;

'  USHORT usUsagePage;

'  USHORT usUsage;

'} RID_DEVICE_INFO_HID, *PRID_DEVICE_INFO_HID;

Type RID_DEVICE_INFO_HID

    dwVendorId As _Unsigned Long ' DWORD

    dwProductId As _Unsigned Long ' DWORD

    dwVersionNumber As _Unsigned Long ' DWORD

    usUsagePage As _Unsigned Integer ' USHORT

    usUsage As _Unsigned Integer ' USHORT

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' NEEDS FIXING:

'RID_DEVICE_INFO structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info

'typedef struct tagRID_DEVICE_INFO {

'  DWORD cbSize;

'  DWORD dwType;

'  union {

'    RID_DEVICE_INFO_MOUSE    mouse;

'    RID_DEVICE_INFO_KEYBOARD keyboard;

'    RID_DEVICE_INFO_HID      hid;

'  } DUMMYUNIONNAME1;

'} RID_DEVICE_INFO, *PRID_DEVICE_INFO, *LPRID_DEVICE_INFO;

' ^^^ NOT SURE HOW TO DEFINE THIS, SHOULD IT BE SOMETHING LIKE THIS?:

'Type DUMMYUNIONNAME1

'    My_RID_DEVICE_INFO_MOUSE As _Offset ' pointer to VAR A1

'    My_RID_DEVICE_INFO_KEYBOARD As _Offset ' pointer to VAR A2

'    My_RID_DEVICE_INFO_HID As _Offset ' pointer to VAR A3

'End Type

'Type RID_DEVICE_INFO

'    cbSize As _Unsigned Long ' DWORD

'    dwType As _Unsigned Long ' DWORD

'    My_DUMMYUNIONNAME1 As _Offset ' pointer to DUMMYUNIONNAME1

'End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWHID structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawhid

'typedef struct tagRAWHID {

'  DWORD dwSizeHid;

'  DWORD dwCount;

'  BYTE  bRawData[1];

'} RAWHID, *PRAWHID, *LPRAWHID;

Type RAWHID

    dwSizeHid As _Unsigned Long ' DWORD

    dwCount As _Unsigned Long ' DWORD

    bRawData As _Unsigned _Byte ' bRawData[1] AS BYTE

End Type

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END RAW INPUT TYPES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN CUSTOM TYPES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' UDT TO HOLD THE INFO FOR EACH MOUSE (READ MICE SUB)

Type MouseInfoType

    ID As String ' player identifier or mouse device ID

    char As String ' cursor character

    '' ReadMiceMain, ReadMiceSub:

    'UpdateCount As Integer ' if this value changes we know a value changed

    ' ReadMiceMain:

    'OldUpdateCount As Integer ' if this value changes we know a value changed

    'x As Integer ' screen x position

    'y As Integer ' screen y position

    dx As Integer ' mouse x movement -1=left, 1=right, 0=none

    dy As Integer ' mouse y movement -1=up  , 1=down , 0=none

    px As Long ' pointer x position (hires) for absolute position of mouse from raw input api

    py As Long ' pointer y position (hires) for absolute position of mouse from raw input api

    ' Multimouse:

    pdx As Long ' mouse x movement (hires) can be greater than just -1 or +1

    pdy As Long ' mouse y movement (hires) can be greater than just -1 or +1

    wheel As Integer ' mouse wheel value

    'wheelOld As Integer ' old mouse wheel value

    LeftDown As Integer ' tracks left mouse button state, TRUE=down

    'LeftDownOld As Integer ' old left mouse button state, TRUE=down

    MiddleDown As Integer ' tracks middle mouse button state, TRUE=down

    'MiddleDownOld As Integer ' old middle mouse button state, TRUE=down

    RightDown As Integer ' tracks right mouse button state, TRUE=down

    'RightDownOld As Integer ' old right mouse button state, TRUE=down

End Type ' MouseInfoType

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END CUSTOM TYPES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN API DECLARATIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ================================================================================================================================================================

' BEGIN CustomType Library definitions

' ================================================================================================================================================================

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' FOR RAW INPUT API

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

Declare CustomType Library

    'DECLARE FUNCTION GetRawInputDeviceList LIB "USER32.DLL" ALIAS "GetRawInputDeviceList"( _

    '    BYREF pRawInputDeviceList AS RAWINPUTDEVICELIST, _

    '    BYREF puiNumDevices AS _UNSIGNED LONG, _

    '    BYVAL cbSize AS _UNSIGNED LONG _

    '    ) AS _UNSIGNED LONG

    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)

    'DECLARE FUNCTION RegisterRawInputDevices LIB "USER32.DLL" ALIAS "RegisterRawInputDevices"( _

    '    BYREF pRawInputDevices AS RAWINPUTDEVICE, _

    '    BYVAL uiNumDevices AS _UNSIGNED LONG, _

    '    BYVAL cbSize AS _UNSIGNED LONG _

    '    ) AS 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)

    'DECLARE FUNCTION GetRawInputData LIB "USER32.DLL" ALIAS "GetRawInputData"( _

    '    BYVAL hRawInput AS _UNSIGNED LONG, _

    '    BYVAL uiCommand AS _UNSIGNED LONG, _

    '    BYREF pData AS _OFFSET, _

    '    BYREF pcbSize AS _UNSIGNED LONG, _

    '    BYVAL cbSizeHeader AS _UNSIGNED LONG _

    '    ) AS _UNSIGNED LONG

    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)

    'DECLARE FUNCTION SendMessage LIB "USER32.DLL" ALIAS "SendMessageA"( _

    '    BYVAL hWnd AS _OFFSET, _

    '    BYVAL Msg AS _UNSIGNED LONG, _

    '    BYVAL wParam AS _UNSIGNED LONG, _

    '    BYVAL lParam AS LONG _

    '    ) 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)

    'Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

    Sub GetClientRect (ByVal hWnd As Offset, Byval lpRect As Offset)

    'Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

    Sub DrawText (ByVal hdc As Offset, Byval lpchText As Offset, Byval cchText As Long, Byval lprc As Offset, Byval format As Unsigned Long)

    'Public Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As 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 ' CustomType Library

' 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

' ================================================================================================================================================================

' END CustomType Library definitions

' ================================================================================================================================================================

' ================================================================================================================================================================

' BEGIN Library definitions

' ================================================================================================================================================================

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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' Needed for acquiring the hWnd of the window

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

Declare Library

    Function FindWindow& (ByVal ClassName As _Offset, WindowName$) ' To get hWnd handle

End Declare

' ================================================================================================================================================================

' END Library definitions

' ================================================================================================================================================================

' ================================================================================================================================================================

' BEGIN Dynamic Library definitions

' ================================================================================================================================================================

Declare Dynamic Library "user32"

    ' FOR CONTROLLING WINDOW ON TOP, ETC.:

    Function FindWindowA%& (ByVal lpClassName%&, Byval lpWindowName%&)

    Function SetWindowPos& (ByVal hWnd%&, Byval hWndInsertAfter%&, Byval X&, Byval Y&, Byval cx&, Byval cy&, Byval uFlags~&)

    Function GetForegroundWindow%&

    ' To make window invisible

    Function SetLayeredWindowAttributes& (ByVal hwnd As _Offset, Byval crKey As Long, Byval bAlpha As _Unsigned _Byte, Byval dwFlags As Long)

    Function GetWindowLong& Alias "GetWindowLongA" (ByVal hwnd As _Offset, Byval nIndex As Long)

    Function SetWindowLong& Alias "SetWindowLongA" (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)

End Declare

Declare Dynamic Library "kernel32"

    Function GetLastError~& ()

End Declare

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' To keep focus on window

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'Declare Dynamic Library "user32"

'    Sub ShowWindow (ByVal hWnd As _Offset, Byval nCmdShow As Long)

'End Declare

' ================================================================================================================================================================

' END Dynamic Library definitions

' ================================================================================================================================================================

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END API DECLARATIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN GLOBAL VARIABLES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' GLOBAL VARIABLES TO TRACK ERROR STATE

Dim Shared m_sError As String: m_sError = ""

Dim Shared m_sIncludeError As String: m_sIncludeError = ""

' 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)

Dim Shared m_sTriggerFile As String: m_sTriggerFile = m_ProgramPath$ + "ReadMiceSub.DELETE-TO-CLOSE"

Dim Shared m_sDebugFile As String: m_sDebugFile = m_ProgramPath$ + m_ProgramName$ + ".txt"

' RAW INPUT VARIABLES

Dim Shared rawinputdevices As String

Dim Shared hDlg As _Unsigned Long ' DWORD

' MOUSE VARIABLES

Dim Shared arrMouse(0 To 8) As MouseInfoType ' STORES INFO FOR EACH MOUSE

Dim Shared iMouseCount As Integer ' # OF MICE ATTACHED

Dim Shared iMinX As Long

Dim Shared iMaxX As Long

Dim Shared iMinY As Long

Dim Shared iMaxY As Long

' KEYBOARD VARIABLES

'Dim Shared arrKeyIndex(8) As String ' STORES KEYBOARD ID

'Dim Shared arrLastKeyDown(8) As Integer ' STORES LAST KEY PRESSED

'Dim Shared arrLastKeyUp(8) As Integer ' STORES LAST KEY RELEASED

'Dim Shared iKeyBoardCount As Integer ' # OF KEYBOARDS ATTACHED

Dim Shared iLastKeyDown As Integer

Dim Shared iLastKeyUp As Integer

' NETWORK VARIABLES

Dim Shared uintPort As _Unsigned Integer ' port

Dim Shared lngConn As Long ' c&

Dim Shared iData As Integer ' i

Dim Shared sOutput As String ' s$

' HANDLE FOR THE PROGRAM WINDOW

Dim Shared MyHwnd As _Offset ' _Integer64 hwnd%&

Dim Shared hwndMain As _Offset

' SCREEN SIZE

Dim Shared lngScreenWidth As Long

Dim Shared lngScreenHeight As Long

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END GLOBAL VARIABLES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' EXECUTION STARTS HERE!

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ENABLE / DISABLE DEBUG CONSOLE WINDOW

If cDebugEnabled = TRUE Then

    ' $Console

    ' _Delay 4

    ' _Console On

    ' _Echo "Started " + m_ProgramName$

    ' _Echo "Debugging on..."

End If

' INITIALIZE

iMinX = 0

iMaxX = 1024 '_DesktopWidth '3583

iMinY = 0

iMaxY = 768 '_DesktopHeight ' 8202

lngScreenWidth = 1024 ' _DESKTOPWIDTH

lngScreenHeight = 768 ' _DESKTOPHEIGHT

' START THE MAIN ROUTINE

main

' DEACTIVATE DEBUGGING WINDOW

If cDebugEnabled = TRUE Then

    ' _Console Off

End If

' EXIT PROGRAM

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

    Dim sPort As String

    Dim iLoop As Integer

    Dim in$

    Dim MyTime##

    ' MAKE SURE WE HAVE INPUT

    sPort = Command$(1)

    If Len(sPort) > 0 Then

        If IsNumber%(sPort) = TRUE Then

            ' OPEN CONNECTION

            uintPort = Val(sPort)

            lngConn = _OpenClient("tcp/ip:" + _Trim$(Str$(uintPort)) + ":localhost")

            Print lngConn

            ' INITIALIZE

            iMinX = 0

            iMaxX = 1024 '3583

            iMinY = 0

            iMaxY = 768 '8202

            ' ****************************************************************************************************************************************************************

            ' ****************************************************************************************************************************************************************

            ' SET UP WINDOW TO BE SAME SIZE AS, AND OVERLAPPED WITH HOST WINDOW

            ' ****************************************************************************************************************************************************************

            ' ****************************************************************************************************************************************************************

            ' 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?

            '' ATTEMPT FULLSCREEN <- NOT REALLY WORKING

            '_FULLSCREEN _STRETCH, _SMOOTH

            'IF _FULLSCREEN = 0 THEN _FULLSCREEN _OFF 'check that a full screen mode initialized

            ' MAXIMIZE WINDOW

            'DOESN'T WORK: $RESIZE:STRETCH

            'DOESN'T WORK: $RESIZE:SMOOTH

            ' TRY JUST SAVING THE DESKTOP SIZE AND USING THAT WHEN DOING A NEW SCREEN

            ' Use _DESKTOPWIDTH and _DESKTOPHEIGHT to find the current desktop resolution to place the program’s window.

            lngScreenWidth = 1024 '_DesktopWidth

            lngScreenHeight = 768 '_DesktopHeight

            '' CLICK ON SCREEN TO GIVE IT THE FOCUS

            ''_SCREENCLICK column%, row%[, button%]

            '_SCREENCLICK 0, 0

            ' CREATE TRIGGER FILE

            Open m_sTriggerFile For Output As #1

            Print #1, "Deleting this file will cause program " + m_ProgramName$ + " to stop running."

            Close #1

            ' WAIT UNTIL FILE IS CREATED

            ' (time out after 10 seconds)

            MyTime## = ExtendedTimer + 10

            Do

                If _FileExists(m_sTriggerFile) = TRUE Then Exit Do

            Loop Until Timer > MyTime##

            If _FileExists(m_sTriggerFile) = FALSE Then

                m_sError = "Trigger file not found: " + Chr$(34) + m_sTriggerFile + Chr$(34)

            End If

            If Len(m_sError) = 0 Then

                ' GET HANDLE TO THE PROGRAM WINDOW

                Do

                    MyHwnd = _WindowHandle

                Loop Until MyHwnd

                ' GIVE CONTROL TO THE EVENT-ORIENTED CODE

                System Val(Str$(WinMain))

            Else

                Print "ERROR: " + m_sError

            End If

        Else

            Print "Invalid non-numeric input " + Chr$(34) + sPort + Chr$(34) + ". Exiting."

        End If

    Else

        Print "No input. Exiting."

    End If

End Sub ' main

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END MAIN ROUTINES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN RAW INPUT FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' Runs first

Function WinMain~%& ()

    'Dim As Offset hwndMain

    Dim As Offset hInst

    Dim As Offset hWndTop

    Dim As MSG msg

    Dim As WNDCLASSEX wndclass

    Dim As String szMainWndClass

    Dim As String szWinTitle

    Dim As Unsigned Integer reg

    Dim sData As String

    Dim iKeyLoop As Integer

    Dim iKeyCode As Integer

    Dim iLoop As Integer

    Dim sResult As String

    'DEBUG: TRY FULL SCREEN <- PROGRAM CRASHES!

    '_FullScreen _SquarePixels

    hInst = GetModuleHandle(0)

    szMainWndClass = "WinTestWin" + 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

    ' INITIALIZE RAW INPUT

    InitRawInput

    If Len(m_sError) = 0 Then

        ' SET WINDOW SiZE + INITIALIZE WINDOW

        'Q: HOW CAN WE USE THE QB64PE PROGRAM'S WINDOW HANDLE e.g. _WindowHandle ?

        hwndMain = CreateWindowEx( _

            0, _

            MAKELPARAM(reg, 0), _

            Offset(szWinTitle), _

            WS_OVERLAPPEDWINDOW, _

            0, _

            0, _

            lngScreenWidth, _

            lngScreenHeight, _

            0, _

            0, _

            hInst, _

            0)

        ShowWindow hwndMain, SW_SHOW

        ' TURN SUB WINDOW INVISIBLE

        ''SetWindowOpacity MyHwnd, cInvisible

        'SetWindowOpacity hwndMain, cTransparent ' <- USE THIS FOR TESTING

        'SetWindowOpacity hwndMain, 50 ' <- USE THIS FOR TESTING

        SetWindowOpacity hwndMain, cInvisible

        ' KEEP WINDOW VISIBLE

        'DEBUG: SUBSTITUTE _WindowHandle

        'UpdateWindow _WindowHandle

        UpdateWindow hwndMain

        ' MOVE WINDOW TO TOP

        '' GET WINDOW HANDLES

        'hWndThis = _WindowHandle ' FindWindowA(0, _OFFSET(t))

        hWndTop = GetForegroundWindow%& ' find currently focused process handle

        ' GET FOCUS

        If hwndMain <> hWndTop Then

            _ScreenClick 240, 240 ' add 40 to x and y to focus on positioned window

        End If

        ' MOVE TO TOP

        'Function SetWindowPos& (ByVal hWnd%&, Byval hWndInsertAfter%&, Byval X&, Byval Y&, Byval cx&, Byval cy&, Byval uFlags~&)

        'If SetWindowPos(hwndMain, HWND_TOPMOST, 200, 200, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE) = 0 Then

        If SetWindowPos(hwndMain, HWND_TOPMOST, 0, 0, 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

        '' DEBUG

        'DebugLog ""

        'DebugLog "AFTER InitRawInput:"

        'For iLoop = LBound(arrMouse) To UBound(arrMouse)

        '   DebugLog "    arrMouse(" + _Trim$(Str$(iLoop)) + ").ID = " + chr$(34) + arrMouse(iLoop).ID + chr$(34)

        'Next iLoop

        'DebugLog ""

        ' IF EVERYTHING IS WORKING, CONTINUE

        If Len(m_sError) = 0 Then

            ' START THE INPUT ROUTINES

            InitInputVars

            '' DEBUG

            'DebugLog "AFTER InitInputVars:"

            'For iLoop = LBound(arrMouse) To UBound(arrMouse)

            '   DebugLog "    arrMouse(" + _Trim$(Str$(iLoop)) + ").ID = " + chr$(34) + arrMouse(iLoop).ID + chr$(34)

            'Next iLoop

            'DebugLog ""

            ' SEND SUB WINDOW HANDLE BACK TO MAIN

            _Delay 2

            sData = "w:" + _Trim$(Str$(hwndMain)) + Chr$(13)

            'If cDebugEnabled = TRUE Then

            '    DebugLog "Put #lngConn, , sData"

            '    DebugLog "Put #" + _Trim$(Str$(lngConn)) + ", , " + Chr$(34) + sData + Chr$(34)

            'End If

            _Delay 2

            Put #lngConn, , sData

            _Delay 2

            ' MAIN PROGRAM LOOP

            While GetMessage(Offset(msg), 0, 0, 0)

                TranslateMessage Offset(msg)

                DispatchMessage Offset(msg)

                ' QUIT IF TRIGGER FILE IS GONE

                If _FileExists(m_sTriggerFile) = FALSE Then

                    System

                End If

                ' KEEP WINDOW ON TOP

                If _WindowHasFocus = 0 Then

                    _ScreenIcon

                    ''ShowWindow MyHwnd, 1

                    'ShowWindow hwndMain, 1

                    ShowWindow hwndMain, SW_SHOW

                End If

            Wend

        Else

            'If cDebugEnabled = TRUE Then

            '    DebugLog "Error, can't return hwndMain: " + m_sError

            'End If

        End If

    End If

    ' SEND ANY ERROR MESSAGES BACK TO MAIN

    If Len(m_sError) > 0 Then

        _Delay 2

        sData = "e:" + m_sError + Chr$(13)

        Put #lngConn, , sData

        _Delay 2

        ' SHOW EROR MESSAGE

        If cDebugEnabled Then

            Screen 0

            Cls

            Print "Error:"

            Print m_sError

            Sleep

        End If

    End If

    ' RETURN A VALUE

    WinMain = msg.wParam

End Function ' WinMain

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

' Handles main window events

' MESSAGE TYPES FOR READING THE KEYBOARD:

' WM_CHAR

' WM_KEYDOWN

' WM_KEYUP

' WM_SYSCHAR

' WM_SYSKEYDOWN

' WM_SYSKEYUP

Function MainWndProc%& (hwnd As Offset, nMsg As Unsigned Long, wParam As Unsigned Offset, lParam As Offset)

    ' EVENT HANDLER VARIABLES PART 1

    Static As Offset hwndButton

    Static As Long cx, cy

    Dim As Offset hdc

    Dim As PAINTSTRUCT ps

    Dim As RECT rc

    Dim As RECT TargetRect

    Dim As MEM lpb

    Dim As Unsigned Long dwSize

    Dim As RAWINPUT rawm ' MOUSE VERSION

    Dim As RAWINPUT_K rawk ' KEYBOARD VERSION

    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 iLine As Integer

    Dim iLen As Integer

    Dim iCount As Integer

    Dim sCount As String

    Dim sText As String

    Dim sX As String

    Dim sY As String

    Dim sPX As String

    Dim sPY 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

    Dim iInputType As Integer

    ' EVENT HANDLER VARIABLES PART 2

    Dim pRawInput As _Offset ' RAWINPUT POINTER

    Dim zKeyName As String ' ASCIIZ * 50 = NULL-terminated string

    Dim sRawInput As String

    Dim sBuffer As String

    Dim ScanCode As _Unsigned Long ' DWORD

    Static hFocusBak As _Unsigned Long ' DWORD

    Dim RawInputDevCount As Long

    Dim KeyboardTypeCount As Long

    Dim RawInputDeviceIndex As Long

    Dim ByteCount As Long

    Dim int_wParam As Integer

    Dim vbCrLf As String: vbCrLf = Chr$(13) + Chr$(10)

    Dim vbCr As String: vbCr = Chr$(13)

    Dim vbLf As String: vbLf = Chr$(10)

    ReDim arrText$(0)

    ' HANDLE EVENT MESSAGES

    Select Case nMsg

        Case WM_DESTROY:

            'DebugPrint "nMsg = WM_DESTROY"

            PostQuitMessage 0

            MainWndProc = 0

            Exit Function

        Case WM_INPUT:

            'DebugPrint "nMsg = WM_INPUT"

            ' MOUSE VERSION:

            GetRawInputData lParam, RID_INPUT, 0, Offset(dwSize), Len(rih)

            ' KEYBOARD VERSION:

            'GetRawInputData(CBLPARAM, %RID_INPUT, BYVAL %NULL, ByteCount, SIZEOF(RAWINPUTHEADER)) ' Get size of raw input buffer

            lpb = MemNew(dwSize)

            If lpb.SIZE = 0 Then

                MainWndProc = 0

                Exit Function

            End If

            ' GET THE RAW INPUT

            If GetRawInputData(lParam, RID_INPUT, lpb.OFFSET, Offset(dwSize), Len(rih)) <> dwSize Then

                'TODO: BUBBLE UP THE ERROR MESSAGE?

                Print "GetRawInputData doesn't return correct size!"

                'DebugPrint "WRONG SIZE: GetRawInputData doesn't return correct size!"

            End If

            ' IDENTIFY TYPE OF INPUT

            Select Case dwSize

                Case Len(rawm):

                    ' MOUSE INPUT

                    'DebugPrint "dwSize = Len(rawm) so MOUSE INPUT DETECTED"

                    iInputType = RIM_TYPEMOUSE

                    MemGet lpb, lpb.OFFSET, rawm

                Case Len(rawk):

                    ' KEYBOARD INPUT

                    'DebugPrint "dwSize = Len(rawk) so KEYBOARD INPUT DETECTED"

                    iInputType = RIM_TYPEKEYBOARD

                    MemGet lpb, lpb.OFFSET, rawk

                Case Else:

                    ' SOME OTHER TYPE (MAYBE HID) BUT ONE WE CAN'T PROCESS

                    'DebugPrint "dwSize = SOME OTHER TYPE (MAYBE HID)"

                    iInputType = RIM_TYPEUNKNOWN

            End Select

            If iInputType = RIM_TYPEMOUSE Then

                'DebugLog "iInputType = RIM_TYPEMOUSE"

                If rawm.header.dwType = RIM_TYPEMOUSE Then

                    'DebugLog "    rawm.header.dwType = RIM_TYPEMOUSE"

                    tmpx = rawm.mouse.lLastX

                    tmpy = rawm.mouse.lLastY

                    maxx = tmpx

                    ' UPDATE RANGE OF MOUSE COORDINATES

                    If GET_X_LPARAM(lParam) < iMinX Then iMinX = GET_X_LPARAM(lParam)

                    If GET_X_LPARAM(lParam) > iMaxX Then iMaxX = GET_X_LPARAM(lParam)

                    If GET_Y_LPARAM(lParam) < iMinY Then iMinY = GET_Y_LPARAM(lParam)

                    If GET_Y_LPARAM(lParam) > iMaxY Then iMaxY = GET_Y_LPARAM(lParam)

                    ' IDENTIFY WHICH MOUSE IT IS

                    strNextID = _Trim$(Str$(rawm.header.hDevice))

                    'DebugPrint "    strNextID = " + Chr$(34) + strNextID + Chr$(34)

                    'DebugLog "        strNextID = " + Chr$(34) + strNextID + Chr$(34)

                    ' GET ARRAY INDEX FROM strnextID

                    iIndex = GetMouseIndex%(strNextID)

                    'DebugPrint "    iIndex =  GetMouseIndex%(" + chr$(34) + strNextID + chr$(34) + ") = " + _Trim$(Str$(iIndex))

                    'DebugLog "    iIndex =  GetMouseIndex%(" + chr$(34) + strNextID + chr$(34) + ") = " + _Trim$(Str$(iIndex))

                    ' DETECT INPUT

                    If iIndex >= LBound(arrMouse) Then

                        'DebugLog "            iIndex >= LBound(arrMouse)"

                        If iIndex <= UBound(arrMouse) Then

                            'DebugLog "                iIndex <= UBound(arrMouse)"

                            'DebugLog "                    iIndex = " + _Trim$(Str$(iIndex))

                            ' INCREMENT/DECREMENT FIXED DELTA X

                            If rawm.mouse.lLastX < 0 Then

                                arrMouse(iIndex).dx = -1

                                'arrMouse(iIndex).x = arrMouse(iIndex).x - 1

                            ElseIf rawm.mouse.lLastX > 0 Then

                                arrMouse(iIndex).dx = 1

                                'arrMouse(iIndex).x = arrMouse(iIndex).x + 1

                            End If

                            'DebugLog "                    arrMouse(iIndex).dx = " + _Trim$(Str$(arrMouse(iIndex).dx))

                            ' INCREMENT/DECREMENT FIXED DELTA Y

                            If rawm.mouse.lLastY < 0 Then

                                arrMouse(iIndex).dy = -1

                                'arrMouse(iIndex).y = arrMouse(iIndex).y - 1

                            ElseIf rawm.mouse.lLastY > 0 Then

                                arrMouse(iIndex).dy = 1

                                'arrMouse(iIndex).y = arrMouse(iIndex).y + 1

                            End If

                            'DebugLog "                    arrMouse(iIndex).dy = " + _Trim$(Str$(arrMouse(iIndex).dy))

                            ' INCREMENT/DECREMENT TRUE DELTA

                            arrMouse(iIndex).pdx = rawm.mouse.lLastX

                            arrMouse(iIndex).pdy = rawm.mouse.lLastY

                            arrMouse(iIndex).px = arrMouse(iIndex).px + arrMouse(iIndex).pdx

                            arrMouse(iIndex).py = arrMouse(iIndex).py + arrMouse(iIndex).pdy

                            ' CHECK HIRES CURSOR BOUNDARIES

                            If arrMouse(iIndex).px < cMinPX Then arrMouse(iIndex).px = cMinPX

                            If arrMouse(iIndex).px > cMaxPX Then arrMouse(iIndex).px = cMaxPX

                            If arrMouse(iIndex).py < cMinPY Then arrMouse(iIndex).py = cMinPY

                            If arrMouse(iIndex).py > cMaxPY Then arrMouse(iIndex).py = cMaxPY

                            'DebugLog "                    arrMouse(iIndex).px = " + _Trim$(Str$(arrMouse(iIndex).px))

                            'DebugLog "                    arrMouse(iIndex).py = " + _Trim$(Str$(arrMouse(iIndex).py))

                            ' =============================================================================

                            ' left button = 1 when down, 2 when released

                            If ((rawm.mouse.usButtonFlags And 1) = 1) Then

                                arrMouse(iIndex).LeftDown = TRUE

                            ElseIf ((rawm.mouse.usButtonFlags And 2) = 2) Then

                                arrMouse(iIndex).LeftDown = FALSE

                            End If

                            'DebugLog "                    arrMouse(iIndex).LeftDown = " + TrueFalse$(arrMouse(iIndex).LeftDown)

                            ' =============================================================================

                            ' middle button = 16 when down, 32 when released

                            If ((rawm.mouse.usButtonFlags And 16) = 16) Then

                                arrMouse(iIndex).MiddleDown = TRUE

                            ElseIf ((rawm.mouse.usButtonFlags And 32) = 32) Then

                                arrMouse(iIndex).MiddleDown = FALSE

                            End If

                            'DebugLog "                    arrMouse(iIndex).MiddleDown = " + TrueFalse$(arrMouse(iIndex).MiddleDown)

                            ' =============================================================================

                            ' right button = 4 when down, 8 when released

                            If ((rawm.mouse.usButtonFlags And 4) = 4) Then

                                arrMouse(iIndex).RightDown = TRUE

                            ElseIf ((rawm.mouse.usButtonFlags And 8) = 8) Then

                                arrMouse(iIndex).RightDown = FALSE

                            End If

                            'DebugLog "                    arrMouse(iIndex).RightDown = " + TrueFalse$(arrMouse(iIndex).RightDown)

                            ' =============================================================================

                            ' scroll wheel = ???

                            'Hex$(rawm.mouse.usButtonFlags)

                            '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

                            ' COLLECT VALUES FOR THIS MOUSE TO SEND

                            ' IN THE FOLOWING TAB-DELIMITED FORMAT:

                            ' {mouse #}\t{dx}\t{dy}\t{wheel}\t{leftDown}\t{middleDown}\t{rightDown}\n

                            sOutput = "m:"

                            sOutput = sOutput + _Trim$(Str$(iIndex)) + Chr$(9)

                            'sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).UpdateCount)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).dx)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).dy)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).px)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).py)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).wheel)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).LeftDown)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).MiddleDown)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).RightDown)) + Chr$(13)

                            ' SEND VALUES FOR THIS MOUSE TO HOST

                            'DebugLog "                    Put #lngConn, , sOutput"

                            'DebugLog "                    Put #" + _Trim$(Str$(lngConn)) + ", , " + chr$(34) + sOutput + chr$(34)

                            Put #lngConn, , sOutput

                            'DebugLog "                    m_sError = " + chr$(34) + m_sError + chr$(34)

                            ' CLEAR MOVEMENT

                            arrMouse(iIndex).dx = 0

                            arrMouse(iIndex).dy = 0

                            'arrMouse(iIndex).wheelOld = arrMouse(iIndex).wheel

                            'arrMouse(iIndex).LeftDownOld = arrMouse(iIndex).LeftDown

                            'arrMouse(iIndex).MiddleDownOld = arrMouse(iIndex).MiddleDown

                            'arrMouse(iIndex).RightDownOld = arrMouse(iIndex).RightDown

                        End If

                    End If

                    '' INVOKE PAINT

                    'InvalidateRect hwnd, 0, -1

                    'SendMessage hwnd, WM_PAINT, 0, 0

                End If

            ElseIf iInputType = RIM_TYPEKEYBOARD Then

                ' *** FOR NOW RAW KEYBOARD INPUT NOT WORKING

                'DebugPrint "iInputType = RIM_TYPEKEYBOARD"

                'If rawk.header.dwType = RIM_TYPEKEYBOARD Then

                '    DebugPrint "* FOUND RAW INPUT KEYBOARD *"

                '

                '    ' HOW DO WE READ THE KEYBOARD USING RawInputAPI ???

                '    DebugPrint "rawk.header.dwType = RIM_TYPEKEYBOARD"

                '

                '    ' IDENTIFY WHICH KEYBOARD IT IS

                '    strNextID = _Trim$(Str$(rawk.header.hDevice))

                '    DebugPrint "    strNextID = " + Chr$(34) + strNextID + Chr$(34)

                '

                '    '' GET ARRAY INDEX FROM strnextID

                '    'iIndex = GetKeyboardIndex%(strNextID)

                '    'DebugPrint "    iIndex = " + _Trim$(Str$(iIndex))

                '

                'End If

            End If

            ' FINISHUP WM_INPUT

            MemFree lpb

            MainWndProc = 0

            Exit Function

        Case WM_MOUSEMOVE:

            'DebugPrint "nMsg = WM_MOUSEMOVE"

            Exit Function

        Case WM_PAINT:

            'DebugPrint "nMsg = WM_PAINT"

            'hdc = BeginPaint(hwnd, Offset(ps))

            'GetClientRect hwnd, Offset(rc)

            '

            '' -----------------------------------------------------------------------------

            '' DISPLAY MOUSE INFO ON SCREEN AT MOUSE POSITIONS

            'iCount = 0

            'For iIndex = LBound(arrMouse) To UBound(arrMouse)

            '    iCount = iCount + 1

            '

            '    If Len(arrMouse(iIndex).ID) > 0 Then

            '        ' CHECK CURSOR BOUNDARIES

            '        If arrMouse(iIndex).x < cMinX Then arrMouse(iIndex).x = cMinX

            '        If arrMouse(iIndex).x > cMaxX Then arrMouse(iIndex).x = cMaxX

            '        If arrMouse(iIndex).y < cMinY Then arrMouse(iIndex).y = cMinY

            '        If arrMouse(iIndex).y > cMaxY Then arrMouse(iIndex).y = cMaxY

            '

            '        ' CHECK HIRES CURSOR BOUNDARIES

            '        If arrMouse(iIndex).px < cMinPX Then arrMouse(iIndex).px = cMinPX

            '        If arrMouse(iIndex).px > cMaxPX Then arrMouse(iIndex).px = cMaxPX

            '        If arrMouse(iIndex).py < cMinPY Then arrMouse(iIndex).py = cMinPY

            '        If arrMouse(iIndex).py > cMaxPY Then arrMouse(iIndex).py = cMaxPY

            '

            '        ' DEFINE TARGET RECT FOR WHERE TO DRAW ON SCREEN

            '        TargetRect.left = rc.left + arrMouse(iIndex).px

            '        TargetRect.top = rc.top + arrMouse(iIndex).py

            '        TargetRect.right = rc.right + arrMouse(iIndex).px

            '        TargetRect.bottom = rc.bottom + arrMouse(iIndex).py

            '

            '        ' COLLECT VALUES FOR THIS MOUSE IN A STRING

            '        sText = ""

            '        sText = sText + _Trim$(Str$(iCount))

            '        sText = sText + " ("

            '        sText = sText + _Trim$(Str$(arrMouse(iIndex).px))

            '        sText = sText + ","

            '        sText = sText + _Trim$(Str$(arrMouse(iIndex).py))

            '        sText = sText + ") "

            '        sText = sText + IIFS$(arrMouse(iIndex).LeftDown, "1", " ")

            '        sText = sText + IIFS$(arrMouse(iIndex).MiddleDown, "2", " ")

            '        sText = sText + IIFS$(arrMouse(iIndex).RightDown, "3", " ")

            '

            '        'arrMouse(iIndex).wheel

            '        'arrMouse(iIndex).char

            '        'arrMouse(iIndex).y

            '        'arrMouse(iIndex).x

            '

            '        ' DRAW VALUES FOR THIS MOUSE TO SCREEN AT POINTER POSITION

            '        DrawText hdc, Offset(sText), Len(sText), Offset(TargetRect), DT_LEFT

            '        OffsetRect Offset(TargetRect), arrMouse(iIndex).px, arrMouse(iIndex).px

            '    End If

            'Next iIndex

            '

            '' -----------------------------------------------------------------------------

            '' DISPLAY INSTRUCTIONS ON SCREEN

            '' DEFINE TARGET RECT FOR WHERE TO DRAW ON SCREEN

            'TargetRect.left = rc.left + 100

            'TargetRect.top = rc.top + 500

            'TargetRect.right = rc.right + 100

            'TargetRect.bottom = rc.bottom + 500

            '

            '' COLLECT VALUES FOR THIS KEYBOARD IN A STRING

            'sText = ""

            'sText = sText + "Raw Input API multi-mouse demo:"

            'sText = sText + Chr$(13)

            'sText = sText + Chr$(13)

            'sText = sText + "1. Plug in 2 or more USB mice"

            'sText = sText + Chr$(13)

            'sText = sText + "2. Move them around and click the buttons."

            'sText = sText + Chr$(13)

            'sText = sText + "3. Try pressing some keys on the keyboard."

            'sText = sText + Chr$(13)

            'sText = sText + Chr$(13)

            'sText = sText + "Press ESC to exit."

            '

            '' DRAW VALUES FOR THIS KEYBOARD TO SCREEN AT NEXT POSITION

            'DrawText hdc, Offset(sText), Len(sText), Offset(TargetRect), DT_LEFT

            'OffsetRect Offset(TargetRect), 0, 0 ' y,x

            '

            '' -----------------------------------------------------------------------------

            '' DISPLAY KEYBOARD INFO ON SCREEN

            '' DEFINE TARGET RECT FOR WHERE TO DRAW ON SCREEN

            'TargetRect.left = rc.left + 400

            'TargetRect.top = rc.top + 100

            'TargetRect.right = rc.right + 400

            'TargetRect.bottom = rc.bottom + 100

            '

            '' COLLECT VALUES FOR THIS KEYBOARD IN A STRING

            'sText = ""

            'sText = sText + "Keyboard: "

            'sText = sText + IIFS$(iLastKeyDown > 0, VirtualKeyCodeToString$(iLastKeyDown) + " (" + _Trim$(Str$(iLastKeyDown)) + ")", "")

            ''sText = sText + Chr$(13)

            ''sText = sText + "  LAST DOWN="

            ''sText = sText + IIFS$(iLastKeyDown > 0, VirtualKeyCodeToString$(iLastKeyDown), "")

            ''sText = sText + Chr$(13)

            ''sText = sText + "  LAST UP  ="

            ''sText = sText + IIFS$(iLastKeyUp > 0, VirtualKeyCodeToString$(iLastKeyUp), "")

            '

            '' DRAW VALUES FOR THIS KEYBOARD TO SCREEN AT NEXT POSITION

            'DrawText hdc, Offset(sText), Len(sText), Offset(TargetRect), DT_LEFT

            'OffsetRect Offset(TargetRect), 0, 0 ' y,x

            '

            '' -----------------------------------------------------------------------------

            '' FINISH PAINT

            'EndPaint hwnd, Offset(ps)

            '

            MainWndProc = 0

            Exit Function

        Case WM_CHAR:

            'DebugPrint "nMsg = WM_CHAR"

            '' GET AN INTEGER FROM WPARAM

            'If wParam < 32768 Then

            '    int_wParam = Val(_Trim$(Str$(wParam)))

            'Else

            '    int_wParam = -1

            'End If

            '

            '' WM_CHAR message

            '' https://learn.microsoft.com/en-us/windows/win32/inputdev/wm-char

            '' Posted to the window with the keyboard focus when a WM_KEYDOWN message is translated by the TranslateMessage function. The WM_CHAR message contains the character code of the key that was pressed.

            'DebugPrint "nMsg = WM_CHAR"

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            '

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            'MainWndProc = 0

            Exit Function

        Case WM_KEYDOWN:

            'DebugPrint "nMsg = WM_KEYDOWN"

            ' GET AN INTEGER FROM WPARAM

            If wParam < 32768 Then

                int_wParam = Val(_Trim$(Str$(wParam)))

            Else

                int_wParam = -1

            End If

            ' REMEMBER KEY

            iLastKeyDown = int_wParam

            ' WM_KEYDOWN message

            ' Posted to the window with the keyboard focus when a nonsystem key is pressed. A nonsystem key is a key that is pressed when the ALT key is not pressed.

            ' https://learn.microsoft.com/en-us/windows/win32/inputdev/wm-keydown

            'DebugPrint "nMsg = WM_KEYDOWN"

            'DebugPrint "    strNextID  =" + Chr$(34) + strNextID + Chr$(34)

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            ' SEND KEYDOWN EVENT TO HOST

            sOutput = "d:" + _Trim$(Str$(int_wParam)) + Chr$(13)

            Put #lngConn, , sOutput

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            MainWndProc = 0

            Exit Function

        Case WM_KEYUP:

            'DebugPrint "nMsg = WM_KEYUP"

            ' GET AN INTEGER FROM WPARAM

            If wParam < 32768 Then

                int_wParam = Val(_Trim$(Str$(wParam)))

            Else

                int_wParam = -1

            End If

            ' REMEMBER KEY

            iLastKeyUp = int_wParam

            iLastKeyDown = 0

            ' WM_KEYUP message

            ' https://learn.microsoft.com/en-us/windows/win32/inputdev/wm-keyup

            ' Posted to the window with the keyboard focus when a nonsystem key is released. A nonsystem key is a key that is pressed when the ALT key is not pressed, or a keyboard key that is pressed when a window has the keyboard focus.

            'DebugPrint "nMsg = WM_KEYUP"

            'DebugPrint "    strNextID  =" + Chr$(34) + strNextID + Chr$(34)

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            ' SEND KEYUP EVENT TO HOST

            sOutput = "u:" + _Trim$(Str$(int_wParam)) + Chr$(13)

            Put #lngConn, , sOutput

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            MainWndProc = 0

            '' EXIT WHEN USER RELEASES ESCAPE KEY

            'If int_wParam = 27 Then System

            Exit Function

        Case WM_SYSCHAR:

            'DebugPrint "nMsg = WM_SYSCHAR"

            '' GET AN INTEGER FROM WPARAM

            'If wParam < 32768 Then

            '    int_wParam = Val(_Trim$(Str$(wParam)))

            'Else

            '    int_wParam = -1

            'End If

            '

            '' WM_SYSCHAR message

            '' https://learn.microsoft.com/en-us/windows/win32/menurc/wm-syschar

            '' Posted to the window with the keyboard focus when a WM_SYSKEYDOWN message is translated by the TranslateMessage function. It specifies the character code of a system character key that is, a character key that is pressed while the ALT key is down.

            'DebugPrint "nMsg = WM_SYSCHAR"

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            '

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            'MainWndProc = 0

            Exit Function

        Case WM_SYSKEYDOWN:

            'DebugPrint "nMsg = WM_SYSKEYDOWN"

            ' GET AN INTEGER FROM WPARAM

            If wParam < 32768 Then

                int_wParam = Val(_Trim$(Str$(wParam)))

            Else

                int_wParam = -1

            End If

            ' REMEMBER KEY

            iLastKeyDown = int_wParam

            ' WM_SYSKEYDOWN message

            ' https://learn.microsoft.com/en-us/windows/win32/inputdev/wm-syskeydown

            ' Posted to the window with the keyboard focus when the user presses the F10 key (which activates the menu bar) or holds down the ALT key and then presses another key. It also occurs when no window currently has the keyboard focus; in this case, the WM_SYSKEYDOWN message is sent to the active window. The window that receives the message can distinguish between these two contexts by checking the context code in the lParam parameter.

            'DebugPrint "nMsg = WM_SYSKEYDOWN"

            'DebugPrint "    strNextID  =" + Chr$(34) + strNextID + Chr$(34)

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            ' SEND KEYDOWN EVENT TO HOST

            sOutput = "d:" + _Trim$(Str$(int_wParam)) + Chr$(13)

            Put #lngConn, , sOutput

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            MainWndProc = 0

            Exit Function

        Case WM_SYSKEYUP:

            'DebugPrint "nMsg = WM_SYSKEYUP"

            ' GET AN INTEGER FROM WPARAM

            If wParam < 32768 Then

                int_wParam = Val(_Trim$(Str$(wParam)))

            Else

                int_wParam = -1

            End If

            ' REMEMBER KEY

            iLastKeyUp = int_wParam

            iLastKeyDown = 0

            ' WM_SYSKEYUP message

            ' https://learn.microsoft.com/en-us/windows/win32/inputdev/wm-syskeyup

            ' Posted to the window with the keyboard focus when the user releases a key that was pressed while the ALT key was held down. It also occurs when no window currently has the keyboard focus; in this case, the WM_SYSKEYUP message is sent to the active window. The window that receives the message can distinguish between these two contexts by checking the context code in the lParam parameter.

            ' A window receives this message through its WindowProc function.

            'DebugPrint "nMsg = WM_SYSKEYUP"

            'DebugPrint "    strNextID  =" + Chr$(34) + strNextID + Chr$(34)

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            ' SEND KEYUP EVENT TO HOST

            sOutput = "u:" + _Trim$(Str$(int_wParam)) + Chr$(13)

            Put #lngConn, , sOutput

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            MainWndProc = 0

            Exit Function

        Case Else:

            ' some other message

            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 iLoop2 As Integer

    Dim strNextID As String

    If GetRawInputDeviceList(0, Offset(nDevices), Len(RawInputDeviceList)) <> 0 Then

        Exit Sub

    End If

    pRawInputDeviceList = MemNew(Len(RawInputDeviceList) * nDevices)

    GetRawInputDeviceList pRawInputDeviceList.OFFSET, Offset(nDevices), Len(RawInputDeviceList)

    ' This small block of commented code proves that we've got the device list

    ReDim As RAWINPUTDEVICELIST rawdevs(0 To nDevices - 1)

    MemGet pRawInputDeviceList, pRawInputDeviceList.OFFSET, rawdevs()

    ' GET DEVICE INFO

    rawinputdevices = "Number of raw input devices:" + Str$(nDevices) + Chr$(13)

    iMouseCount = 0

    'iKeyBoardCount = 0

    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 = RIM_TYPEMOUSE Then

            iMouseCount = iMouseCount + 1 ' INCREMENT THE MOUSE COUNT

            strNextID = _Trim$(Str$(rawdevs(x).hDevice)) ' GET THE MOUSE DEVICE ID

            arrMouse(iMouseCount - 1).ID = strNextID ' SAVE THE MOUSE DEVICE ID

            'arrMouse(iMouseCount - 1).UpdateCount = 0

        ElseIf rawdevs(x).dwType = RIM_TYPEKEYBOARD Then

            'iKeyBoardCount = iKeyBoardCount + 1 ' INCREMENT THE KEYBAORD COUNT

            'strNextID = _Trim$(Str$(rawdevs(x).hDevice)) ' GET THE KEYBOARD DEVICE ID

            'arrKeyIndex(iKeyBoardCount - 1) = strNextID ' SAVE THE KEYBOARD DEVICE ID

            'arrLastKeyDown(iKeyBoardCount - 1) = 0

        End If

    Next x

    ' FOR NOW KEYBOARD INFO IS NOT RAW INPUT, UNTIL WE FIGURE IT OUT:

    iLastKeyDown = 0

    iLastKeyUp = 0

    rawinputdevices = rawinputdevices + Chr$(0)

    MemFree pRawInputDeviceList

    Rid(0).usUsagePage = &H01

    Rid(0).usUsage = &H02

    Rid(0).dwFlags = 0

    Rid(0).hwndTarget = 0

    If RegisterRawInputDevices(Offset(Rid()), 1, Len(Rid(0))) = 0 Then

        m_sError = "RawInput init failed" + Chr$(0)

    End If

End Sub ' InitRawInput

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END RAW INPUT FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN WINDOW FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' hWnd = handle to window to set opacity for

' Level = 0 TO 255, 0=totally invisible, 128=transparent, 255=100% solid

Sub SetWindowOpacity (hWnd As _Offset, Level As _Unsigned _Byte)

    Const cIndex = -20

    Const LWA_ALPHA = &H2

    Const WS_EX_LAYERED = &H80000

    Dim lngMsg As Long

    Dim lngValue As Long

    'Function GetWindowLong& Alias "GetWindowLongA" (ByVal hwnd As _Offset, Byval nIndex As Long)

    lngMsg = GetWindowLong(hWnd, cIndex)

    lngMsg = lngMsg Or WS_EX_LAYERED

    'Function SetWindowLong& Alias "SetWindowLongA" (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)

    lngValue = SetWindowLong(hWnd, cIndex, lngMsg)

    'Function SetLayeredWindowAttributes& (ByVal hwnd As _Offset, Byval crKey As Long, Byval bAlpha As _Unsigned _Byte, Byval dwFlags As Long)

    lngValue = SetLayeredWindowAttributes(hWnd, 0, Level, LWA_ALPHA)

End Sub ' SetWindowOpacity

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END WINDOW FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN RAW INPUT VARIABLE FUNCTIONS #1

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' Initialize variables that store mouse + keyboard input

Sub InitInputVars

    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.

    iIndex = LBound(arrMouse) - 1

    For iLoop = 1 To iMouseCount

        iIndex = iIndex + 1

        'DON'T ERASE THE ID!: arrMouse(iIndex).ID = ""

        'arrMouse(iIndex).UpdateCount = 1

        arrMouse(iIndex).dx = 0

        arrMouse(iIndex).dy = 0

        arrMouse(iIndex).px = cMaxPX / 2 ' 0

        arrMouse(iIndex).py = cMaxPY / 2 ' 0

        arrMouse(iIndex).pdx = 0 ' 100

        arrMouse(iIndex).pdy = 0 ' 100

        arrMouse(iIndex).wheel = 0

        'arrMouse(iIndex).wheelOld = 0

        arrMouse(iIndex).LeftDown = FALSE

        'arrMouse(iIndex).LeftDownOld = FALSE

        arrMouse(iIndex).MiddleDown = FALSE

        'arrMouse(iIndex).MiddleDownOld = FALSE

        arrMouse(iIndex).RightDown = FALSE

        'arrMouse(iIndex).RightDownOld = FALSE

    Next iLoop

    ' INITIALIZE KEYBOARD STATE VARIABLES

    iLastKeyDown = 0

    iLastKeyUp = 0

End Sub ' InitInputVars

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

' 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

        End If

    Next iLoop

    GetMouseIndex% = iIndex%

End Function ' GetMouseIndex%

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

'' Finds position in array arrKeyIndex containing KeyboardID

'

'Function GetKeyboardIndex% (KeyboardID As String)

'    Dim iLoop As Integer

'    Dim iIndex%

'    iIndex% = LBound(arrKeyIndex) - 1

'    For iLoop = LBound(arrKeyIndex) To UBound(arrKeyIndex)

'        If arrKeyIndex(iLoop) = KeyboardID Then

'            iIndex% = iLoop

'            Exit For

'        End If

'    Next iLoop

'    GetKeyboardIndex% = iIndex%

'End Function ' GetKeyboardIndex%

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END RAW INPUT VARIABLE FUNCTIONS #1

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN FILE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Help Me!

' Using shell to delete a file

' https://qb64phoenix.com/forum/showthread.php?tid=2618&pid=24683#pid24683

' a740g

' #5

' 04-24-2024, 06:05 AM

'

' There are no commands to directly make copies or backup of files.

' But you could write one with a few lines of code like:

'

' Copies src to dst

' Set overwite to true if dst should be overwritten if present

Sub CopyFile (src As String, dst As String, overwrite As _Byte)

    If _FileExists(src) Then

        If Not _FileExists(dst) Or (_FileExists(dst) And overwrite) Then

            _WriteFile dst, _ReadFile$(src)

        End If

    End If

End Sub ' CopyFile

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

' Convert a value to string and trim it (because normal Str$ adds spaces)

Function cstr$ (myValue)

    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))

    cstr$ = _Trim$(Str$(myValue))

End Function ' cstr$

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

Sub DebugLog (sText As String)

    Dim sTime As String

    Dim sResult As String

    ReDim arrLines(0) As String

    Dim iLoop As Integer

    Dim sNextLine As String

    If _FileExists(m_sDebugFile) = FALSE Then

        sResult = PrintFile$(m_sDebugFile, "", FALSE)

    End If

    If Len(sResult) = 0 Then

        sTime = GetCurrentDateTime$("{mm}/{dd}/{yyyy} {hh}:{nn}:{ss} {ampm}")

        split sText, Chr$(13), arrLines()

        For iLoop = LBound(arrLines) To UBound(arrLines)

            sNextLine = sTime + " " + arrLines(iLoop)

            sResult = PrintFile$(m_sDebugFile, sNextLine, TRUE)

        Next iLoop

    End If

End Sub ' DebugLog

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

Sub DebugLog1 (sText As String)

    Dim sResult As String

    If _FileExists(m_sDebugFile) Then

        sResult = PrintFile$(m_sDebugFile, sText, TRUE)

    Else

        sResult = PrintFile$(m_sDebugFile, sText, FALSE)

    End If

End Sub ' DebugLog

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

' QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Help Me!

' Using shell to delete a file

' https://qb64phoenix.com/forum/showthread.php?tid=2618

Sub DeleteFile (sFile As String)

    If _FileExists(sFile) Then

        'Shell "DELETE " + sFile

        'Shell "del " + sFile

        Kill sFile

    End If

End Sub ' DeleteFile

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

Function FileExt$ (sFile As String)

    Dim iPos As Integer

    iPos = _InStrRev(sFile, ".")

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                FileExt$ = Right$(sFile, Len(sFile) - iPos)

            Else

                ' dot is first character, return everything after it

                FileExt$ = Right$(sFile, Len(sFile) - 1)

            End If

        Else

            ' file only has one character, the dot, the file extension is blank

            FileExt$ = ""

        End If

    Else

        ' no dot found, the file extension is blank

        FileExt$ = ""

    End If

End Function ' FileExt$

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

Function NameOnly$ (sFile As String, sSlash As String)

    Dim iPos As Integer

    'sFile = Replace$(sFile, "/", "\")

    iPos = _InStrRev(sFile, sSlash)

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                NameOnly$ = Right$(sFile, Len(sFile) - iPos)

            Else

                ' slash is first character, return everything after it

                NameOnly$ = Right$(sFile, Len(sFile) - 1)

            End If

        Else

            ' file only has one character, the slash, name is blank

            NameOnly$ = ""

        End If

    Else

        ' slash not found, return the entire thing

        NameOnly$ = sFile

    End If

End Function ' NameOnly$

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

Function NoExt$ (sFile As String)

    Dim iPos As Integer

    iPos = _InStrRev(sFile, ".")

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                NoExt$ = Left$(sFile, iPos - 1)

            Else

                ' dot is first character, removing it returns blank!

                ' our version will just return the name unchanged

                ' but you can return blank if you prefer

                NoExt$ = sFile

            End If

        Else

            ' file only has one character, the dot, removing it returns blank!

            ' our version will just return the name unchanged

            ' but you can return blank if you prefer

            NoExt$ = sFile

        End If

    Else

        ' no dot found

        ' return the name unchanged

        NoExt$ = sFile

    End If

End Function ' NoExt$

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

Function PathOnly$ (sFile As String, sSlash As String)

    Dim iPos As Integer

    'sFile = Replace$(sFile, "/", "\")

    iPos = _InStrRev(sFile, sSlash)

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                PathOnly$ = Left$(sFile, iPos)

            Else

                ' slash is first character, so not much of a path, return blank

                PathOnly$ = ""

            End If

        Else

            ' file only has one character, the slash, name is blank

            PathOnly$ = ""

        End If

    Else

        ' slash not found, so not a path, return blank

        PathOnly$ = ""

    End If

End Function ' PathOnly$

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

' Writes sText to file sFileName.

' If bAppend=TRUE appends to file, else overwrites it.

' Returns blank if successful else returns error message.

' Example:

' ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))

' ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

' sFileName = ProgramPath$ + ProgramName$ + ".OUT.txt"

' sText = "This is a test." + chr$(13) + "Here is line 2." + chr$(13) + "End."

' sError = PrintFile$(sFileName, sText, FALSE)

Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)

    Dim sError As String: sError = ""

    If (bAppend = TRUE) Then

        If _FileExists(sFileName) Then

            Open sFileName For Append As #1 ' opens an existing file for appending

        Else

            sError = "Error in PrintFile$ : File not found. Cannot append."

        End If

    Else

        Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file

    End If

    If Len(sError) = 0 Then

        ' NOTE: WRITE places text in quotes in the file

        'WRITE #1, x, y, z$

        'WRITE #1, sText

        ' PRINT does not put text inside quotes

        Print #1, sText

        Close #1

    End If

    PrintFile$ = sError

End Function ' PrintFile$

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

' Fastest way is always to just read the whole life at once and then parse it.

Function ReadTextFile$ (sFileName As String, sDefault As String)

    Dim x$

    If _FileExists(sFileName) Then

        Open sFileName For Binary As #1

        x$ = Space$(LOF(1))

        Get #1, 1, x$

        Close #1

        ReadTextFile$ = x$

    Else

        ReadTextFile$ = sDefault

    End If

End Function ' ReadTextFile$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END FILE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN CONSTANT TO STRING FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

Function VirtualKeyCodeToString$ (MyInteger As Integer)

    Dim Mystring As String

    Select Case MyInteger

        Case VK_LBUTTON:

            Mystring = "VK_LBUTTON"

        Case VK_RBUTTON:

            Mystring = "VK_RBUTTON"

        Case VK_CANCEL:

            Mystring = "VK_CANCEL"

        Case VK_MBUTTON:

            Mystring = "VK_MBUTTON"

        Case VK_XBUTTON1:

            Mystring = "VK_XBUTTON1"

        Case VK_XBUTTON2:

            Mystring = "VK_XBUTTON2"

        Case VK_BACK:

            Mystring = "VK_BACK"

        Case VK_TAB:

            Mystring = "VK_TAB"

        Case VK_CLEAR:

            Mystring = "VK_CLEAR"

        Case VK_RETURN:

            Mystring = "VK_RETURN"

        Case VK_SHIFT:

            Mystring = "VK_SHIFT"

        Case VK_CONTROL:

            Mystring = "VK_CONTROL"

        Case VK_MENU:

            Mystring = "VK_MENU"

        Case VK_PAUSE:

            Mystring = "VK_PAUSE"

        Case VK_CAPITAL:

            Mystring = "VK_CAPITAL"

        Case VK_KANA:

            Mystring = "VK_KANA"

        Case VK_HANGUL:

            Mystring = "VK_HANGUL"

        Case VK_IME_ON:

            Mystring = "VK_IME_ON"

        Case VK_JUNJA:

            Mystring = "VK_JUNJA"

        Case VK_FINAL:

            Mystring = "VK_FINAL"

        Case VK_HANJA:

            Mystring = "VK_HANJA"

        Case VK_KANJI:

            Mystring = "VK_KANJI"

        Case VK_IME_OFF:

            Mystring = "VK_IME_OFF"

        Case VK_ESCAPE:

            Mystring = "VK_ESCAPE"

        Case VK_CONVERT:

            Mystring = "VK_CONVERT"

        Case VK_NONCONVERT:

            Mystring = "VK_NONCONVERT"

        Case VK_ACCEPT:

            Mystring = "VK_ACCEPT"

        Case VK_MODECHANGE:

            Mystring = "VK_MODECHANGE"

        Case VK_SPACE:

            Mystring = "VK_SPACE"

        Case VK_PRIOR:

            Mystring = "VK_PRIOR"

        Case VK_NEXT:

            Mystring = "VK_NEXT"

        Case VK_END:

            Mystring = "VK_END"

        Case VK_HOME:

            Mystring = "VK_HOME"

        Case VK_LEFT:

            Mystring = "VK_LEFT"

        Case VK_UP:

            Mystring = "VK_UP"

        Case VK_RIGHT:

            Mystring = "VK_RIGHT"

        Case VK_DOWN:

            Mystring = "VK_DOWN"

        Case VK_SELECT:

            Mystring = "VK_SELECT"

        Case VK_PRINT:

            Mystring = "VK_PRINT"

        Case VK_EXECUTE:

            Mystring = "VK_EXECUTE"

        Case VK_SNAPSHOT:

            Mystring = "VK_SNAPSHOT"

        Case VK_INSERT:

            Mystring = "VK_INSERT"

        Case VK_DELETE:

            Mystring = "VK_DELETE"

        Case VK_HELP:

            Mystring = "VK_HELP"

        Case VK_0:

            Mystring = "VK_0"

        Case VK_1:

            Mystring = "VK_1"

        Case VK_2:

            Mystring = "VK_2"

        Case VK_3:

            Mystring = "VK_3"

        Case VK_4:

            Mystring = "VK_4"

        Case VK_5:

            Mystring = "VK_5"

        Case VK_6:

            Mystring = "VK_6"

        Case VK_7:

            Mystring = "VK_7"

        Case VK_8:

            Mystring = "VK_8"

        Case VK_9:

            Mystring = "VK_9"

        Case VK_A:

            Mystring = "VK_A"

        Case VK_B:

            Mystring = "VK_B"

        Case VK_C:

            Mystring = "VK_C"

        Case VK_D:

            Mystring = "VK_D"

        Case VK_E:

            Mystring = "VK_E"

        Case VK_F:

            Mystring = "VK_F"

        Case VK_G:

            Mystring = "VK_G"

        Case VK_H:

            Mystring = "VK_H"

        Case VK_I:

            Mystring = "VK_I"

        Case VK_J:

            Mystring = "VK_J"

        Case VK_K:

            Mystring = "VK_K"

        Case VK_L:

            Mystring = "VK_L"

        Case VK_M:

            Mystring = "VK_M"

        Case VK_N:

            Mystring = "VK_N"

        Case VK_O:

            Mystring = "VK_O"

        Case VK_P:

            Mystring = "VK_P"

        Case VK_Q:

            Mystring = "VK_Q"

        Case VK_R:

            Mystring = "VK_R"

        Case VK_S:

            Mystring = "VK_S"

        Case VK_T:

            Mystring = "VK_T"

        Case VK_U:

            Mystring = "VK_U"

        Case VK_V:

            Mystring = "VK_V"

        Case VK_W:

            Mystring = "VK_W"

        Case VK_X:

            Mystring = "VK_X"

        Case VK_Y:

            Mystring = "VK_Y"

        Case VK_Z:

            Mystring = "VK_Z"

        Case VK_LWIN:

            Mystring = "VK_LWIN"

        Case VK_RWIN:

            Mystring = "VK_RWIN"

        Case VK_APPS:

            Mystring = "VK_APPS"

        Case VK_SLEEP:

            Mystring = "VK_SLEEP"

        Case VK_NUMPAD0:

            Mystring = "VK_NUMPAD0"

        Case VK_NUMPAD1:

            Mystring = "VK_NUMPAD1"

        Case VK_NUMPAD2:

            Mystring = "VK_NUMPAD2"

        Case VK_NUMPAD3:

            Mystring = "VK_NUMPAD3"

        Case VK_NUMPAD4:

            Mystring = "VK_NUMPAD4"

        Case VK_NUMPAD5:

            Mystring = "VK_NUMPAD5"

        Case VK_NUMPAD6:

            Mystring = "VK_NUMPAD6"

        Case VK_NUMPAD7:

            Mystring = "VK_NUMPAD7"

        Case VK_NUMPAD8:

            Mystring = "VK_NUMPAD8"

        Case VK_NUMPAD9:

            Mystring = "VK_NUMPAD9"

        Case VK_MULTIPLY:

            Mystring = "VK_MULTIPLY"

        Case VK_ADD:

            Mystring = "VK_ADD"

        Case VK_SEPARATOR:

            Mystring = "VK_SEPARATOR"

        Case VK_SUBTRACT:

            Mystring = "VK_SUBTRACT"

        Case VK_DECIMAL:

            Mystring = "VK_DECIMAL"

        Case VK_DIVIDE:

            Mystring = "VK_DIVIDE"

        Case VK_F1:

            Mystring = "VK_F1"

        Case VK_F2:

            Mystring = "VK_F2"

        Case VK_F3:

            Mystring = "VK_F3"

        Case VK_F4:

            Mystring = "VK_F4"

        Case VK_F5:

            Mystring = "VK_F5"

        Case VK_F6:

            Mystring = "VK_F6"

        Case VK_F7:

            Mystring = "VK_F7"

        Case VK_F8:

            Mystring = "VK_F8"

        Case VK_F9:

            Mystring = "VK_F9"

        Case VK_F10:

            Mystring = "VK_F10"

        Case VK_F11:

            Mystring = "VK_F11"

        Case VK_F12:

            Mystring = "VK_F12"

        Case VK_F13:

            Mystring = "VK_F13"

        Case VK_F14:

            Mystring = "VK_F14"

        Case VK_F15:

            Mystring = "VK_F15"

        Case VK_F16:

            Mystring = "VK_F16"

        Case VK_F17:

            Mystring = "VK_F17"

        Case VK_F18:

            Mystring = "VK_F18"

        Case VK_F19:

            Mystring = "VK_F19"

        Case VK_F20:

            Mystring = "VK_F20"

        Case VK_F21:

            Mystring = "VK_F21"

        Case VK_F22:

            Mystring = "VK_F22"

        Case VK_F23:

            Mystring = "VK_F23"

        Case VK_F24:

            Mystring = "VK_F24"

        Case VK_NUMLOCK:

            Mystring = "VK_NUMLOCK"

        Case VK_SCROLL:

            Mystring = "VK_SCROLL"

        Case VK_LSHIFT:

            Mystring = "VK_LSHIFT"

        Case VK_RSHIFT:

            Mystring = "VK_RSHIFT"

        Case VK_LCONTROL:

            Mystring = "VK_LCONTROL"

        Case VK_RCONTROL:

            Mystring = "VK_RCONTROL"

        Case VK_LMENU:

            Mystring = "VK_LMENU"

        Case VK_RMENU:

            Mystring = "VK_RMENU"

        Case VK_BROWSER_BACK:

            Mystring = "VK_BROWSER_BACK"

        Case VK_BROWSER_FORWARD:

            Mystring = "VK_BROWSER_FORWARD"

        Case VK_BROWSER_REFRESH:

            Mystring = "VK_BROWSER_REFRESH"

        Case VK_BROWSER_STOP:

            Mystring = "VK_BROWSER_STOP"

        Case VK_BROWSER_SEARCH:

            Mystring = "VK_BROWSER_SEARCH"

        Case VK_BROWSER_FAVORITES:

            Mystring = "VK_BROWSER_FAVORITES"

        Case VK_BROWSER_HOME:

            Mystring = "VK_BROWSER_HOME"

        Case VK_VOLUME_MUTE:

            Mystring = "VK_VOLUME_MUTE"

        Case VK_VOLUME_DOWN:

            Mystring = "VK_VOLUME_DOWN"

        Case VK_VOLUME_UP:

            Mystring = "VK_VOLUME_UP"

        Case VK_MEDIA_NEXT_TRACK:

            Mystring = "VK_MEDIA_NEXT_TRACK"

        Case VK_MEDIA_PREV_TRACK:

            Mystring = "VK_MEDIA_PREV_TRACK"

        Case VK_MEDIA_STOP:

            Mystring = "VK_MEDIA_STOP"

        Case VK_MEDIA_PLAY_PAUSE:

            Mystring = "VK_MEDIA_PLAY_PAUSE"

        Case VK_LAUNCH_MAIL:

            Mystring = "VK_LAUNCH_MAIL"

        Case VK_LAUNCH_MEDIA_SELECT:

            Mystring = "VK_LAUNCH_MEDIA_SELECT"

        Case VK_LAUNCH_APP1:

            Mystring = "VK_LAUNCH_APP1"

        Case VK_LAUNCH_APP2:

            Mystring = "VK_LAUNCH_APP2"

        Case VK_OEM_1:

            Mystring = "VK_OEM_1"

        Case VK_OEM_PLUS:

            Mystring = "VK_OEM_PLUS"

        Case VK_OEM_COMMA:

            Mystring = "VK_OEM_COMMA"

        Case VK_OEM_MINUS:

            Mystring = "VK_OEM_MINUS"

        Case VK_OEM_PERIOD:

            Mystring = "VK_OEM_PERIOD"

        Case VK_OEM_2:

            Mystring = "VK_OEM_2"

        Case VK_OEM_3:

            Mystring = "VK_OEM_3"

        Case VK_OEM_4:

            Mystring = "VK_OEM_4"

        Case VK_OEM_5:

            Mystring = "VK_OEM_5"

        Case VK_OEM_6:

            Mystring = "VK_OEM_6"

        Case VK_OEM_7:

            Mystring = "VK_OEM_7"

        Case VK_OEM_8:

            Mystring = "VK_OEM_8"

        Case VK_OEM_102:

            Mystring = "VK_OEM_102"

        Case VK_PROCESSKEY:

            Mystring = "VK_PROCESSKEY"

        Case VK_PACKET:

            Mystring = "VK_PACKET"

        Case VK_ATTN:

            Mystring = "VK_ATTN"

        Case VK_CRSEL:

            Mystring = "VK_CRSEL"

        Case VK_EXSEL:

            Mystring = "VK_EXSEL"

        Case VK_EREOF:

            Mystring = "VK_EREOF"

        Case VK_PLAY:

            Mystring = "VK_PLAY"

        Case VK_ZOOM:

            Mystring = "VK_ZOOM"

        Case VK_NONAME:

            Mystring = "VK_NONAME"

        Case VK_PA1:

            Mystring = "VK_PA1"

        Case VK_OEM_CLEAR:

            Mystring = "VK_OEM_CLEAR"

        Case Else:

            Mystring = _Trim$(Str$(MyInteger))

    End Select

    VirtualKeyCodeToString$ = Mystring

End Function ' VirtualKeyCodeToString$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END CONSTANT TO STRING FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN GENERAL PURPOSE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' SMcNeill

' More efficient version of ExtendedTimer.

' This stores our day values and only updates them when necessary.

' We really don't need to figure out how many seconds are in today over and over endlessly

' -- just count them once, and when the clock swaps back to 0:0:0, add 24*60*60 seconds to the count.

' Re: how to time something (ie do loop for n seconds)

' https://forum.qb64.org/index.php?topic=4682.0

Function ExtendedTimer##

    'modified extendedtimer to store the old day's count, and not have to recalculate it every time the routine is called.

    Static olds As _Float, old_day As _Float

    Dim m As Integer, d As Integer, y As Integer

    Dim s As _Float, day As String

    Dim oldt As Single

    If olds = 0 Then 'calculate the day the first time the extended timer runs

        day = Date$

        m = Val(Left$(day, 2))

        d = Val(Mid$(day, 4, 2))

        y = Val(Right$(day, 4)) - 1970

        Select Case m 'Add the number of days for each previous month passed

            Case 2: d = d + 31

            Case 3: d = d + 59

            Case 4: d = d + 90

            Case 5: d = d + 120

            Case 6: d = d + 151

            Case 7: d = d + 181

            Case 8: d = d + 212

            Case 9: d = d + 243

            Case 10: d = d + 273

            Case 11: d = d + 304

            Case 12: d = d + 334

        End Select

        If (y Mod 4) = 2 And m > 2 Then d = d + 1 'add a day if this is leap year and we're past february

        d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year

        d = d + (y + 2) \ 4 'add in days for leap years passed

        s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds

        old_day = s

    End If

    If Timer < oldt Then 'we went from 23:59:59 (a second before midnight) to 0:0:0 (midnight)

        old_day = s + 83400 'add another worth of seconds to our counter

    End If

    oldt = Timer

    olds = old_day + oldt

    ExtendedTimer## = olds

End Function ' ExtendedTimer##

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

' Simple timestamp function

' Format: {YYYY}-{MM}-{DD} {hh}:[mm}:{ss}

' Uses:

'     TIME$

'         The TIME$ Function returns a STRING representation

'         of the current computer time in a 24 hour format.

'         https://qb64phoenix.com/qb64wiki/index.php/TIME$

'     DATE$

'         The DATE$ function returns the current computer date

'         as a string in the format "mm-dd-yyyy".

'         https://qb64phoenix.com/qb64wiki/index.php/DATE$

'

' TODO: support template where

'       {yyyy} = 4 digit year

'       {mm}   = 2 digit month

'       {dd}   = 2 digit day

'       {hh}   = 2 digit hour (12-hour)

'       {rr}   = 2 digit hour (24-hour)

'       {nn}   = 2 digit minute

'       {ss}   = 2 digit second

'       {ampm} = AM/PM

' We got the nn for minute from Microsoft > Office VBA Reference > DateDiff function

' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/datediff-function

' PRINT "Current date time (simple format) = " + Chr$(34) + GetCurrentDateTime$("{yyyy}-{mm}-{dd} {rr}:{nn}:{ss}") + Chr$(34)

' PRINT "Current date time (US format)     = " + Chr$(34) + GetCurrentDateTime$("{mm}/{dd}/{yyyy} {hh}:{nn}:{ss} {ampm}") + Chr$(34)

' PRINT "Filename timestamp                = " + Chr$(34) + GetCurrentDateTime$("{yyyy}{mm}{dd}_{rr}{nn}{ss}") + Chr$(34)

Function GetCurrentDateTime$ (sTemplate$)

    Dim sDate$: sDate$ = Date$

    Dim sTime$: sTime$ = Time$

    Dim sYYYY$: sYYYY$ = Mid$(sDate$, 7, 4)

    Dim sMM$: sMM$ = Mid$(sDate$, 1, 2)

    Dim sDD$: sDD$ = Mid$(sDate$, 4, 2)

    Dim sHH24$: sHH24$ = Mid$(sTime$, 1, 2)

    Dim sHH$: sHH$ = ""

    Dim sMI$: sMI$ = Mid$(sTime$, 4, 2)

    Dim sSS$: sSS$ = Mid$(sTime$, 7, 2)

    Dim iHour%: iHour% = Val(sHH24$)

    Dim sAMPM$: sAMPM$ = ""

    Dim result$: result$ = ""

    ' FIGURE OUT AM/PM

    If InStr(sTemplate$, "{ampm}") > 0 Then

        If iHour% = 0 Then

            sAMPM$ = "AM"

            iHour% = 12

        ElseIf iHour% > 0 And iHour% < 12 Then

            sAMPM$ = "AM"

        ElseIf iHour% = 12 Then

            sAMPM$ = "PM"

        Else

            sAMPM$ = "PM"

            iHour% = iHour% - 12

        End If

        sHH$ = Right$("00" + _Trim$(Str$(iHour%)), 2)

    End If

    ' POPULATE TEMPLATE

    result$ = sTemplate$

    result$ = Replace$(result$, "{yyyy}", sYYYY$)

    result$ = Replace$(result$, "{mm}", sMM$)

    result$ = Replace$(result$, "{dd}", sDD$)

    result$ = Replace$(result$, "{hh}", sHH$)

    result$ = Replace$(result$, "{rr}", sHH24$)

    result$ = Replace$(result$, "{nn}", sMI$)

    result$ = Replace$(result$, "{ss}", sSS$)

    result$ = Replace$(result$, "{ampm}", sAMPM$)

    ' RETURN RESULT

    GetCurrentDateTime$ = result$

End Function ' GetCurrentDateTime$

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

' 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%

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

' IIF function for QB for integers

Function IIF (Condition, IfTrue, IfFalse)

    If Condition Then IIF = IfTrue Else IIF = IfFalse

End Function

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

' IIF function for QB for strings

Function IIFS$ (Condition, IfTrue$, IfFalse$)

    If Condition Then IIFS$ = IfTrue$ Else IIFS$ = IfFalse$

End Function

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

' 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%

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

' FROM: String Manipulation

' found at abandoned, outdated and now likely malicious qb64 dot net website

' http://www.qb64.[net]/forum/index_topic_5964-0/

'

'SUMMARY:

'   Purpose:  A library of custom functions that transform strings.

'   Author:   Dustinian Camburides (dustinian@gmail.com)

'   Platform: QB64 (www.qb64.org)

'   Revision: 1.6

'   Updated:  5/28/2012

'SUMMARY:

'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.

'INPUT:

'Text: The input string; the text that's being manipulated.

'Find: The specified sub-string; the string sought within the [Text] string.

'Add: The sub-string that's being added to the [Text] string.

Function Replace$ (Text1 As String, Find1 As String, Add1 As String)

    ' VARIABLES:

    Dim Text2 As String

    Dim Find2 As String

    Dim Add2 As String

    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.

    Dim strBefore As String ' The characters before the string to be replaced.

    Dim strAfter As String ' The characters after the string to be replaced.

    ' INITIALIZE:

    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)

    Text2 = Text1

    Find2 = Find1

    Add2 = Add1

    lngLocation = InStr(1, Text2, Find2)

    ' PROCESSING:

    ' While [Find2] appears in [Text2]...

    While lngLocation

        ' Extract all Text2 before the [Find2] substring:

        strBefore = Left$(Text2, lngLocation - 1)

        ' Extract all text after the [Find2] substring:

        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))

        ' Return the substring:

        Text2 = strBefore + Add2 + strAfter

        ' Locate the next instance of [Find2]:

        lngLocation = InStr(1, Text2, Find2)

        ' Next instance of [Find2]...

    Wend

    ' OUTPUT:

    Replace$ = Text2

End Function ' Replace$

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

' 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 As Integer

    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

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

'

'Sub SplitTest

'    Dim in$

'    Dim delim$

'    ReDim arrText$(0)

'    Dim iLoop%

'

'    delim$ = Chr$(10)

'    in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"

'    Print "in$ = " + Chr$(34) + in$ + Chr$(34)

'    Print "delim$ = " + Chr$(34) + delim$ + Chr$(34)

'    split in$, delim$, arrText$()

'

'    For iLoop% = LBound(arrText$) To UBound(arrText$)

'        Print "arrText$(" + _Trim$(Str$(iLoop%)) + ") = " + Chr$(34) + arrText$(iLoop%) + Chr$(34)

'    Next iLoop%

'    Print

'    Print "Split test finished."

'End Sub ' SplitTest

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

'

'Sub SplitAndReplaceTest

'    Dim in$

'    Dim out$

'    Dim iLoop%

'    ReDim arrText$(0)

'

'    Print "-------------------------------------------------------------------------------"

'    Print "SplitAndReplaceTest"

'    Print

'

'    Print "Original value"

'    in$ = "This line 1 " + Chr$(13) + Chr$(10) + "and line 2" + Chr$(10) + "and line 3 " + Chr$(13) + "finally THE END."

'    out$ = in$

'    out$ = Replace$(out$, Chr$(13), "\r")

'    out$ = Replace$(out$, Chr$(10), "\n")

'    out$ = Replace$(out$, Chr$(9), "\t")

'    Print "in$ = " + Chr$(34) + out$ + Chr$(34)

'    Print

'

'    Print "Fixing linebreaks..."

'    in$ = Replace$(in$, Chr$(13) + Chr$(10), Chr$(13))

'    in$ = Replace$(in$, Chr$(10), Chr$(13))

'    out$ = in$

'    out$ = Replace$(out$, Chr$(13), "\r")

'    out$ = Replace$(out$, Chr$(10), "\n")

'    out$ = Replace$(out$, Chr$(9), "\t")

'    Print "in$ = " + Chr$(34) + out$ + Chr$(34)

'    Print

'

'    Print "Splitting up..."

'    split in$, Chr$(13), arrText$()

'

'    For iLoop% = LBound(arrText$) To UBound(arrText$)

'        out$ = arrText$(iLoop%)

'        out$ = Replace$(out$, Chr$(13), "\r")

'        out$ = Replace$(out$, Chr$(10), "\n")

'        out$ = Replace$(out$, Chr$(9), "\t")

'        Print "arrText$(" + cstr$(iLoop%) + ") = " + Chr$(34) + out$ + Chr$(34)

'    Next iLoop%

'    Print

'

'    Print "SplitAndReplaceTest finished."

'End Sub ' SplitAndReplaceTest

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

' Use to pretty print TRUE and FALSE values.

Function TrueFalse$ (myValue)

    If myValue = TRUE Then

        TrueFalse$ = "TRUE"

    Else

        TrueFalse$ = "FALSE"

    End If

End Function ' TrueFalse$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END GENERAL PURPOSE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN handle MEM for any type

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' QB64 GPT Just Rewrote My Code

' https://qb64phoenix.com/forum/showthread.php?tid=2728

' And the revisions QB64 GPT made (after minor changes and me asking it to redo some syntax errors):

' It separated out a lot of processing out to separate subs.

' It is quite impressive how little input I had to give it to fix its mistakes.

' The code actually worked just as well as it did before the changes, which blows my mind.

' It actually even listened to me when I told it that it would need to cast an OFFSET type by using VAL(STR$(var)).

' To be fair, I had to tell it "ByRef" was invalid and a couple of other things.

' I also had to declare "y" each time it was used. But the last iteration only required me to declare "y".

' I think that is a decent enough result. Too bad I can't get it to be this good every time.

' 1) This is the paid version of GPT4. I am on the plus plan, so whatever that one has.

' 2) I think I deleted the session. Sorry. I only used it for as long as I needed it.

' 3) I don't know what the hard limit is. It's in "tokens", which I have no idea how those are calculated.

' I got a pretty large source code from one output and it can take a lot of input. I would just say it can handle quite a bit.

' The GPT I used was one I trained using the Wiki, sample code, etc. At the time, it used GPT4.

' Custom GPTs now use 4o. I will probably need to republish it to take advantage of 4o for it.

' I guess training is the wrong word. A custom GPT has a "knowledge base".

' You can have a maximum of 20 files.

' It can use those files to create an answer. Even a zip folder can be used.

' It will basically only use the knowledge base when specifically asked. Otherwise, it is using whatever it already had in its model.

' As for testing code and such, you can create "actions" for your GPT that allow it to do things outside of ChatGPT, including REST API.

' So if dbox ever made a REST API for QBJS, you could definitely have it write QBJS code and then ask it to run it.

Sub anyArg (args() As _MEM)

    Dim As _Unsigned Integer x, y

    Dim As _Unsigned _Offset z

    Dim As _Unsigned Long size, elementsize

    For x = LBound(args) To UBound(args)

        If _MemExists(args(x)) Then

            z = 0

            size = Val(Str$(args(x).SIZE))

            elementsize = Val(Str$(args(x).ELEMENTSIZE))

            If _ReadBit(args(x).TYPE, 7) And _ReadBit(args(x).TYPE, 13) = 0 Then

                HandleNumericType args(x), size, elementsize, z

            ElseIf _ReadBit(args(x).TYPE, 8) Then

                HandleFloatingType args(x), size, elementsize, z

            ElseIf _ReadBit(args(x).TYPE, 9) Then

                HandleStringType args(x), size, elementsize

            ElseIf _ReadBit(args(x).TYPE, 13) And _ReadBit(args(x).TYPE, 7) Then

                HandleOffsetType args(x), size, elementsize, z

            ElseIf args(x).TYPE = 0 And args(x).SIZE > 0 Then

                HandleSoundType args(x)

            ElseIf _ReadBit(args(x).TYPE, 14) Then

                Print args(x).SIZE, "MEM"

                ' TODO: Handle other types if necessary

            End If

            If _ReadBit(args(x).TYPE, 11) Then

                Screen args(x).IMAGE

            End If

        End If

    Next

End Sub ' anyArg

' Subroutines for handling specific types

Sub HandleNumericType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)

    If _ReadBit(arg.TYPE, 10) Then

        If _ReadBit(arg.TYPE, 16) Then

            Select Case elementsize

                Case 1

                    Dim As _Unsigned _Byte unsignedbytearray(1 To (size / elementsize))

                    ProcessArray_UByte unsignedbytearray(), arg, size, elementsize, z, "UBYTE ARRAY"

                Case 2

                    Dim As _Unsigned Integer unsignedintarray(1 To (size / elementsize))

                    ProcessArray_UInteger unsignedintarray(), arg, size, elementsize, z, "USHORT ARRAY"

                Case 4

                    Dim As _Unsigned Long unsignedlongarray(1 To (size / elementsize))

                    ProcessArray_ULong unsignedlongarray(), arg, size, elementsize, z, "ULONG ARRAY"

                Case 8

                    Dim As _Unsigned _Integer64 unsignedint64array(1 To (size / elementsize))

                    ProcessArray_UInt64 unsignedint64array(), arg, size, elementsize, z, "UINT64 ARRAY"

            End Select

        Else

            PrintSingleValue arg, size, elementsize

        End If

    Else

        If _ReadBit(arg.TYPE, 16) Then

            Select Case elementsize

                Case 1

                    Dim As _Byte bytearray(1 To (size / elementsize))

                    ProcessArray_Byte bytearray(), arg, size, elementsize, z, "BYTE ARRAY"

                Case 2

                    Dim As Integer intarray(1 To (size / elementsize))

                    ProcessArray_Integer intarray(), arg, size, elementsize, z, "SHORT ARRAY"

                Case 4

                    Dim As Long longarray(1 To (size / elementsize))

                    ProcessArray_Long longarray(), arg, size, elementsize, z, "LONG ARRAY"

                Case 8

                    Dim As _Integer64 int64array(1 To (size / elementsize))

                    ProcessArray_Int64 int64array(), arg, size, elementsize, z, "INT64 ARRAY"

            End Select

        Else

            PrintSingleValue arg, size, elementsize

        End If

    End If

End Sub ' HandleNumericType

Sub HandleFloatingType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)

    If _ReadBit(arg.TYPE, 16) Then

        Select Case elementsize

            Case 4

                Dim As Single singlearray(1 To (size / elementsize))

                ProcessArray_Single singlearray(), arg, size, elementsize, z, "SINGLE ARRAY"

            Case 8

                Dim As Double doublearray(1 To (size / elementsize))

                ProcessArray_Double doublearray(), arg, size, elementsize, z, "DOUBLE ARRAY"

            Case 32

                Dim As _Float floatarray(1 To (size / elementsize))

                ProcessArray_Float floatarray(), arg, size, elementsize, z, "FLOAT ARRAY"

        End Select

    Else

        Select Case size

            Case 4

                Print _MemGet(arg, arg.OFFSET, Single), "SINGLE"

            Case 8

                Print _MemGet(arg, arg.OFFSET, Double), "DOUBLE"

            Case 32

                Print _MemGet(arg, arg.OFFSET, _Float), "FLOAT"

        End Select

    End If

End Sub ' HandleFloatingType

Sub HandleStringType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long)

    If _ReadBit(arg.TYPE, 16) Then

        Dim As String stringarray(1 To (size / elementsize))

        Dim As _Unsigned Long y

        For y = LBound(stringarray) To UBound(stringarray)

            stringarray(y) = Space$(elementsize)

            _MemGet arg, (arg.OFFSET) + (y * elementsize - elementsize), stringarray(y)

            Print stringarray(y), "STRING ARRAY"

        Next

    Else

        Dim As String stringtest: stringtest = Space$(elementsize)

        _MemGet arg, arg.OFFSET, stringtest

        Print stringtest

    End If

End Sub ' HandleStringType

Sub HandleOffsetType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)

    If _ReadBit(arg.TYPE, 10) Then

        If _ReadBit(arg.TYPE, 16) Then

            Dim As _Unsigned _Offset unsignedoffsetarray(1 To (size / elementsize))

            ProcessArray_UOffset unsignedoffsetarray(), arg, size, elementsize, z, "ULONG_PTR ARRAY"

        Else

            Print _MemGet(arg, arg.OFFSET, _Unsigned _Offset), "ULONG_PTR"

        End If

    Else

        If _ReadBit(arg.TYPE, 16) Then

            Dim As _Offset offsetarray(1 To (size / elementsize))

            ProcessArray_Offset offsetarray(), arg, size, elementsize, z, "LONG_PTR ARRAY"

        Else

            Print _MemGet(arg, arg.OFFSET, _Offset), "LONG_PTR"

        End If

    End If

End Sub ' HandleOffsetType

Sub HandleSoundType (arg As _MEM)

    If Not _SndPlaying(arg.SOUND) Then

        _SndPlay (arg.SOUND)

    End If

    Print "SOUND", arg.SIZE, arg.ELEMENTSIZE

End Sub ' HandleSoundType

' Subroutines for processing arrays

Sub ProcessArray_UByte (unsignedbytearray() As _Unsigned _Byte, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(unsignedbytearray) To UBound(unsignedbytearray)

        _MemGet arg, arg.OFFSET + z, unsignedbytearray(y)

        z = z + elementsize

        Print unsignedbytearray(y), typeName

    Next

End Sub ' ProcessArray_UByte

Sub ProcessArray_UInteger (unsignedintarray() As _Unsigned Integer, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(unsignedintarray) To UBound(unsignedintarray)

        _MemGet arg, arg.OFFSET + z, unsignedintarray(y)

        z = z + elementsize

        Print unsignedintarray(y), typeName

    Next

End Sub ' ProcessArray_UInteger

Sub ProcessArray_ULong (unsignedlongarray() As _Unsigned Long, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(unsignedlongarray) To UBound(unsignedlongarray)

        _MemGet arg, arg.OFFSET + z, unsignedlongarray(y)

        z = z + elementsize

        Print unsignedlongarray(y), typeName

    Next

End Sub ' ProcessArray_ULong

Sub ProcessArray_UInt64 (unsignedint64array() As _Unsigned _Integer64, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(unsignedint64array) To UBound(unsignedint64array)

        _MemGet arg, arg.OFFSET + z, unsignedint64array(y)

        z = z + elementsize

        Print unsignedint64array(y), typeName

    Next

End Sub ' ProcessArray_UInt64

Sub ProcessArray_Byte (bytearray() As _Byte, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(bytearray) To UBound(bytearray)

        _MemGet arg, arg.OFFSET + z, bytearray(y)

        z = z + elementsize

        Print bytearray(y), typeName

    Next

End Sub ' ProcessArray_Byte

Sub ProcessArray_Integer (intarray() As Integer, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(intarray) To UBound(intarray)

        _MemGet arg, arg.OFFSET + z, intarray(y)

        z = z + elementsize

        Print intarray(y), typeName

    Next

End Sub ' ProcessArray_Integer

Sub ProcessArray_Long (longarray() As Long, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(longarray) To UBound(longarray)

        _MemGet arg, arg.OFFSET + z, longarray(y)

        z = z + elementsize

        Print longarray(y), typeName

    Next

End Sub ' ProcessArray_Long

Sub ProcessArray_Int64 (int64array() As _Integer64, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(int64array) To UBound(int64array)

        _MemGet arg, arg.OFFSET + z, int64array(y)

        z = z + elementsize

        Print int64array(y), typeName

    Next

End Sub ' ProcessArray_Int64

Sub ProcessArray_Single (singlearray() As Single, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(singlearray) To UBound(singlearray)

        _MemGet arg, arg.OFFSET + z, singlearray(y)

        z = z + elementsize

        Print singlearray(y), typeName

    Next

End Sub ' ProcessArray_Single

Sub ProcessArray_Double (doublearray() As Double, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(doublearray) To UBound(doublearray)

        _MemGet arg, arg.OFFSET + z, doublearray(y)

        z = z + elementsize

        Print doublearray(y), typeName

    Next

End Sub ' ProcessArray_Double

Sub ProcessArray_Float (floatarray() As _Float, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(floatarray) To UBound(floatarray)

        _MemGet arg, arg.OFFSET + z, floatarray(y)

        z = z + elementsize / 2

        Print floatarray(y), typeName

    Next

End Sub ' ProcessArray_Float

Sub ProcessArray_UOffset (unsignedoffsetarray() As _Unsigned _Offset, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(unsignedoffsetarray) To UBound(unsignedoffsetarray)

        _MemGet arg, arg.OFFSET + z, unsignedoffsetarray(y)

        z = z + elementsize

        Print unsignedoffsetarray(y), typeName

    Next

End Sub ' ProcessArray_UOffset

Sub ProcessArray_Offset (offsetarray() As _Offset, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(offsetarray) To UBound(offsetarray)

        _MemGet arg, arg.OFFSET + z, offsetarray(y)

        z = z + elementsize

        Print offsetarray(y), typeName

    Next

End Sub ' ProcessArray_Offset

Sub PrintSingleValue (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long)

    Select Case size

        Case 1

            Print _MemGet(arg, arg.OFFSET, _Byte), "BYTE"

        Case 2

            Print _MemGet(arg, arg.OFFSET, Integer), "SHORT"

        Case 4

            Print _MemGet(arg, arg.OFFSET, Long), "LONG"

        Case 8

            Print _MemGet(arg, arg.OFFSET, _Integer64), "INT64"

    End Select

End Sub ' PrintSingleValue

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END handle MEM for any type

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ################################################################################################################################################################

' 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 cDebugEnabled = 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 cDebugEnabled = TRUE Then

    '    _Echo s$

    'End If

End Sub ' DebugPrint1

' ################################################################################################################################################################

' END DEBUGGING ROUTINES @DEBUG

' ################################################################################################################################################################

' ################################################################################################################################################################

' BEGIN REFERENCE #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 REFERENCE @REFERENCE

' ################################################################################################################################################################

' @END

RE: seperate input from multiple mice v0.54 graphic demo - madscijr - 06-21-2024

Updated the main program to process multiple messages, so concurrent input seems to work more smoothly.
Give it a try! Right now it's set up to read input from 8 USB mice plugged into one PC as seperate devices!

A challenge for you brainiacs: get this working without needing a separate program to read the mice!

Braniac challenge #2: get it to read multiple keyboards as seperate devices! Hint: find the 8800 keys! convert unions in RAWINPUT structure to QB64PE type in "ReadMiceSub"

Screenshot:

Filename: readmicemain56.screenshot.png Size: 17.01 KB 06-21-2024, 01:02 PM

All files in 1 zip archive:

.zip

readmicemain56.zip (Size: 56.26 KB / Downloads: 12)

Source code for all files:

"ReadMiceMain56.bas":

Code: (Select All)
' ################################################################################################################################################################

' Multimouse main program "ReadMiceMain.bas" v0.54

' ################################################################################################################################################################

' -------------------------------------------------------------------------------

' ABOUT

' -------------------------------------------------------------------------------

' Working proof of concept! (Windows only so far)

'

' HOW TO USE:

'

' 1. Plug 2-8 USB mice into your PC.

'

' 2. Place "makeint.h" and "winproc.h" in same folder as the program.

'

' 3. Compile the mouse reader program "ReadMiceSub" first

'    (or run it once, it will run briefly then exit).

'

' 4. Run the front end program "ReadMiceMain".

'    The main program will automatically start the subprogram "ReadMiceSub"

'    which should have the focus.

'

' 5. If your PC prompts for permission say Yes.

'    Be patient, the program takes a few seconds to start everything up

'    and get "situated"!

'

' 6. Click the mouse to make sure "ReadMiceSub" has the focus

'    (it's invisible but sitting on top of "ReadMiceMain").

'

' 7. Try moving each mouse.

'    Each mouse should move a different colored numbered block.

'

' 7. Try clicking the left / middle / right mouse buttons.

'    You should see the button states on the screen for each mouse.

'

' 8. Try pressing some keys on the keyboard.

'    The last keys pressed + released are displayed at the top.

'

' 9. Press Esc to quit, or delete the file "ReadMiceSub.DELETE-TO-CLOSE".

'    The main program creates this file at startup, and both the main and

'    sub programs periodically check that the file is still present.

'    If it is missing, both programs shut down.

'

' DEBUGGING CODE:

' There is currently a ton of commented out debugging code - sorry about the

' mess! There were some horribly elusive problems to figure out.

' To enable debugging output: change Const cDebugEnabled to TRUE

' and search for "debug" and uncomment those lines.

' DebugPrint outputs to the console, DebugLog outputs to a file.

' Enabling console in "ReadMiceSub" caused all sorts of problems,

' so to debug that, just use DebugLog.

' -------------------------------------------------------------------------------

' TO DO

' -------------------------------------------------------------------------------

' Some issues and things to fix:

'

' * Hide the real mouse cursor and reactivate it when program closes.

'

' * Detect moving the scroll wheel.

'

' * Get it working with _FullScreen _SquarePixels.

'   When I tried that mode things got really weird.

'

' * Read input from multiple keyboards - need to figure out how to do the

'   unions in the RAWINPUT structure type in "ReadMiceSub".

'   (Just need someone to figure this out, I have tried.)

'

' * Figure out how to get the same functionality for Mac & Linux.

' -------------------------------------------------------------------------------

' THANK YOU

' -------------------------------------------------------------------------------

' Much credit and thanks are due to:

' * jstookey who started the work that made this possible

' * SpriggsySpriggs who ported the hard stuff (APIs, events) to QB64 & QB64PE

' * SMcNeill who helped with so many things, most recently keeping the main window on top, getting file attributes

' * Steffan-68 for feedback, code for managing windows and ideas

' * DSMan195276 for the network code that lets the reader and main program talk smoothly

' * euklides, Ed Davis, mdijkens for file attributes code

' * grymmjack for words of encouragement

' * the QB64 and QB64PE communities for help with everything

' * (if I forgot anyone let me know!)

' -------------------------------------------------------------------------------

' 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.

'                        Code at: https://jstookey.com/multiple-mice-raw-input/

' 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.

' 2024-05-23  madscijr   Now we get mice coordinates from subprogram via TCPIP.

'                        A lot faster than using files!

'                        Thanks to DSMan195276 for the networking code.

' 2024-06-19  madscijr   Now we get absolute mouse coordinates not just dx, dy

'                        and can read the keyboard (just a single keyboard).

'                        Updated the graphics / display code to use layers.

' -------------------------------------------------------------------------------

' RESOURCES:

'

' Multiple Mice in Windows using Raw Input by jstookey

' * https://jstookey.com/multiple-mice-raw-input/

'

' One of the original QB64 threads

' * https://qb64phoenix.com/forum/showthread.php?tid=864

'

' Using Raw Input from C# to handle multiple keyboards by Emma Burrows, Steve Messer

' * https://www.codeproject.com/Articles/17123/Using-Raw-Input-from-C-to-handle-multiple-keyboard

'

' Microsoft's Raw Input API docs at pages around:

' * https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputheader

' * https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevicelist

'

' Looking at RAWINPUT for more detail (HACKADAY.IO)

' * https://hackaday.io/project/5364-cheap-windows-jogkeyboard-controller-for-cncs/log/16843-looking-at-rawinput-for-more-detail

'

' TimothyTimbers Raw Input Class for indie Game Developers:

' * https://www.unknowncheats.me/forum/c-and-c-/64318-raw-input-class-indie-game-developers.html

'

' WINDOWS PROGRAMMING: ACCESSING RAW INPUT by DAVID OREJUELA

' * https://davidorejuela.blogspot.com/2013/12/windows-programming-accessing-raw-input.html

'

' Explorations in Game Development: Why Raw Input?

' * https://explore-gamedev.blogspot.com/2013/09/why-raw-input.html

' Forum threads:

' * https://stackoverflow.com/questions/44935905/why-i-can-not-retrieve-rawinput-data-from-mouse

' * https://stackoverflow.com/questions/6423729/get-current-cursor-position

' * https://www.gamedev.net/forums/topic/700010-winapi-raw-input-confusion/

' * https://cplusplus.com/forum/windows/95700/

' * https://www.codeproject.com/Questions/118950/Raw-input-in-QT-library

' * https://docs.unity3d.com/ScriptReference/Windows.Input.ForwardRawInput.html

' * https://forum.freecad.org/viewtopic.php?style=2&t=28306&start=40

' * https://java-native-access.github.io/jna/5.4.0/javadoc/com/sun/jna/platform/win32/WinUser.RAWINPUTDEVICELIST.html

' * https://community.appeon.com/index.php/qna/q-a/how-can-i-catch-tab-key

' * https://forum.3dconnexion.com/viewtopic.php?t=2698

' * https://en.sfml-dev.org/forums/index.php?topic=15879.0

' * https://www.autoitscript.com/forum/topic/95105-hid-human-interface-device-communications-in-xp/page/2/

' * https://forum.unity.com/threads/new-input-system-get-raw-mouse-delta-from-wm_input.1177393/

' * https://forums.codeguru.com/showthread.php?541051-WM_Input-runtime-crash

' * https://discourse.libsdl.org/t/sdl-fixed-allocation-and-alignment-of-raw-input-buffers/48112

' * https://microsoft.public.dotnet.framework.interop.narkive.com/gWykTvfJ/reading-raw-data-from-a-hid-device

' * https://forum.qt.io/topic/66064/how-to-get-mouse-actual-position

' * https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/55985-raw-keyboard-hid-input-discussion

' * https://handmade.network/forums/t/7638-how_to_read_joystick_data_from_raw_input

' * https://microsoft.public.development.device.drivers.narkive.com/UWm0qmMb/getrawinputdata-usb-keyboard-with-power-keys

' * https://www.quakeworld.nu/forum/topic/3634/46374/getting-sensitivity-to-match-quake-

' * https://discourse.libsdl.org/t/sdl-fixed-windows-rawinput-crash/50150

' * https://squid.nt.tuwien.ac.at/gitlab/platzgummer/qgroundcontrol/commit/779f13f4e38c8d06fc2a74e594017d984e42c58e.diff

' * https://forums.codeguru.com/showthread.php?511656-How-to-get-interpreted-mouse-coords-from-raw-mouse-input

' * https://blog.naver.com/promaker72/50102194598

' * https://ubuntuforums.org/showthread.php?t=1543385

' Other pages with Raw Input info:

' * https://dev.to/igorsegallafa/avoiding-the-use-of-auto-clicker-keyboard-tools-5469

' * https://dev.opencascade.org/doc/refman/html/class_w_n_t___h_i_d_space_mouse.html

' * https://chromium.googlesource.com/experimental/chromium/src/+/refs/wip/bajones/webvr/device/gamepad/raw_input_data_fetcher_win.cc

' * https://bobobobo.wordpress.com/2010/04/21/rawinput/

' * https://sidestore.io/SideSource/interfaces/RawInput.html

Option Explicit

_Title "ReadMiceMain"

$NoPrefix

'$Console:Only

'Console Off

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN CONSTANTS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Const cProgName = "ReadMiceMain"

Const FALSE = 0

Const TRUE = Not FALSE

Const cDebugEnabled = FALSE

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' TEXT MODE COLORS:

Const c_Black = 0: Const c_Blue = 1: Const c_Green = 2: Const c_LtBlue = 3

Const c_Red = 4: Const c_Purple = 5: Const c_Orange = 6: Const c_White = 7

Const c_Gray = 8: Const c_Periwinkle = 9: Const c_LtGreen = 10: Const c_Cyan = 11

Const c_LtRed = 12: Const c_Pink = 13: Const c_Yellow = 14: Const c_LtGray = 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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' FOR CONTROLLING WINDOW FOCUS

Const SW_SHOW = 5

'' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'' 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 cForPlayer = 1

'Const cUpdateCount = 2

Const cMouseDX = 2

Const cMouseDY = 3

Const cMousePosX = 4

Const cMousePosY = 5

Const cMouseWheel = 6

Const cMouseLeftDown = 7

Const cMouseMiddleDown = 8

Const cMouseRightDown = 9

Const cMouseSpeedX = 0 ' smaller = faster

Const cMouseSpeedY = 2 ' smaller = faster

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' BEGIN Virtual-Key Codes

' https://learn.microsoft.com/en-us/windows/win32/inputdev/virtual-key-codes

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' NOTE: raw.data.Keyboard.vKey may require set extended bit

Const VK_LBUTTON = &H01 ' dec = 1, Left mouse button

Const VK_RBUTTON = &H02 ' dec = 2, Right mouse button

Const VK_CANCEL = &H03 ' dec = 3, Control-break processing

Const VK_MBUTTON = &H04 ' dec = 4, Middle mouse button

Const VK_XBUTTON1 = &H05 ' dec = 5, X1 mouse button

Const VK_XBUTTON2 = &H06 ' dec = 6, X2 mouse button

'??? = &H07 ' dec = 7, Reserved

Const VK_BACK = &H08 ' dec = 8, BACKSPACE key

Const VK_TAB = &H09 ' dec = 9, TAB key

'??? = &H0A-0B ' dec = 10-11, Reserved

Const VK_CLEAR = &H0C ' dec = 12, CLEAR key

Const VK_RETURN = &H0D ' dec = 13, ENTER key

'??? = &H0E-0F ' dec = 14-15, Unassigned

Const VK_SHIFT = &H10 ' dec = 16, SHIFT key

Const VK_CONTROL = &H11 ' dec = 17, CTRL key

Const VK_MENU = &H12 ' dec = 18, ALT key

Const VK_PAUSE = &H13 ' dec = 19, PAUSE key

Const VK_CAPITAL = &H14 ' dec = 20, CAPS LOCK key

Const VK_KANA = &H15 ' dec = 21, IME Kana mode

Const VK_HANGUL = &H15 ' dec = 21, IME Hangul mode

Const VK_IME_ON = &H16 ' dec = 22, IME On

Const VK_JUNJA = &H17 ' dec = 23, IME Junja mode

Const VK_FINAL = &H18 ' dec = 24, IME final mode

Const VK_HANJA = &H19 ' dec = 25, IME Hanja mode

Const VK_KANJI = &H19 ' dec = 25, IME Kanji mode

Const VK_IME_OFF = &H1A ' dec = 26, IME Off

Const VK_ESCAPE = &H1B ' dec = 27, ESC key

Const VK_CONVERT = &H1C ' dec = 28, IME convert

Const VK_NONCONVERT = &H1D ' dec = 29, IME nonconvert

Const VK_ACCEPT = &H1E ' dec = 30, IME accept

Const VK_MODECHANGE = &H1F ' dec = 31, IME mode change request

Const VK_SPACE = &H20 ' dec = 32, SPACEBAR

Const VK_PRIOR = &H21 ' dec = 33, PAGE UP key

Const VK_NEXT = &H22 ' dec = 34, PAGE DOWN key

Const VK_END = &H23 ' dec = 35, END key

Const VK_HOME = &H24 ' dec = 36, HOME key

Const VK_LEFT = &H25 ' dec = 37, LEFT ARROW key

Const VK_UP = &H26 ' dec = 38, UP ARROW key

Const VK_RIGHT = &H27 ' dec = 39, RIGHT ARROW key

Const VK_DOWN = &H28 ' dec = 40, DOWN ARROW key

Const VK_SELECT = &H29 ' dec = 41, SELECT key

Const VK_PRINT = &H2A ' dec = 42, PRINT key

Const VK_EXECUTE = &H2B ' dec = 43, EXECUTE key

Const VK_SNAPSHOT = &H2C ' dec = 44, PRINT SCREEN key

Const VK_INSERT = &H2D ' dec = 45, INS key

Const VK_DELETE = &H2E ' dec = 46, DEL key

Const VK_HELP = &H2F ' dec = 47, HELP key

' MADE OUR OWN CONSTANTS FOR THESE:

Const VK_0 = &H30 ' dec = 48, 0 key

Const VK_1 = &H31 ' dec = 49, 1 key

Const VK_2 = &H32 ' dec = 50, 2 key

Const VK_3 = &H33 ' dec = 51, 3 key

Const VK_4 = &H34 ' dec = 52, 4 key

Const VK_5 = &H35 ' dec = 53, 5 key

Const VK_6 = &H36 ' dec = 54, 6 key

Const VK_7 = &H37 ' dec = 55, 7 key

Const VK_8 = &H38 ' dec = 56, 8 key

Const VK_9 = &H39 ' dec = 57, 9 key

'??? = &H3A-40 ' dec = 58-64, Undefined

Const VK_A = &H41 ' dec = 65, A key

Const VK_B = &H42 ' dec = 66, B key

Const VK_C = &H43 ' dec = 67, C key

Const VK_D = &H44 ' dec = 68, D key

Const VK_E = &H45 ' dec = 69, E key

Const VK_F = &H46 ' dec = 70, F key

Const VK_G = &H47 ' dec = 71, G key

Const VK_H = &H48 ' dec = 72, H key

Const VK_I = &H49 ' dec = 73, I key

Const VK_J = &H4A ' dec = 74, J key

Const VK_K = &H4B ' dec = 75, K key

Const VK_L = &H4C ' dec = 76, L key

Const VK_M = &H4D ' dec = 77, M key

Const VK_N = &H4E ' dec = 78, N key

Const VK_O = &H4F ' dec = 79, O key

Const VK_P = &H50 ' dec = 80, P key

Const VK_Q = &H51 ' dec = 81, Q key

Const VK_R = &H52 ' dec = 82, R key

Const VK_S = &H53 ' dec = 83, S key

Const VK_T = &H54 ' dec = 84, T key

Const VK_U = &H55 ' dec = 85, U key

Const VK_V = &H56 ' dec = 86, V key

Const VK_W = &H57 ' dec = 87, W key

Const VK_X = &H58 ' dec = 88, X key

Const VK_Y = &H59 ' dec = 89, Y key

Const VK_Z = &H5A ' dec = 90, Z key

' Microsoft's Virtual-Key Codes constants (continued):

Const VK_LWIN = &H5B ' dec = 91, Left Windows key

Const VK_RWIN = &H5C ' dec = 92, Right Windows key

Const VK_APPS = &H5D ' dec = 93, Applications key

'??? = &H5E ' dec = 94, Reserved

Const VK_SLEEP = &H5F ' dec = 95, Computer Sleep key

Const VK_NUMPAD0 = &H60 ' dec = 96, Numeric keypad 0 key

Const VK_NUMPAD1 = &H61 ' dec = 97, Numeric keypad 1 key

Const VK_NUMPAD2 = &H62 ' dec = 98, Numeric keypad 2 key

Const VK_NUMPAD3 = &H63 ' dec = 99, Numeric keypad 3 key

Const VK_NUMPAD4 = &H64 ' dec = 100, Numeric keypad 4 key

Const VK_NUMPAD5 = &H65 ' dec = 101, Numeric keypad 5 key

Const VK_NUMPAD6 = &H66 ' dec = 102, Numeric keypad 6 key

Const VK_NUMPAD7 = &H67 ' dec = 103, Numeric keypad 7 key

Const VK_NUMPAD8 = &H68 ' dec = 104, Numeric keypad 8 key

Const VK_NUMPAD9 = &H69 ' dec = 105, Numeric keypad 9 key

Const VK_MULTIPLY = &H6A ' dec = 106, Multiply key

Const VK_ADD = &H6B ' dec = 107, Add key

Const VK_SEPARATOR = &H6C ' dec = 108, Separator key

Const VK_SUBTRACT = &H6D ' dec = 109, Subtract key

Const VK_DECIMAL = &H6E ' dec = 110, Decimal key

Const VK_DIVIDE = &H6F ' dec = 111, Divide key

Const VK_F1 = &H70 ' dec = 112, F1 key

Const VK_F2 = &H71 ' dec = 113, F2 key

Const VK_F3 = &H72 ' dec = 114, F3 key

Const VK_F4 = &H73 ' dec = 115, F4 key

Const VK_F5 = &H74 ' dec = 116, F5 key

Const VK_F6 = &H75 ' dec = 117, F6 key

Const VK_F7 = &H76 ' dec = 118, F7 key

Const VK_F8 = &H77 ' dec = 119, F8 key

Const VK_F9 = &H78 ' dec = 120, F9 key

Const VK_F10 = &H79 ' dec = 121, F10 key

Const VK_F11 = &H7A ' dec = 122, F11 key

Const VK_F12 = &H7B ' dec = 123, F12 key

Const VK_F13 = &H7C ' dec = 124, F13 key

Const VK_F14 = &H7D ' dec = 125, F14 key

Const VK_F15 = &H7E ' dec = 126, F15 key

Const VK_F16 = &H7F ' dec = 127, F16 key

Const VK_F17 = &H80 ' dec = 128, F17 key

Const VK_F18 = &H81 ' dec = 129, F18 key

Const VK_F19 = &H82 ' dec = 130, F19 key

Const VK_F20 = &H83 ' dec = 131, F20 key

Const VK_F21 = &H84 ' dec = 132, F21 key

Const VK_F22 = &H85 ' dec = 133, F22 key

Const VK_F23 = &H86 ' dec = 134, F23 key

Const VK_F24 = &H87 ' dec = 135, F24 key

'??? = &H88-8F ' dec = 136-143, Reserved

Const VK_NUMLOCK = &H90 ' dec = 144, NUM LOCK key

Const VK_SCROLL = &H91 ' dec = 145, SCROLL LOCK key

'??? = &H92-96 ' dec = 146-150, OEM specific

'??? = &H97-9F ' dec = 151-159, Unassigned

Const VK_LSHIFT = &HA0 ' dec = 160, Left SHIFT key

Const VK_RSHIFT = &HA1 ' dec = 161, Right SHIFT key

Const VK_LCONTROL = &HA2 ' dec = 162, Left CONTROL key

Const VK_RCONTROL = &HA3 ' dec = 163, Right CONTROL key

Const VK_LMENU = &HA4 ' dec = 164, Left ALT key

Const VK_RMENU = &HA5 ' dec = 165, Right ALT key

Const VK_BROWSER_BACK = &HA6 ' dec = 166, Browser Back key

Const VK_BROWSER_FORWARD = &HA7 ' dec = 167, Browser Forward key

Const VK_BROWSER_REFRESH = &HA8 ' dec = 168, Browser Refresh key

Const VK_BROWSER_STOP = &HA9 ' dec = 169, Browser Stop key

Const VK_BROWSER_SEARCH = &HAA ' dec = 170, Browser Search key

Const VK_BROWSER_FAVORITES = &HAB ' dec = 171, Browser Favorites key

Const VK_BROWSER_HOME = &HAC ' dec = 172, Browser Start and Home key

Const VK_VOLUME_MUTE = &HAD ' dec = 173, Volume Mute key

Const VK_VOLUME_DOWN = &HAE ' dec = 174, Volume Down key

Const VK_VOLUME_UP = &HAF ' dec = 175, Volume Up key

Const VK_MEDIA_NEXT_TRACK = &HB0 ' dec = 176, Next Track key

Const VK_MEDIA_PREV_TRACK = &HB1 ' dec = 177, Previous Track key

Const VK_MEDIA_STOP = &HB2 ' dec = 178, Stop Media key

Const VK_MEDIA_PLAY_PAUSE = &HB3 ' dec = 179, Play/Pause Media key

Const VK_LAUNCH_MAIL = &HB4 ' dec = 180, Start Mail key

Const VK_LAUNCH_MEDIA_SELECT = &HB5 ' dec = 181, Select Media key

Const VK_LAUNCH_APP1 = &HB6 ' dec = 182, Start Application 1 key

Const VK_LAUNCH_APP2 = &HB7 ' dec = 183, Start Application 2 key

'??? = &HB8-B9 ' dec = 184-137, Reserved

Const VK_OEM_1 = &HBA ' dec = 186, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the ;: key

Const VK_OEM_PLUS = &HBB ' dec = 187, For any country/region, the + key

Const VK_OEM_COMMA = &HBC ' dec = 188, For any country/region, the , key

Const VK_OEM_MINUS = &HBD ' dec = 189, For any country/region, the - key

Const VK_OEM_PERIOD = &HBE ' dec = 190, For any country/region, the . key

Const VK_OEM_2 = &HBF ' dec = 191, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the /? key

Const VK_OEM_3 = &HC0 ' dec = 192, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the `~ key

'??? = &HC1-DA ' dec = 193-218, Reserved

Const VK_OEM_4 = &HDB ' dec = 219, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the [{ key

Const VK_OEM_5 = &HDC ' dec = 220, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the \\| key

Const VK_OEM_6 = &HDD ' dec = 221, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the ]} key

Const VK_OEM_7 = &HDE ' dec = 222, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the '" key

Const VK_OEM_8 = &HDF ' dec = 223, Used for miscellaneous characters; it can vary by keyboard.

'??? = &HE0 ' dec = 224, Reserved

'??? = &HE1 ' dec = 225, OEM specific

Const VK_OEM_102 = &HE2 ' dec = 226, The <> keys on the US standard keyboard, or the \\| key on the non-US 102-key keyboard

'??? = &HE3-E4 ' dec = 227-228, OEM specific

Const VK_PROCESSKEY = &HE5 ' dec = 229, IME PROCESS key

'??? = &HE6 ' dec = 230, OEM specific

Const VK_PACKET = &HE7 ' dec = 231, Used to pass Unicode characters as if they were keystrokes. The VK_PACKET key is the low word of a 32-bit Virtual Key value used for non-keyboard input methods. For more information, see Remark in KEYBDINPUT, SendInput, WM_KEYDOWN, and WM_KEYUP

'??? = &HE8 ' dec = 232, Unassigned

'??? = &HE9-F5 ' dec = 233-245, OEM specific

Const VK_ATTN = &HF6 ' dec = 246, Attn key

Const VK_CRSEL = &HF7 ' dec = 247, CrSel key

Const VK_EXSEL = &HF8 ' dec = 248, ExSel key

Const VK_EREOF = &HF9 ' dec = 249, Erase EOF key

Const VK_PLAY = &HFA ' dec = 250, Play key

Const VK_ZOOM = &HFB ' dec = 251, Zoom key

Const VK_NONAME = &HFC ' dec = 252, Reserved

Const VK_PA1 = &HFD ' dec = 253, PA1 key

Const VK_OEM_CLEAR = &HFE ' dec = 254, Clear key

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' END Virtual-Key Codes

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END CONSTANTS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN TYPE DECLARATIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' UDT TO HOLD THE INFO FOR EACH MOUSE (READ MICE MAIN)

Type MouseInfoType

    ' ReadMiceMain, ReadMiceSub:

    ID As String ' player identifier or mouse device ID

    ' ReadMiceMain:

    char As String ' cursor character

    ' ReadMiceMain:

    color As _Unsigned Long ' character color = ~&MyColor (OLD=Integer)

    row As Integer ' line to display values at

    ' ReadMiceMain, ReadMiceSub:

    UpdateCount As Integer ' if this value changes we know a value changed

    ' ReadMiceMain:

    OldUpdateCount As Integer ' if this value changes we know a value changed

    ' ReadMiceMain:

    x As Integer ' screen x position

    y As Integer ' screen y position

    ' ReadMiceMain, ReadMiceSub:

    dx As Integer ' mouse x movement -1=left, 1=right, 0=none

    dy As Integer ' mouse y movement -1=up  , 1=down , 0=none

    ' ReadMiceMain:

    oldX As Integer ' tracks old x position to erase screen

    oldY As Integer ' tracks old y position to erase screen

    ' ReadMiceMain:

    countX As Integer ' increments by 1 every time mouse moves, when x movement count exceeds threshold cMouseSpeedX, send dx

    countY As Integer ' increments by 1 every time mouse moves, when y movement count exceeds threshold cMouseSpeedY, send dy

    ' ReadMiceMain, ReadMiceSub:

    pdx As Long ' x delta (hires) for absolute position of mouse from raw input api

    pdy As Long ' y delta (hires) for absolute position of mouse from raw input api

    ' ReadMiceMain, ReadMiceSub:

    px As Long ' pointer x position (hires) for absolute position of mouse from raw input api

    py As Long ' pointer y position (hires) for absolute position of mouse from raw input api

    ' ReadMiceMain:

    pxOld As Long ' old pointer x position (hires) for absolute position of mouse from raw input api

    pyOld As Long ' old pointer y position (hires) for absolute position of mouse from raw input api

    ' ReadMiceMain, ReadMiceSub:

    wheel As Integer ' mouse wheel value

    ' ReadMiceMain, ReadMiceSub:

    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

    ' ReadMiceMain

    wheelOld As Integer ' old mouse wheel value

    LeftDownOld As Integer ' tracks left mouse button state, TRUE=down

    MiddleDownOld As Integer ' tracks middle mouse button state, TRUE=down

    RightDownOld As Integer ' tracks right mouse button state, TRUE=down

    ' ReadMiceMain

    LeftCount As Integer ' counts left clicks

    MiddleCount As Integer ' counts middle clicks

    RightCount As Integer ' counts right clicks

    ' Text to display

    Message As String

End Type ' MouseInfoType

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END TYPE DECLARATIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN API DECLARATIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ================================================================================================================================================================

' BEGIN Dynamic Library definitions

' ================================================================================================================================================================

Declare Dynamic Library "user32"

    ' FOR CONTROLLING WINDOW ON TOP, ETC.:

    Function FindWindowA%& (ByVal lpClassName%&, Byval lpWindowName%&)

    Function SetWindowPos& (ByVal hWnd%&, Byval hWndInsertAfter%&, Byval X&, Byval Y&, Byval cx&, Byval cy&, Byval uFlags~&)

    Function GetForegroundWindow%&

    ' FOR CONTROLLING SUB WINDOW FOCUS:

    Sub ShowWindow (ByVal hWnd As _Offset, Byval nCmdShow As Long)

End Declare

Declare Dynamic Library "kernel32"

    Function GetLastError~& ()

End Declare

' ================================================================================================================================================================

' END Dynamic Library definitions

' ================================================================================================================================================================

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' 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)

Dim Shared m_VersionNum$: m_VersionNum$ = GetVersionNum$(m_ProgramName$)

' GLOBAL VARIABLES TO TRACK ERROR STATE

Dim Shared m_sError As String: m_sError = ""

Dim Shared m_sIncludeError As String: m_sIncludeError = ""

Dim Shared m_sTriggerFile As String: m_sTriggerFile = m_ProgramPath$ + "ReadMiceSub.DELETE-TO-CLOSE"

Dim Shared m_sDebugFile As String: m_sDebugFile = m_ProgramPath$ + m_ProgramName$ + ".txt"

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END GLOBAL VARIABLES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ****************************************************************************************************************************************************************

' BEGIN DEBUG CONSOLE

' ****************************************************************************************************************************************************************

' ENABLE / DISABLE DEBUG CONSOLE WINDOW

If cDebugEnabled = 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 cDebugEnabled = 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 arrMouse(0 To 8) As MouseInfoType ' STORES INFO FOR EACH MOUSE

    Dim iMouseCount As Integer ' # OF MICE ATTACHED

    ' WINDOW VARIABLES

    Dim hWndThis As _Offset ' hWndThis%&

    Dim hWndTop As _Offset ' x%&

    ' OTHER VARS

    Dim iLoop1 As Integer

    Dim iLoop2 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 iStartRow As Integer

    Dim arrColor(0 To 40) As _Unsigned Long ' ~&arrColor (OLD=Integer)

    Dim in$

    Dim iNextX As Integer

    Dim iNextY As Integer

    ' VARIABLES FOR READING MICE FROM CLIENT

    Dim uintPort As _Unsigned Integer ' port

    Dim lngHost ' h&

    Dim lngConn ' c&

    Dim sInput As String ' s$

    Dim sMessageType As String

    Dim sValue As String

    ' FOR LOOPING THROUGH DATA

    ReDim arrMice(-1 To -1) As String

    ReDim arrMessage(-1 To -1) As String

    ReDim arrValue(-1 To -1) As String

    Dim sNextChunk As String

    Dim sNextValue As String

    Dim iValuePosition As Integer

    Dim sText As String

    ' FOR CONTROLLING WINDOW FOCUS

    Dim hwndSub As _Offset

    ' MOUSE READER PROG

    Dim sMouseReaderProg As String

    ' CONTROLS MIN/MAX SCREEN POSITIONS

    Dim iMinX As Integer

    Dim iMaxX As Integer

    Dim iMinY As Integer

    Dim iMaxY As Integer

    ' BASELINE STARTING POSITION

    Dim iStartX As Integer

    Dim iStartY As Integer

    Dim iKeyLoop As Integer

    Dim iKeyCode As Integer

    Dim iLastKeyDown As Integer

    Dim iLastKeyUp As Integer

    Dim sLastKeyDown As String

    Dim sLastKeyUp As String

    Dim sResult As String

    Dim MyTime##

    Dim imgBackground& ' NEEDS _FREEIMAGE AT END

    Dim imgWalls& ' NEEDS _FREEIMAGE AT END

    Dim imgText& ' NEEDS _FREEIMAGE AT END

    Dim imgPlayers& ' NEEDS _FREEIMAGE AT END

    Dim imgScore& ' NEEDS _FREEIMAGE AT END

    Dim screen_color~&

    Dim wall_color~&

    Dim screen_width%

    Dim screen_height%

    Dim x%

    Dim y%

    Dim message$

    ' INITIALIZE

    screen_width% = 1024 ' _DesktopWidth

    screen_height% = 768 ' _DesktopHeight

    screen_color~& = cBlack~&

    wall_color~& = cWhite~&

    iMinX = 0 ' 1 ' 2

    iMaxX = screen_width% ' 1024 ' _DesktopWidth ' (_DesktopWidth \ _FontWidth) - 1 ' _Width(0) \ _FontWidth ' 128 ' 80 ' 79

    iMinY = 0 ' 14 ' 1

    iMaxY = screen_height% ' 768 ' _DesktopHeight ' (_DesktopHeight \ _FontHeight) - 1 ' _Height(0) \ _FontHeight ' 48 ' 30

    iStartX = iMinX + 75

    iStartY = iMaxY - 54

    iLastKeyDown = 0

    iLastKeyUp = 0

    sLastKeyDown = "(None)"

    sLastKeyUp = "(None)"

    iStartRow = 5 ' text row to display mouse info at

    ' =============================================================================

    ' SET ERROR TRAPPING

    On Error GoTo ErrorHandler

    ' =============================================================================

    ' OPEN A PORT TO TALK TO THE MOUSE READER

    Randomize Timer

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

    '' DEBUG! ***********************************************************************************************************************************************

    'If cDebugEnabled = TRUE Then

    '    'Print "uintPort = Rnd * 10000 + 40000 = " + _Trim$(Str$(uintPort))

    '    DebugLog "uintPort = Rnd * 10000 + 40000 = " + _Trim$(Str$(uintPort))

    'End If

    '' DEBUG! ***********************************************************************************************************************************************

    lngHost = _OpenHost("tcp/ip:" + _Trim$(Str$(uintPort)))

    'Print lngHost

    '' DEBUG! ***********************************************************************************************************************************************

    'If cDebugEnabled = TRUE Then

    '    'Print "lngHost = _OpenHost(" + Chr$(34) + "tcp/ip:" + Chr$(34) + "_Trim$(Str$(uintPort))) = " + _Trim$(Str$(lngHost))

    '    DebugLog "lngHost = _OpenHost(" + Chr$(34) + "tcp/ip:" + Chr$(34) + "_Trim$(Str$(uintPort))) = " + _Trim$(Str$(lngHost))

    'End If

    '' DEBUG! ***********************************************************************************************************************************************

    ' =============================================================================

    ' START THE MOUSE READER PROGRAM

    sMouseReaderProg = "readmicesub" + m_VersionNum$ + ".exe"

    If _FileExists(sMouseReaderProg) = FALSE Then

        'If cDebugEnabled = TRUE Then

        '    DebugLog "Subprogram " + Chr$(34) + sMouseReaderProg + Chr$(34) + " not found."

        '    DebugLog "Be sure to compile " + Chr$(34) + "readmicesub" + m_VersionNum$ + ".bas" + Chr$(34) + " before running this."

        'End If

        Print "Subprogram " + Chr$(34) + sMouseReaderProg + Chr$(34) + " not found."

        Print "Be sure to compile " + Chr$(34) + "readmicesub" + m_VersionNum$ + ".bas" + Chr$(34) + " before running this."

        Print "PRESS ANY KEY TO EXIT"

        Sleep

    End If

    'Shell _DontWait "readmicesub39.exe " + _Trim$(Str$(uintPort))

    Shell _DontWait "readmicesub" + m_VersionNum$ + ".exe " + _Trim$(Str$(uintPort))

    ' =============================================================================

    ' GET CONNECTION WITH MOUSE READER

    lngConn = 0

    While lngConn = 0

        lngConn = _OpenConnection(lngHost)

        _Limit 60

    Wend

    '' DEBUG! ***********************************************************************************************************************************************

    'If cDebugEnabled = TRUE Then

    '    Print "lngConn = _OpenConnection(lngHost) = " + _Trim$(Str$(lngConn))

    '    DebugLog "lngConn = _OpenConnection(lngHost) = " + _Trim$(Str$(lngConn))

    'End If

    '' DEBUG! ***********************************************************************************************************************************************

    ' =============================================================================

    'GET SUB WINDOW HANDLE FROM CONNECTION...

    '_Delay 2

    'Get #lngConn, , sInput

    ' TRY FOR 30 SECONDS

    MyTime## = ExtendedTimer + 30

    sInput = ""

    Do

        '_Delay 2

        Get #lngConn, , sInput

        If Left$(sInput, 2) = "w:" Then Exit Do

    Loop Until Timer > MyTime##

    If Right$(sInput, 1) = Chr$(13) Then sInput = Left$(sInput, Len(sInput) - 1)

    '' DEBUG! ***********************************************************************************************************************************************

    'If cDebugEnabled = TRUE Then

    '    DebugLog "Get #lngConn, , sInput"

    '    DebugLog "Get #" + _Trim$(Str$(lngConn)) + ", , " + Chr$(34) + sInput + Chr$(34)

    '

    '    'Print "Get #lngConn, , sInput = " + Chr$(34) + sInput + Chr$(34)

    '    'Print "hwndSub = Val(sInput) = " + _Trim$(Str$(hwndSub))

    '    'Print "PRESS ENTER TO CONTINUE"

    '    'Sleep

    'End If

    '' DEBUG! ***********************************************************************************************************************************************

    If Left$(sInput, 2) = "w:" Then

        sValue = Right$(sInput, Len(sInput) - 2)

        'if len( Replace$(sValue, chr$(13), "") ) <> len(sValue) then DebugLog "response had chr$(13)"

        If IsNumber%(sValue) Then

            hwndSub = Val(sValue)

        Else

            m_sError = "Mouse reader subprogram failed to return a valid window handle."

            m_sError = m_sError + Chr$(13)

            m_sError = m_sError + "sInput=" + Chr$(34) + sInput + Chr$(34) + Chr$(13)

            m_sError = m_sError + "sValue=" + Chr$(34) + sValue + Chr$(34) + Chr$(13)

        End If

    ElseIf Left$(sInput, 2) = "e:" Then

        If Len(sInput) > 2 Then

            m_sError = Right$(sInput, Len(sInput) - 2)

        Else

            m_sError = "Unspecified error."

        End If

    Else

        m_sError = "Mouse reader subprogram failed to return a window handle."

        m_sError = m_sError + Chr$(13)

        m_sError = m_sError + "sInput=" + Chr$(34) + sInput + Chr$(34) + Chr$(13)

    End If

    ' IF NO ERRORS, CONTINUE

    If Len(m_sError) = 0 Then

        ' =============================================================================

        ' INITIALIZE VARIABLES

        ' INITALIZE COLORS

        arrColor(0) = cBlack

        arrColor(1) = cRed

        arrColor(2) = cDarkOrange

        arrColor(3) = cYellow

        arrColor(4) = cLime

        arrColor(5) = cCyan

        arrColor(6) = cBlue

        arrColor(7) = cDeepPurple

        arrColor(8) = cMagenta

        ' INITIALIZE USER DATA

        iNextX = iStartX

        iNextY = iStartY

        iCount = 0

        For iIndex = LBound(arrMouse) To UBound(arrMouse)

            iCount = iCount + 1

            arrMouse(iIndex).ID = "Mouse" + _Trim$(Str$(iCount))

            arrMouse(iIndex).char = Chr$(64 + iCount)

            arrMouse(iIndex).color = arrColor(iCount)

            arrMouse(iIndex).row = iCount + iStartRow

            arrMouse(iIndex).UpdateCount = 0

            arrMouse(iIndex).OldUpdateCount = 0

            arrMouse(iIndex).x = 0

            arrMouse(iIndex).y = 0

            arrMouse(iIndex).dx = 0

            arrMouse(iIndex).dy = 0

            arrMouse(iIndex).oldX = 0

            arrMouse(iIndex).oldY = 0

            arrMouse(iIndex).countX = 0

            arrMouse(iIndex).countY = 0

            arrMouse(iIndex).pdx = 0

            arrMouse(iIndex).pdy = 0

            arrMouse(iIndex).px = iNextX

            arrMouse(iIndex).py = iNextY

            arrMouse(iIndex).pxOld = arrMouse(iIndex).px

            arrMouse(iIndex).pyOld = arrMouse(iIndex).py

            ' POSITION NEXT PLAYER

            iNextX = iNextX + 75

            iNextY = iNextY - 54

            arrMouse(iIndex).wheel = 0

            arrMouse(iIndex).wheelOld = 0

            arrMouse(iIndex).LeftDown = FALSE

            arrMouse(iIndex).LeftDownOld = FALSE

            arrMouse(iIndex).MiddleDown = FALSE

            arrMouse(iIndex).MiddleDownOld = FALSE

            arrMouse(iIndex).RightDown = FALSE

            arrMouse(iIndex).RightDownOld = FALSE

            arrMouse(iIndex).LeftCount = 0

            arrMouse(iIndex).MiddleCount = 0

            arrMouse(iIndex).RightCount = 0

            arrMouse(iIndex).Message = ""

        Next iIndex

        ' ================================================================================================================================================================

        ' SETUP SCREEN + LAYERS

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' INIT SCREEN

        'Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)

        'Screen _NewImage(1024, 768, 32)

        Screen _NewImage(screen_width%, screen_height%, 32)

        ' window needs to be lined up directly under the main program, so the mouse coordinates align with the display

        _ScreenMove 0, 0

        ' CLEAR THE SCREEN

        _Dest 0: Cls , cEmpty

        ' update screen with changes & wait for next update

        _Display

        '' ATTEMPT FULLSCREEN <- NOT REALLY WORKING

        '_FULLSCREEN _STRETCH, _SMOOTH

        'IF _FULLSCREEN = 0 THEN _FULLSCREEN _OFF 'check that a full screen mode initialized

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' INIT LAYERS

        imgBackground& = _NewImage(screen_width%, screen_height%, 32)

        imgWalls& = _NewImage(screen_width%, screen_height%, 32)

        imgText& = _NewImage(screen_width%, screen_height%, 32)

        imgPlayers& = _NewImage(screen_width%, screen_height%, 32)

        imgScore& = _NewImage(screen_width%, screen_height%, 32)

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' DRAW THE BACKGROUND LAYER

        '_Dest 0: Cls , cBlack ' CLEAR THE SCREEN

        _Dest imgBackground&: Cls , screen_color~&

        'LINE (0, 0)-(screen_width%, screen_height%), screen_color~&, BF ' Draw a solid box

        ' DRAW CENTER LINE

        For y% = 44 To (screen_height% - 48) Step 20

            Line ((screen_width% / 2) - 2, y%)-((screen_width% / 2) + 2, y% + 10), wall_color~&, BF

        Next y%

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' DRAW THE WALLS LAYER

        _Dest imgWalls&: Cls , cEmpty

        ' DRAW WALLS AROUND EDGES

        For x% = 7 To screen_width% Step 20

            Line (x%, 40)-(x% + 10, 44), wall_color~&, BF

            Line (x%, screen_height% - 50)-(x% + 10, screen_height% - 54), wall_color~&, BF

        Next x%

        'DrawRectSolid (iX As Integer, iY As Integer, iSizeW As Integer, iSizeH As Integer, fgColor As _Unsigned Long)

        'DrawBoxSolid (iX As Integer, iY As Integer, iSize As Integer, fgColor As _Unsigned Long)

        '' GET BOUNDARIES

        'ball_min_x% = 1

        'ball_max_x% = screen_width%

        'ball_min_y% = 45

        'ball_max_y% = screen_height% - (54 + ball_size% + 1)

        'player_1_min_y% = 45

        'player_1_max_y% = screen_height% - (54 + player_1_height% + 1)

        'player_2_min_y% = 45

        'player_2_max_y% = screen_height% - (54 + player_2_height% + 1)

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' DRAW THE INSTRUCTIONS LAYER

        _Dest imgText&: Cls , cEmpty

        ' TEXT SCREEN AT 1024X768 IS 48 LINES X 128 CHARACTERS WIDE

        ' PRINT INSTRUCTIONS

        Color cWhite, cEmpty

        'message$ = "AVOID MISSING BALL FOR HIGH SCORE"

        message$ = "PLUG IN 2 OR MORE USB MICE, MOVE THEM AROUND, CLICK BUTTONS, PRESS KEYS ON KEYBOARD."

        Locate 1, 64 - (Len(message$) / 2): Print message$;

        ' SHOW MORE INSTRUCTIONS

        Color cWhite, cEmpty

        message$ = "TO EXIT PRESS <ESC> OR DELETE FILE " + Chr$(34) + "ReadMiceSub.DELETE-TO-CLOSE" + Chr$(34) + "."

        Locate 47, 64 - (Len(message$) / 2): Print message$;

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' DRAW THE SCORE LAYER

        _Dest imgScore&: Cls , cEmpty

        ' PRINT INITIAL SCORE

        Color cCyan, cEmpty

        Locate 2, 32: Print "LAST KEY DOWN: ";

        Locate 2, 96: Print "LAST KEY UP  : ";

        ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

        ' DRAW THE PLAYERS LAYER

        _Dest imgPlayers&: Cls , cEmpty

        ' ================================================================================================================================================================

        ' MAIN LOOP

        Do

            ' KEEP READMICESUB WINDOW ON TOP

            If _WindowHasFocus = TRUE Then

                '_ScreenIcon

                ShowWindow hwndSub, 1

            End If

            ' -----------------------------------------------------------------------------

            ' READ MICE COORDINATES FROM CONNECTION...

            Get #lngConn, , sInput

            'If Right$(sInput, 1) = Chr$(13) Then sInput = Left$(sInput, Len(sInput) - 1)

            ' DID IT WORK?

            If Len(m_sError) = 0 Then

                ''DebugPrint "    GOT DATA FROM CONNECTION"

                ''DebugPrint "    sInput=" + chr$(34) + sInput + chr$(34)

                ' HAVE DATA?

                If Len(sInput) > 0 Then

                    'DebugPrint "    GOT DATA FROM CONNECTION"

                    'DebugPrint "    sInput=" + chr$(34) + sInput + chr$(34)

                    ' * The subprogram "ReadMiceSub" sends its data back to "ReadMiceMain"

                    '   via TCPIP in the form of a tab-delimited string. Tab is chr$(9).

                    '   Sometimes it sends multiple messages, which are separated by chr$(13).

                    '   Here we split the input by chr$(13) and process each line seperately,

                    '   which should make concurrent input smoother:

                    split sInput, Chr$(13), arrMessage() ' SPLIT OUTPUT INTO PAGES

                    For iLoop2 = LBound(arrMessage) To UBound(arrMessage)

                        sInput = arrMessage(iLoop2)

                        ' WHAT KIND OF MESSAGE?

                        sMessageType = Left$(sInput, 2)

                        'DebugPrint "    sMessageType=" + chr$(34) + sMessageType + chr$(34)

                        If sMessageType = "d:" Then

                            ' KEY DOWN

                            sValue = Right$(sInput, Len(sInput) - 2)

                            If IsNumber%(sValue) Then

                                iLastKeyDown = Val(sValue)

                                sLastKeyDown = VirtualKeyCodeToString$(iLastKeyDown)

                            Else

                                iLastKeyDown = 0

                                sLastKeyDown = Chr$(34) + sValue + Chr$(34) + " IS NOT A NUMGBER"

                            End If

                        ElseIf sMessageType = "u:" Then

                            ' KEY UP

                            sValue = Right$(sInput, Len(sInput) - 2)

                            If IsNumber%(sValue) Then

                                iLastKeyUp = Val(sValue)

                                sLastKeyUp = VirtualKeyCodeToString$(iLastKeyUp)

                            Else

                                iLastKeyUp = 0

                                sLastKeyUp = Chr$(34) + sValue + Chr$(34) + " IS NOT A NUMGBER"

                            End If

                        ElseIf sMessageType = "m:" Then

                            ' SPLIT INPUT INTO VALUES

                            ' cForPlayer cMouseDX cMouseDY cMousePosX cMousePosY cMouseWheel cMouseLeftDown cMouseMiddleDown cMouseRightDown

                            ' {mouse #}\t{dx}\t{dy}\t{pos x}\t{pos y}\t{wheel}\t{leftDown}\t{middleDown}\t{rightDown}\n

                            sValue = Right$(sInput, Len(sInput) - 2)

                            split sValue, Chr$(9), arrValue() ' SPLIT OUTPUT INTO PAGES

                            ' PROCESS VALUES

                            iIndex = -1

                            iValuePosition = 0

                            For iLoop1 = LBound(arrValue) To UBound(arrValue)

                                ' TRACK WHAT VALUE # WE'RE ON

                                iValuePosition = iValuePosition + 1

                                'DebugPrint "            iValuePosition = " + _Trim$(Str$(iValuePosition))

                                'DebugPrint "            arrValue(" + _Trim$(Str$(iLoop1)) + ")"

                                ' GET VALUE

                                sNextValue = _Trim$(arrValue(iLoop1))

                                'DebugPrint "            sNextValue=" + Chr$(34) + sNextValue + Chr$(34)

                                ' IS IT A VALID INTEGER?

                                If IsNumber%(sNextValue) Then

                                    ' DETERMINE WHICH VALUE IT IS FROM ORDINAL POSITION IN THE INPUT

                                    ' AND WRITE TO APPROPRIATE VARIABLE

                                    Select Case iValuePosition

                                        Case cForPlayer

                                            ' THIS VALUE TELLS US WHO IT'S FOR

                                            iIndex = Val(sNextValue)

                                            'DebugPrint "                PLAYER #" + _Trim$(Str$(iIndex))

                                            ''Case cUpdateCount

                                            ''   ' THIS VALUE TELLS US IF THERE IS NEW INPUT

                                            ''   arrMouse(iIndex).UpdateCount = Val(sNextValue)

                                            ''   DebugPrint "                UpdateCount = " + _Trim$(Str$(arrMouse(iIndex).UpdateCount))

                                        Case cMouseDX:

                                            ' READ RAW VALUE

                                            arrMouse(iIndex).dx = Val(sNextValue)

                                            'DebugPrint "                DX = " + _Trim$(Str$(arrMouse(iIndex).dx))

                                        Case cMouseDY:

                                            ' READ RAW VALUE

                                            arrMouse(iIndex).dy = Val(sNextValue)

                                            'DebugPrint "                DY = " + _Trim$(Str$(arrMouse(iIndex).dy))

                                        Case cMousePosX:

                                            ' READ RAW VALUE

                                            arrMouse(iIndex).px = Val(sNextValue)

                                        Case cMousePosY:

                                            ' READ RAW VALUE

                                            arrMouse(iIndex).py = Val(sNextValue)

                                        Case cMouseWheel:

                                            '' READ RAW VALUE

                                            'arrMouse(iIndex).wheel = Val(sNextValue)

                                        Case cMouseLeftDown:

                                            ' READ RAW VALUE

                                            arrMouse(iIndex).LeftDown = Val(sNextValue)

                                            ' DID VALUE CHANGE?

                                            If arrMouse(iIndex).LeftDown <> arrMouse(iIndex).LeftDownOld Then

                                                If arrMouse(iIndex).LeftDown = TRUE Then

                                                    ' CLICKED BUTTON

                                                Else

                                                    ' RELEASED BUTTON

                                                End If

                                                arrMouse(iIndex).LeftDownOld = arrMouse(iIndex).LeftDown

                                            End If

                                        Case cMouseMiddleDown:

                                            ' READ RAW VALUE

                                            arrMouse(iIndex).MiddleDown = Val(sNextValue)

                                            ' DID VALUE CHANGE?

                                            If arrMouse(iIndex).MiddleDown <> arrMouse(iIndex).MiddleDownOld Then

                                                If arrMouse(iIndex).MiddleDown = TRUE Then

                                                    ' CLICKED BUTTON

                                                Else

                                                    ' RELEASED BUTTON

                                                End If

                                                arrMouse(iIndex).MiddleDownOld = arrMouse(iIndex).MiddleDown

                                            End If

                                        Case cMouseRightDown:

                                            ' READ RAW VALUE

                                            arrMouse(iIndex).RightDown = Val(sNextValue)

                                            ' DID VALUE CHANGE?

                                            If arrMouse(iIndex).RightDown <> arrMouse(iIndex).RightDownOld Then

                                                If arrMouse(iIndex).RightDown = TRUE Then

                                                    ' CLICKED BUTTON

                                                Else

                                                    ' RELEASED BUTTON

                                                End If

                                                arrMouse(iIndex).RightDownOld = arrMouse(iIndex).RightDown

                                            End If

                                        Case Else:

                                            ' Unknown

                                    End Select

                                    ''' EXIT IF VALUES HAVEN'T CHANGED

                                    ''If iLoop1 > cUpdateCount Then

                                    ''   If arrMouse(iIndex).UpdateCount = arrMouse(iIndex).OldUpdateCount Then

                                    ''       ' STOP THE MOUSE DX / DY

                                    ''       arrMouse(iIndex).dy = 0

                                    ''       arrMouse(iIndex).dx = 0

                                    ''

                                    ''       DebugPrint "                UpdateCount HASN'T CHANGED FROM OLD:"

                                    ''       DebugPrint "                OldUpdateCount = " + _Trim$(Str$(arrMouse(iIndex).OldUpdateCount))

                                    ''       DebugPrint "                EXITING CHUNK..."

                                    ''

                                    ''       ' WE CAN STOP PROCESSING THIS CHUNK

                                    ''       Exit For

                                    ''   End If

                                    ''End If

                                Else

                                    'DebugPrint "                " + _

                                    '    "Value " + _

                                    '    chr$(34) + sNextValue + chr$(34) + " " + _

                                    '    "at position " + _

                                    '    _Trim$(Str$(iLoop1)) + " " + _

                                    '    "(" + MouseDataPositionToString(iLoop1) + ") " + _

                                    '    "is not a number."

                                    '

                                    ''sNextValue

                                    ''DebugPrint "                ** sNextValue NOT A NUMBER: " + chr$(34) + sNextValue + chr$(34)

                                    '' (VALUE ISN'T A NUMBER)

                                    '' (DO NOTHING)

                                End If

                            Next iLoop1

                            '' UPDATE OLD VALUE FOR NEXT CHANGE TEST

                            'If arrMouse(iIndex).UpdateCount <> arrMouse(iIndex).OldUpdateCount Then

                            '   arrMouse(iIndex).OldUpdateCount = arrMouse(iIndex).UpdateCount

                            'End If

                        ElseIf sMessageType = "e:" Then

                            sValue = Right$(sInput, Len(sInput) - 2)

                            'DebugPrint "    Received error message from subprogram: " + sValue

                        Else

                            'DebugPrint "    Message type from subprogram not recognized: " + sInput

                        End If

                    Next iLoop2

                Else

                    ' RETRIEVED DATA IS EMPTY

                    ''DebugPrint "    DATA IS EMPTY"

                    ' (JUST IGNORE FOR NOW)

                    ' TODO:

                    ' WE SHOULD QUIT IF NO DATA IS RETRIEVED IN A CERTAIN THRESHOLD OF TIME...

                End If

            Else

                ' ERROR RETRIEVING DATA...

                'DebugPrint "    ERROR RETRIEVING DATA FROM CONNECTION: " + m_sError

                ' (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

                ' TODO:

                ' WE SHOULD QUIT HERE, AND RESTART THE CLIENT...

            End If

            ' ================================================================================================================================================================

            ' UPDATE DISPLAY

            ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

            ' DRAW THE SCORE LAYER

            _Dest imgScore&: Cls , cEmpty

            ' SHOW HEADER ROW

            Color cWhite, cEmpty

            iRow = iStartRow: iCol = 5

            PrintString1 iRow, iCol, "MOUSE": iCol = iCol + 9

            PrintString1 iRow, iCol, "X POS": iCol = iCol + 9

            PrintString1 iRow, iCol, "Y POS": iCol = iCol + 9

            PrintString1 iRow, iCol, "LEFT": iCol = iCol + 9

            PrintString1 iRow, iCol, "MIDDLE": iCol = iCol + 9

            PrintString1 iRow, iCol, "RIGHT": iCol = iCol + 9

            ' SHOW VALUES FOR EACH MOUSE

            For iIndex = LBound(arrMouse) To UBound(arrMouse)

                If iIndex > -1 Then

                    Color arrMouse(iIndex).color, cEmpty

                    iRow = arrMouse(iIndex).row: iCol = 5

                    PrintString1 iRow, iCol, _Trim$(Str$(iIndex)): iCol = iCol + 9

                    PrintString1 iRow, iCol, _Trim$(Str$(arrMouse(iIndex).px)): iCol = iCol + 9

                    PrintString1 iRow, iCol, _Trim$(Str$(arrMouse(iIndex).py)): iCol = iCol + 9

                    If arrMouse(iIndex).LeftDown Then

                        Color cEmpty, arrMouse(iIndex).color

                    Else

                        Color arrMouse(iIndex).color, cEmpty

                    End If

                    PrintString1 iRow, iCol, "1": iCol = iCol + 9

                    If arrMouse(iIndex).MiddleDown Then

                        Color cEmpty, arrMouse(iIndex).color

                    Else

                        Color arrMouse(iIndex).color, cEmpty

                    End If

                    PrintString1 iRow, iCol, "2": iCol = iCol + 9

                    If arrMouse(iIndex).RightDown Then

                        Color cEmpty, arrMouse(iIndex).color

                    Else

                        Color arrMouse(iIndex).color, cEmpty

                    End If

                    PrintString1 iRow, iCol, "3": iCol = iCol + 9

                End If

            Next iIndex

            ' SHOW KEYBOARD INPUT

            Color cCyan, cEmpty

            Locate 2, 32: Print "LAST KEY DOWN: " + sLastKeyDown;

            Locate 2, 96: Print "LAST KEY UP  : " + sLastKeyUp;

            ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

            ' DRAW THE PLAYERS LAYER

            _Dest imgPlayers&: Cls , cEmpty

            For iIndex = LBound(arrMouse) To UBound(arrMouse)

                If iIndex > -1 Then

                    ' COLLECT VALUES FOR THIS MOUSE IN A STRING

                    sText = ""

                    sText = sText + _Trim$(Str$(iIndex))

                    'sText = sText + " ("

                    'sText = sText + _Trim$(Str$(arrMouse(iIndex).px))

                    'sText = sText + ","

                    'sText = sText + _Trim$(Str$(arrMouse(iIndex).py))

                    'sText = sText + ") "

                    'sText = sText + " "

                    'sText = sText + IIFS$(arrMouse(iIndex).LeftDown, "1", " ")

                    'sText = sText + IIFS$(arrMouse(iIndex).MiddleDown, "2", " ")

                    'sText = sText + IIFS$(arrMouse(iIndex).RightDown, "3", " ")

                    arrMouse(iIndex).Message = sText

                    'DrawRectSolid (iX As Integer, iY As Integer, iSizeW As Integer, iSizeH As Integer, fgColor As _Unsigned Long)

                    'DrawBoxSolid (iX As Integer, iY As Integer, iSize As Integer, fgColor As _Unsigned Long)

                    DrawBoxSolid arrMouse(iIndex).px, arrMouse(iIndex).py, 32, arrMouse(iIndex).color

                    Color cBlack, arrMouse(iIndex).color

                    _PrintString (arrMouse(iIndex).px + 8, arrMouse(iIndex).py + 8), arrMouse(iIndex).Message

                End If

            Next iIndex

            ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

            ' COPY LAYERS TO SCREEN AND UPDATE DISPLAY

            ' CLEAR THE SCREEN

            _Dest 0: Cls , cEmpty

            ' Add the background

            _PutImage , imgBackground&, 0

            ' Add the walls

            _PutImage , imgWalls&, 0

            ' Add the instructions

            _PutImage , imgText&, 0

            ' Add the score

            _PutImage , imgScore&, 0

            ' Add the players

            _PutImage , imgPlayers&, 0

            ' update screen with changes

            _Display

            ' ================================================================================================================================================================

            ' QUIT ONCE PLAYER PRESSES ESC KEY

            If iLastKeyDown = VK_ESCAPE Then

                DeleteFile m_sTriggerFile

            End If

            ' ================================================================================================================================================================

            ' QUIT IF TRIGGER FILE IS GONE

            If _FileExists(m_sTriggerFile) = FALSE Then

                'DebugLog "_FileExists(" + chr$(34) + m_sTriggerFile + chr$(34) + ") = FALSE, exiting"

                Exit Do

            End If

            '_Limit 60 ' run 60 fps

        Loop While _Connected(lngConn)

        ' RETURN TO AUTODISPLAY

        _AutoDisplay

    Else

        ' DELETE THE TRIGGER FILE SO THE SUBPROGRAM CLOSES

        DeleteFile m_sTriggerFile

        'If cDebugEnabled = TRUE Then

        '    DebugLog "ERROR:" + m_sError

        'End If

        ' SHOW EROR MESSAGE

        Screen 0

        Cls

        Print "ERROR:"

        Print

        Print m_sError

        Print

        Print "Press any key to exit."

        Sleep

    End If

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

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

Function GetVersionNum$ (sFileName$)

    Const cDigits = "1234567890"

    Dim sResult As String

    Dim sProgName As String

    Dim iLoop As Integer

    sResult$ = ""

    'sProgName$ = NoExt$(m_ProgramName$)

    sProgName$ = NoExt$(sFileName$)

    For iLoop = Len(sProgName) To 1 Step -1

        If InStr(1, cDigits, Mid$(sProgName, iLoop, 1)) = 0 Then

            Exit For

        Else

            sResult = Mid$(sProgName, iLoop, 1) + sResult

        End If

    Next iLoop

    GetVersionNum$ = sResult

End Function ' GetVersionNum$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN GRAPHIC PRINTING ROUTINES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' Does a _PrintString at the specified row+column.

'

' iRow% and iCol% are 0-based in this version

'

' See also: PrintString, PrintString1, PutCharXY

Sub PrintAt (iRow%, iCol%, sText$)

    '_PrintString (iCol% * 8, iRow% * 16), sText$

    _PrintString (iCol% * 8, iRow% * 16), sText$

    '_PrintString (iCol%, iRow%), sText$

End Sub ' PrintAt

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

' 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: PrintString

Sub PrintString1 (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 ' 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 COLOR FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Function cRed~& ()

    cRed = _RGB32(255, 0, 0)

End Function

Function cOrangeRed~& ()

    cOrangeRed = _RGB32(255, 69, 0)

End Function ' cOrangeRed~&

Function cDarkOrange~& ()

    cDarkOrange = _RGB32(255, 140, 0)

End Function ' cDarkOrange~&

Function cOrange~& ()

    cOrange = _RGB32(255, 165, 0)

End Function ' cOrange~&

Function cGold~& ()

    cGold = _RGB32(255, 215, 0)

End Function ' cGold~&

Function cYellow~& ()

    cYellow = _RGB32(255, 255, 0)

End Function ' cYellow~&

' LONG-HAIRED FRIENDS OF JESUS OR NOT,

' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)

' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:

Function cChartreuse~& ()

    cChartreuse = _RGB32(127, 255, 0)

End Function ' cChartreuse~&

' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:

Function cOliveDrab1~& ()

    cOliveDrab1 = _RGB32(192, 255, 62)

End Function ' cOliveDrab1~&

Function cLime~& ()

    cLime = _RGB32(0, 255, 0)

End Function ' cLime~&

Function cMediumSpringGreen~& ()

    cMediumSpringGreen = _RGB32(0, 250, 154)

End Function ' cMediumSpringGreen~&

' ADDED THIS FOR THE GAUGE COLOR:

Function cSpringGreen~& ()

    cSpringGreen = _RGB32(0, 255, 160)

End Function ' cSpringGreen~&

Function cCyan~& ()

    cCyan = _RGB32(0, 255, 255)

End Function ' cCyan~&

Function cDeepSkyBlue~& ()

    cDeepSkyBlue = _RGB32(0, 191, 255)

End Function ' cDeepSkyBlue~&

Function cDodgerBlue~& ()

    cDodgerBlue = _RGB32(30, 144, 255)

End Function ' cDodgerBlue~&

Function cSeaBlue~& ()

    cSeaBlue = _RGB32(0, 64, 255)

End Function ' cSeaBlue~&

Function cBlue~& ()

    cBlue = _RGB32(0, 0, 255)

End Function ' cBlue~&

Function cBluePurple~& ()

    cBluePurple = _RGB32(64, 0, 255)

End Function ' cBluePurple~&

Function cDeepPurple~& ()

    cDeepPurple = _RGB32(96, 0, 255)

End Function ' cDeepPurple~&

Function cPurple~& ()

    cPurple = _RGB32(128, 0, 255)

End Function ' cPurple~&

Function cPurpleRed~& ()

    cPurpleRed = _RGB32(128, 0, 192)

End Function ' cPurpleRed~&

Function cDarkRed~& ()

    cDarkRed = _RGB32(160, 0, 64)

End Function ' cDarkRed~&

Function cBrickRed~& ()

    cBrickRed = _RGB32(192, 0, 32)

End Function ' cBrickRed~&

Function cDarkGreen~& ()

    cDarkGreen = _RGB32(0, 100, 0)

End Function ' cDarkGreen~&

Function cGreen~& ()

    cGreen = _RGB32(0, 128, 0)

End Function ' cGreen~&

Function cOliveDrab~& ()

    cOliveDrab = _RGB32(107, 142, 35)

End Function ' cOliveDrab~&

Function cLightPink~& ()

    cLightPink = _RGB32(255, 182, 193)

End Function ' cLightPink~&

Function cHotPink~& ()

    cHotPink = _RGB32(255, 105, 180)

End Function ' cHotPink~&

Function cDeepPink~& ()

    cDeepPink = _RGB32(255, 20, 147)

End Function ' cDeepPink~&

Function cMagenta~& ()

    cMagenta = _RGB32(255, 0, 255)

End Function ' cMagenta~&

Function cBlack~& ()

    cBlack = _RGB32(0, 0, 0)

End Function ' cBlack~&

Function cDimGray~& ()

    cDimGray = _RGB32(105, 105, 105)

End Function ' cDimGray~&

Function cGray~& ()

    cGray = _RGB32(128, 128, 128)

End Function ' cGray~&

Function cDarkGray~& ()

    cDarkGray = _RGB32(169, 169, 169)

End Function ' cDarkGray~&

Function cSilver~& ()

    cSilver = _RGB32(192, 192, 192)

End Function ' cSilver~&

Function cLightGray~& ()

    cLightGray = _RGB32(211, 211, 211)

End Function ' cLightGray~&

Function cGainsboro~& ()

    cGainsboro = _RGB32(220, 220, 220)

End Function ' cGainsboro~&

Function cWhiteSmoke~& ()

    cWhiteSmoke = _RGB32(245, 245, 245)

End Function ' cWhiteSmoke~&

Function cWhite~& ()

    cWhite = _RGB32(255, 255, 255)

    'cWhite = _RGB32(254, 254, 254)

End Function ' cWhite~&

Function cDarkBrown~& ()

    cDarkBrown = _RGB32(128, 64, 0)

End Function ' cDarkBrown~&

Function cLightBrown~& ()

    cLightBrown = _RGB32(196, 96, 0)

End Function ' cLightBrown~&

Function cKhaki~& ()

    cKhaki = _RGB32(240, 230, 140)

End Function ' cKhaki~&

Function cEmpty~& ()

    'cEmpty~& = -1

    cEmpty = _RGB32(0, 0, 0, 0)

End Function ' cEmpty~&

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END COLOR FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN FILE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Help Me!

' Using shell to delete a file

' https://qb64phoenix.com/forum/showthread.php?tid=2618&pid=24683#pid24683

' a740g

' #5

' 04-24-2024, 06:05 AM

'

' There are no commands to directly make copies or backup of files.

' But you could write one with a few lines of code like:

'

' Copies src to dst

' Set overwite to true if dst should be overwritten if present

Sub CopyFile (src As String, dst As String, overwrite As _Byte)

    If _FileExists(src) Then

        If Not _FileExists(dst) Or (_FileExists(dst) And overwrite) Then

            _WriteFile dst, _ReadFile$(src)

        End If

    End If

End Sub ' CopyFile

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

' Convert a value to string and trim it (because normal Str$ adds spaces)

Function cstr$ (myValue)

    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))

    cstr$ = _Trim$(Str$(myValue))

End Function ' cstr$

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

Sub DebugLog (sText As String)

    Dim sTime As String

    Dim sResult As String

    ReDim arrLines(0) As String

    Dim iLoop As Integer

    Dim sNextLine As String

    If _FileExists(m_sDebugFile) = FALSE Then

        sResult = PrintFile$(m_sDebugFile, "", FALSE)

    End If

    If Len(sResult) = 0 Then

        sTime = GetCurrentDateTime$("{mm}/{dd}/{yyyy} {hh}:{nn}:{ss} {ampm}")

        split sText, Chr$(13), arrLines()

        For iLoop = LBound(arrLines) To UBound(arrLines)

            sNextLine = sTime + " " + arrLines(iLoop)

            sResult = PrintFile$(m_sDebugFile, sNextLine, TRUE)

        Next iLoop

    End If

End Sub ' DebugLog

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

Sub DebugLog1 (sText As String)

    Dim sResult As String

    If _FileExists(m_sDebugFile) Then

        sResult = PrintFile$(m_sDebugFile, sText, TRUE)

    Else

        sResult = PrintFile$(m_sDebugFile, sText, FALSE)

    End If

End Sub ' DebugLog

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

' QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Help Me!

' Using shell to delete a file

' https://qb64phoenix.com/forum/showthread.php?tid=2618

Sub DeleteFile (sFile As String)

    If _FileExists(sFile) Then

        'Shell "DELETE " + sFile

        'Shell "del " + sFile

        Kill sFile

    End If

End Sub ' DeleteFile

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

Function FileExt$ (sFile As String)

    Dim iPos As Integer

    iPos = _InStrRev(sFile, ".")

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                FileExt$ = Right$(sFile, Len(sFile) - iPos)

            Else

                ' dot is first character, return everything after it

                FileExt$ = Right$(sFile, Len(sFile) - 1)

            End If

        Else

            ' file only has one character, the dot, the file extension is blank

            FileExt$ = ""

        End If

    Else

        ' no dot found, the file extension is blank

        FileExt$ = ""

    End If

End Function ' FileExt$

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

Function NameOnly$ (sFile As String, sSlash As String)

    Dim iPos As Integer

    'sFile = Replace$(sFile, "/", "\")

    iPos = _InStrRev(sFile, sSlash)

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                NameOnly$ = Right$(sFile, Len(sFile) - iPos)

            Else

                ' slash is first character, return everything after it

                NameOnly$ = Right$(sFile, Len(sFile) - 1)

            End If

        Else

            ' file only has one character, the slash, name is blank

            NameOnly$ = ""

        End If

    Else

        ' slash not found, return the entire thing

        NameOnly$ = sFile

    End If

End Function ' NameOnly$

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

Function NoExt$ (sFile As String)

    Dim iPos As Integer

    iPos = _InStrRev(sFile, ".")

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                NoExt$ = Left$(sFile, iPos - 1)

            Else

                ' dot is first character, removing it returns blank!

                ' our version will just return the name unchanged

                ' but you can return blank if you prefer

                NoExt$ = sFile

            End If

        Else

            ' file only has one character, the dot, removing it returns blank!

            ' our version will just return the name unchanged

            ' but you can return blank if you prefer

            NoExt$ = sFile

        End If

    Else

        ' no dot found

        ' return the name unchanged

        NoExt$ = sFile

    End If

End Function ' NoExt$

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

Function PathOnly$ (sFile As String, sSlash As String)

    Dim iPos As Integer

    'sFile = Replace$(sFile, "/", "\")

    iPos = _InStrRev(sFile, sSlash)

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                PathOnly$ = Left$(sFile, iPos)

            Else

                ' slash is first character, so not much of a path, return blank

                PathOnly$ = ""

            End If

        Else

            ' file only has one character, the slash, name is blank

            PathOnly$ = ""

        End If

    Else

        ' slash not found, so not a path, return blank

        PathOnly$ = ""

    End If

End Function ' PathOnly$

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

' Writes sText to file sFileName.

' If bAppend=TRUE appends to file, else overwrites it.

' Returns blank if successful else returns error message.

' Example:

' ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))

' ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

' sFileName = ProgramPath$ + ProgramName$ + ".OUT.txt"

' sText = "This is a test." + chr$(13) + "Here is line 2." + chr$(13) + "End."

' sError = PrintFile$(sFileName, sText, FALSE)

Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)

    Dim sError As String: sError = ""

    If (bAppend = TRUE) Then

        If _FileExists(sFileName) Then

            Open sFileName For Append As #1 ' opens an existing file for appending

        Else

            sError = "Error in PrintFile$ : File not found. Cannot append."

        End If

    Else

        Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file

    End If

    If Len(sError) = 0 Then

        ' NOTE: WRITE places text in quotes in the file

        'WRITE #1, x, y, z$

        'WRITE #1, sText

        ' PRINT does not put text inside quotes

        Print #1, sText

        Close #1

    End If

    PrintFile$ = sError

End Function ' PrintFile$

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

' Fastest way is always to just read the whole life at once and then parse it.

Function ReadTextFile$ (sFileName As String, sDefault As String)

    Dim x$

    If _FileExists(sFileName) Then

        Open sFileName For Binary As #1

        x$ = Space$(LOF(1))

        Get #1, 1, x$

        Close #1

        ReadTextFile$ = x$

    Else

        ReadTextFile$ = sDefault

    End If

End Function ' ReadTextFile$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END FILE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN CONSTANT TO STRING FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

Function MouseDataPositionToString$ (MyInteger As Integer)

    Dim Mystring As String

    Select Case MyInteger

        Case cForPlayer:

            Mystring = "cForPlayer"

        Case cMouseDX:

            Mystring = "cMouseDX"

        Case cMouseDY:

            Mystring = "cMouseDY"

        Case cMousePosX:

            Mystring = "cMousePosX"

        Case cMousePosY:

            Mystring = "cMousePosY"

        Case cMouseWheel:

            Mystring = "cMouseWheel"

        Case cMouseLeftDown:

            Mystring = "cMouseLeftDown"

        Case cMouseMiddleDown:

            Mystring = "cMouseMiddleDown"

        Case cMouseRightDown:

            Mystring = "cMouseRightDown"

        Case Else:

            Mystring = _Trim$(Str$(MyInteger))

    End Select

    MouseDataPositionToString$ = Mystring

End Function ' MouseDataPositionToString$

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

Function VirtualKeyCodeToString$ (MyInteger As Integer)

    Dim Mystring As String

    Select Case MyInteger

        Case VK_LBUTTON:

            Mystring = "VK_LBUTTON"

        Case VK_RBUTTON:

            Mystring = "VK_RBUTTON"

        Case VK_CANCEL:

            Mystring = "VK_CANCEL"

        Case VK_MBUTTON:

            Mystring = "VK_MBUTTON"

        Case VK_XBUTTON1:

            Mystring = "VK_XBUTTON1"

        Case VK_XBUTTON2:

            Mystring = "VK_XBUTTON2"

        Case VK_BACK:

            Mystring = "VK_BACK"

        Case VK_TAB:

            Mystring = "VK_TAB"

        Case VK_CLEAR:

            Mystring = "VK_CLEAR"

        Case VK_RETURN:

            Mystring = "VK_RETURN"

        Case VK_SHIFT:

            Mystring = "VK_SHIFT"

        Case VK_CONTROL:

            Mystring = "VK_CONTROL"

        Case VK_MENU:

            Mystring = "VK_MENU"

        Case VK_PAUSE:

            Mystring = "VK_PAUSE"

        Case VK_CAPITAL:

            Mystring = "VK_CAPITAL"

        Case VK_KANA:

            Mystring = "VK_KANA"

        Case VK_HANGUL:

            Mystring = "VK_HANGUL"

        Case VK_IME_ON:

            Mystring = "VK_IME_ON"

        Case VK_JUNJA:

            Mystring = "VK_JUNJA"

        Case VK_FINAL:

            Mystring = "VK_FINAL"

        Case VK_HANJA:

            Mystring = "VK_HANJA"

        Case VK_KANJI:

            Mystring = "VK_KANJI"

        Case VK_IME_OFF:

            Mystring = "VK_IME_OFF"

        Case VK_ESCAPE:

            Mystring = "VK_ESCAPE"

        Case VK_CONVERT:

            Mystring = "VK_CONVERT"

        Case VK_NONCONVERT:

            Mystring = "VK_NONCONVERT"

        Case VK_ACCEPT:

            Mystring = "VK_ACCEPT"

        Case VK_MODECHANGE:

            Mystring = "VK_MODECHANGE"

        Case VK_SPACE:

            Mystring = "VK_SPACE"

        Case VK_PRIOR:

            Mystring = "VK_PRIOR"

        Case VK_NEXT:

            Mystring = "VK_NEXT"

        Case VK_END:

            Mystring = "VK_END"

        Case VK_HOME:

            Mystring = "VK_HOME"

        Case VK_LEFT:

            Mystring = "VK_LEFT"

        Case VK_UP:

            Mystring = "VK_UP"

        Case VK_RIGHT:

            Mystring = "VK_RIGHT"

        Case VK_DOWN:

            Mystring = "VK_DOWN"

        Case VK_SELECT:

            Mystring = "VK_SELECT"

        Case VK_PRINT:

            Mystring = "VK_PRINT"

        Case VK_EXECUTE:

            Mystring = "VK_EXECUTE"

        Case VK_SNAPSHOT:

            Mystring = "VK_SNAPSHOT"

        Case VK_INSERT:

            Mystring = "VK_INSERT"

        Case VK_DELETE:

            Mystring = "VK_DELETE"

        Case VK_HELP:

            Mystring = "VK_HELP"

        Case VK_0:

            Mystring = "VK_0"

        Case VK_1:

            Mystring = "VK_1"

        Case VK_2:

            Mystring = "VK_2"

        Case VK_3:

            Mystring = "VK_3"

        Case VK_4:

            Mystring = "VK_4"

        Case VK_5:

            Mystring = "VK_5"

        Case VK_6:

            Mystring = "VK_6"

        Case VK_7:

            Mystring = "VK_7"

        Case VK_8:

            Mystring = "VK_8"

        Case VK_9:

            Mystring = "VK_9"

        Case VK_A:

            Mystring = "VK_A"

        Case VK_B:

            Mystring = "VK_B"

        Case VK_C:

            Mystring = "VK_C"

        Case VK_D:

            Mystring = "VK_D"

        Case VK_E:

            Mystring = "VK_E"

        Case VK_F:

            Mystring = "VK_F"

        Case VK_G:

            Mystring = "VK_G"

        Case VK_H:

            Mystring = "VK_H"

        Case VK_I:

            Mystring = "VK_I"

        Case VK_J:

            Mystring = "VK_J"

        Case VK_K:

            Mystring = "VK_K"

        Case VK_L:

            Mystring = "VK_L"

        Case VK_M:

            Mystring = "VK_M"

        Case VK_N:

            Mystring = "VK_N"

        Case VK_O:

            Mystring = "VK_O"

        Case VK_P:

            Mystring = "VK_P"

        Case VK_Q:

            Mystring = "VK_Q"

        Case VK_R:

            Mystring = "VK_R"

        Case VK_S:

            Mystring = "VK_S"

        Case VK_T:

            Mystring = "VK_T"

        Case VK_U:

            Mystring = "VK_U"

        Case VK_V:

            Mystring = "VK_V"

        Case VK_W:

            Mystring = "VK_W"

        Case VK_X:

            Mystring = "VK_X"

        Case VK_Y:

            Mystring = "VK_Y"

        Case VK_Z:

            Mystring = "VK_Z"

        Case VK_LWIN:

            Mystring = "VK_LWIN"

        Case VK_RWIN:

            Mystring = "VK_RWIN"

        Case VK_APPS:

            Mystring = "VK_APPS"

        Case VK_SLEEP:

            Mystring = "VK_SLEEP"

        Case VK_NUMPAD0:

            Mystring = "VK_NUMPAD0"

        Case VK_NUMPAD1:

            Mystring = "VK_NUMPAD1"

        Case VK_NUMPAD2:

            Mystring = "VK_NUMPAD2"

        Case VK_NUMPAD3:

            Mystring = "VK_NUMPAD3"

        Case VK_NUMPAD4:

            Mystring = "VK_NUMPAD4"

        Case VK_NUMPAD5:

            Mystring = "VK_NUMPAD5"

        Case VK_NUMPAD6:

            Mystring = "VK_NUMPAD6"

        Case VK_NUMPAD7:

            Mystring = "VK_NUMPAD7"

        Case VK_NUMPAD8:

            Mystring = "VK_NUMPAD8"

        Case VK_NUMPAD9:

            Mystring = "VK_NUMPAD9"

        Case VK_MULTIPLY:

            Mystring = "VK_MULTIPLY"

        Case VK_ADD:

            Mystring = "VK_ADD"

        Case VK_SEPARATOR:

            Mystring = "VK_SEPARATOR"

        Case VK_SUBTRACT:

            Mystring = "VK_SUBTRACT"

        Case VK_DECIMAL:

            Mystring = "VK_DECIMAL"

        Case VK_DIVIDE:

            Mystring = "VK_DIVIDE"

        Case VK_F1:

            Mystring = "VK_F1"

        Case VK_F2:

            Mystring = "VK_F2"

        Case VK_F3:

            Mystring = "VK_F3"

        Case VK_F4:

            Mystring = "VK_F4"

        Case VK_F5:

            Mystring = "VK_F5"

        Case VK_F6:

            Mystring = "VK_F6"

        Case VK_F7:

            Mystring = "VK_F7"

        Case VK_F8:

            Mystring = "VK_F8"

        Case VK_F9:

            Mystring = "VK_F9"

        Case VK_F10:

            Mystring = "VK_F10"

        Case VK_F11:

            Mystring = "VK_F11"

        Case VK_F12:

            Mystring = "VK_F12"

        Case VK_F13:

            Mystring = "VK_F13"

        Case VK_F14:

            Mystring = "VK_F14"

        Case VK_F15:

            Mystring = "VK_F15"

        Case VK_F16:

            Mystring = "VK_F16"

        Case VK_F17:

            Mystring = "VK_F17"

        Case VK_F18:

            Mystring = "VK_F18"

        Case VK_F19:

            Mystring = "VK_F19"

        Case VK_F20:

            Mystring = "VK_F20"

        Case VK_F21:

            Mystring = "VK_F21"

        Case VK_F22:

            Mystring = "VK_F22"

        Case VK_F23:

            Mystring = "VK_F23"

        Case VK_F24:

            Mystring = "VK_F24"

        Case VK_NUMLOCK:

            Mystring = "VK_NUMLOCK"

        Case VK_SCROLL:

            Mystring = "VK_SCROLL"

        Case VK_LSHIFT:

            Mystring = "VK_LSHIFT"

        Case VK_RSHIFT:

            Mystring = "VK_RSHIFT"

        Case VK_LCONTROL:

            Mystring = "VK_LCONTROL"

        Case VK_RCONTROL:

            Mystring = "VK_RCONTROL"

        Case VK_LMENU:

            Mystring = "VK_LMENU"

        Case VK_RMENU:

            Mystring = "VK_RMENU"

        Case VK_BROWSER_BACK:

            Mystring = "VK_BROWSER_BACK"

        Case VK_BROWSER_FORWARD:

            Mystring = "VK_BROWSER_FORWARD"

        Case VK_BROWSER_REFRESH:

            Mystring = "VK_BROWSER_REFRESH"

        Case VK_BROWSER_STOP:

            Mystring = "VK_BROWSER_STOP"

        Case VK_BROWSER_SEARCH:

            Mystring = "VK_BROWSER_SEARCH"

        Case VK_BROWSER_FAVORITES:

            Mystring = "VK_BROWSER_FAVORITES"

        Case VK_BROWSER_HOME:

            Mystring = "VK_BROWSER_HOME"

        Case VK_VOLUME_MUTE:

            Mystring = "VK_VOLUME_MUTE"

        Case VK_VOLUME_DOWN:

            Mystring = "VK_VOLUME_DOWN"

        Case VK_VOLUME_UP:

            Mystring = "VK_VOLUME_UP"

        Case VK_MEDIA_NEXT_TRACK:

            Mystring = "VK_MEDIA_NEXT_TRACK"

        Case VK_MEDIA_PREV_TRACK:

            Mystring = "VK_MEDIA_PREV_TRACK"

        Case VK_MEDIA_STOP:

            Mystring = "VK_MEDIA_STOP"

        Case VK_MEDIA_PLAY_PAUSE:

            Mystring = "VK_MEDIA_PLAY_PAUSE"

        Case VK_LAUNCH_MAIL:

            Mystring = "VK_LAUNCH_MAIL"

        Case VK_LAUNCH_MEDIA_SELECT:

            Mystring = "VK_LAUNCH_MEDIA_SELECT"

        Case VK_LAUNCH_APP1:

            Mystring = "VK_LAUNCH_APP1"

        Case VK_LAUNCH_APP2:

            Mystring = "VK_LAUNCH_APP2"

        Case VK_OEM_1:

            Mystring = "VK_OEM_1"

        Case VK_OEM_PLUS:

            Mystring = "VK_OEM_PLUS"

        Case VK_OEM_COMMA:

            Mystring = "VK_OEM_COMMA"

        Case VK_OEM_MINUS:

            Mystring = "VK_OEM_MINUS"

        Case VK_OEM_PERIOD:

            Mystring = "VK_OEM_PERIOD"

        Case VK_OEM_2:

            Mystring = "VK_OEM_2"

        Case VK_OEM_3:

            Mystring = "VK_OEM_3"

        Case VK_OEM_4:

            Mystring = "VK_OEM_4"

        Case VK_OEM_5:

            Mystring = "VK_OEM_5"

        Case VK_OEM_6:

            Mystring = "VK_OEM_6"

        Case VK_OEM_7:

            Mystring = "VK_OEM_7"

        Case VK_OEM_8:

            Mystring = "VK_OEM_8"

        Case VK_OEM_102:

            Mystring = "VK_OEM_102"

        Case VK_PROCESSKEY:

            Mystring = "VK_PROCESSKEY"

        Case VK_PACKET:

            Mystring = "VK_PACKET"

        Case VK_ATTN:

            Mystring = "VK_ATTN"

        Case VK_CRSEL:

            Mystring = "VK_CRSEL"

        Case VK_EXSEL:

            Mystring = "VK_EXSEL"

        Case VK_EREOF:

            Mystring = "VK_EREOF"

        Case VK_PLAY:

            Mystring = "VK_PLAY"

        Case VK_ZOOM:

            Mystring = "VK_ZOOM"

        Case VK_NONAME:

            Mystring = "VK_NONAME"

        Case VK_PA1:

            Mystring = "VK_PA1"

        Case VK_OEM_CLEAR:

            Mystring = "VK_OEM_CLEAR"

        Case Else:

            Mystring = _Trim$(Str$(MyInteger))

    End Select

    VirtualKeyCodeToString$ = Mystring

End Function ' VirtualKeyCodeToString$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END CONSTANT TO STRING FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN DRAWING ROUTINES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' DRAW A 2-D BOX (SOLID)

' https://www.qb64.org/wiki/LINE

' Renamed DrawBox/DrawBoxLine to DrawSolidBox

Sub DrawBoxSolid (iX As Integer, iY As Integer, iSize As Integer, fgColor As _Unsigned Long)

    Line (iX, iY)-(iX + iSize, iY + iSize), fgColor, BF ' Draw a solid box

End Sub ' DrawBoxSolid

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

' DRAW A 2-D RECTANGLE (SOLID)

Sub DrawRectSolid (iX As Integer, iY As Integer, iSizeW As Integer, iSizeH As Integer, fgColor As _Unsigned Long)

    Line (iX, iY)-(iX + iSizeW, iY + iSizeH), fgColor, BF ' Draw a solid rectangle

End Sub ' DrawRectSolid

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END DRAWING ROUTINES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN GENERAL PURPOSE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' SMcNeill

' More efficient version of ExtendedTimer.

' This stores our day values and only updates them when necessary.

' We really don't need to figure out how many seconds are in today over and over endlessly

' -- just count them once, and when the clock swaps back to 0:0:0, add 24*60*60 seconds to the count.

' Re: how to time something (ie do loop for n seconds)

' https://forum.qb64.org/index.php?topic=4682.0

Function ExtendedTimer##

    'modified extendedtimer to store the old day's count, and not have to recalculate it every time the routine is called.

    Static olds As _Float, old_day As _Float

    Dim m As Integer, d As Integer, y As Integer

    Dim s As _Float, day As String

    Dim oldt As Single

    If olds = 0 Then 'calculate the day the first time the extended timer runs

        day = Date$

        m = Val(Left$(day, 2))

        d = Val(Mid$(day, 4, 2))

        y = Val(Right$(day, 4)) - 1970

        Select Case m 'Add the number of days for each previous month passed

            Case 2: d = d + 31

            Case 3: d = d + 59

            Case 4: d = d + 90

            Case 5: d = d + 120

            Case 6: d = d + 151

            Case 7: d = d + 181

            Case 8: d = d + 212

            Case 9: d = d + 243

            Case 10: d = d + 273

            Case 11: d = d + 304

            Case 12: d = d + 334

        End Select

        If (y Mod 4) = 2 And m > 2 Then d = d + 1 'add a day if this is leap year and we're past february

        d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year

        d = d + (y + 2) \ 4 'add in days for leap years passed

        s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds

        old_day = s

    End If

    If Timer < oldt Then 'we went from 23:59:59 (a second before midnight) to 0:0:0 (midnight)

        old_day = s + 83400 'add another worth of seconds to our counter

    End If

    oldt = Timer

    olds = old_day + oldt

    ExtendedTimer## = olds

End Function ' ExtendedTimer##

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

' Simple timestamp function

' Format: {YYYY}-{MM}-{DD} {hh}:[mm}:{ss}

' Uses:

'     TIME$

'         The TIME$ Function returns a STRING representation

'         of the current computer time in a 24 hour format.

'         https://qb64phoenix.com/qb64wiki/index.php/TIME$

'     DATE$

'         The DATE$ function returns the current computer date

'         as a string in the format "mm-dd-yyyy".

'         https://qb64phoenix.com/qb64wiki/index.php/DATE$

'

' TODO: support template where

'       {yyyy} = 4 digit year

'       {mm}   = 2 digit month

'       {dd}   = 2 digit day

'       {hh}   = 2 digit hour (12-hour)

'       {rr}   = 2 digit hour (24-hour)

'       {nn}   = 2 digit minute

'       {ss}   = 2 digit second

'       {ampm} = AM/PM

' We got the nn for minute from Microsoft > Office VBA Reference > DateDiff function

' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/datediff-function

' PRINT "Current date time (simple format) = " + Chr$(34) + GetCurrentDateTime$("{yyyy}-{mm}-{dd} {rr}:{nn}:{ss}") + Chr$(34)

' PRINT "Current date time (US format)     = " + Chr$(34) + GetCurrentDateTime$("{mm}/{dd}/{yyyy} {hh}:{nn}:{ss} {ampm}") + Chr$(34)

' PRINT "Filename timestamp                = " + Chr$(34) + GetCurrentDateTime$("{yyyy}{mm}{dd}_{rr}{nn}{ss}") + Chr$(34)

Function GetCurrentDateTime$ (sTemplate$)

    Dim sDate$: sDate$ = Date$

    Dim sTime$: sTime$ = Time$

    Dim sYYYY$: sYYYY$ = Mid$(sDate$, 7, 4)

    Dim sMM$: sMM$ = Mid$(sDate$, 1, 2)

    Dim sDD$: sDD$ = Mid$(sDate$, 4, 2)

    Dim sHH24$: sHH24$ = Mid$(sTime$, 1, 2)

    Dim sHH$: sHH$ = ""

    Dim sMI$: sMI$ = Mid$(sTime$, 4, 2)

    Dim sSS$: sSS$ = Mid$(sTime$, 7, 2)

    Dim iHour%: iHour% = Val(sHH24$)

    Dim sAMPM$: sAMPM$ = ""

    Dim result$: result$ = ""

    ' FIGURE OUT AM/PM

    If InStr(sTemplate$, "{ampm}") > 0 Then

        If iHour% = 0 Then

            sAMPM$ = "AM"

            iHour% = 12

        ElseIf iHour% > 0 And iHour% < 12 Then

            sAMPM$ = "AM"

        ElseIf iHour% = 12 Then

            sAMPM$ = "PM"

        Else

            sAMPM$ = "PM"

            iHour% = iHour% - 12

        End If

        sHH$ = Right$("00" + _Trim$(Str$(iHour%)), 2)

    End If

    ' POPULATE TEMPLATE

    result$ = sTemplate$

    result$ = Replace$(result$, "{yyyy}", sYYYY$)

    result$ = Replace$(result$, "{mm}", sMM$)

    result$ = Replace$(result$, "{dd}", sDD$)

    result$ = Replace$(result$, "{hh}", sHH$)

    result$ = Replace$(result$, "{rr}", sHH24$)

    result$ = Replace$(result$, "{nn}", sMI$)

    result$ = Replace$(result$, "{ss}", sSS$)

    result$ = Replace$(result$, "{ampm}", sAMPM$)

    ' RETURN RESULT

    GetCurrentDateTime$ = result$

End Function ' GetCurrentDateTime$

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

' 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%

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

' IIF function for QB for integers

Function IIF (Condition, IfTrue, IfFalse)

    If Condition Then IIF = IfTrue Else IIF = IfFalse

End Function

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

' IIF function for QB for strings

Function IIFS$ (Condition, IfTrue$, IfFalse$)

    If Condition Then IIFS$ = IfTrue$ Else IIFS$ = IfFalse$

End Function

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

' 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$

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

' FROM: String Manipulation

' found at abandoned, outdated and now likely malicious qb64 dot net website

' http://www.qb64.[net]/forum/index_topic_5964-0/

'

'SUMMARY:

'   Purpose:  A library of custom functions that transform strings.

'   Author:   Dustinian Camburides (dustinian@gmail.com)

'   Platform: QB64 (www.qb64.org)

'   Revision: 1.6

'   Updated:  5/28/2012

'SUMMARY:

'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.

'INPUT:

'Text: The input string; the text that's being manipulated.

'Find: The specified sub-string; the string sought within the [Text] string.

'Add: The sub-string that's being added to the [Text] string.

Function Replace$ (Text1 As String, Find1 As String, Add1 As String)

    ' VARIABLES:

    Dim Text2 As String

    Dim Find2 As String

    Dim Add2 As String

    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.

    Dim strBefore As String ' The characters before the string to be replaced.

    Dim strAfter As String ' The characters after the string to be replaced.

    ' INITIALIZE:

    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)

    Text2 = Text1

    Find2 = Find1

    Add2 = Add1

    lngLocation = InStr(1, Text2, Find2)

    ' PROCESSING:

    ' While [Find2] appears in [Text2]...

    While lngLocation

        ' Extract all Text2 before the [Find2] substring:

        strBefore = Left$(Text2, lngLocation - 1)

        ' Extract all text after the [Find2] substring:

        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))

        ' Return the substring:

        Text2 = strBefore + Add2 + strAfter

        ' Locate the next instance of [Find2]:

        lngLocation = InStr(1, Text2, Find2)

        ' Next instance of [Find2]...

    Wend

    ' OUTPUT:

    Replace$ = Text2

End Function ' Replace$

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

' 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 cDebugEnabled = 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 cDebugEnabled = 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

"ReadMiceSub56.bas":

Code: (Select All)
' ################################################################################################################################################################

' Multimouse sub-program "ReadMiceSub.bas"

' ################################################################################################################################################################

' -------------------------------------------------------------------------------

' ABOUT

' -------------------------------------------------------------------------------

' (Subprogram for READMICEMAIN.BAS, see that for more info.)

' *****************************************************************************

' NOTES:

'

' The following header files must be in same folder as this program:

' "makeint.h"

' "winproc.h"

' This detects a "phantom mouse" which doesn't seem to work.

' I think it might be my laptop's touchpad or touchscreen,

' is there some way to get the input from this working,

' or if not, at least identify and ignore it?

'

' *****************************************************************************

Option Explicit

_Title "readmice"

$NoPrefix

'$Console:Only

'Console Off

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN CONSTANTS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Const cProgName = "ReadMiceSub"

Const FALSE = 0

Const TRUE = Not FALSE

Const cDebugEnabled = FALSE

' FORM ALPHA VALUES

Const cInvisible = 1 ' for some reason a value of 0 (fully invisible) doesn't let the window get the focus, so we use 1

Const cTransparent = 160

Const cVisible = 255

' MIN/MAX VALUES FOR MOUSE TEST

Const cMinX = 1

Const cMaxX = 354 ' 160 ' 79 ' 80

Const cMinY = 1 ' 16

Const cMaxY = 45 ' 30 24

Const cMinWheel = 0

Const cMaxWheel = 255

Const cMinPX = 1

Const cMaxPX = 1024

Const cMinPY = 1

Const cMaxPY = 768

' CONSTANT FOR 2ND DIMENSION OF arrFile ARRAY

Const cFileName = 0

Const cFileData = 1

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END CONSTANTS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ================================================================================================================================================================

' BEGIN API CONSTANTS

' ================================================================================================================================================================

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' 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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' FOR RAW INPUT API

Const COLOR_WINDOW = 5

Const CS_HREDRAW = &H0002

Const CS_VREDRAW = &H0001

Const CW_USEDEFAULT = &H80000000

Const DT_CENTER = &H00000001

Const DT_LEFT = &H00000000

Const DT_RIGHT = &H00000002

Const DT_VCENTER = &H00000004

Const DT_WORDBREAK = &H00000010

Const DT_SINGLELINE = &H00000020

Const Edit = 101

Const EM_GETSEL = &H00B0

Const EM_SETSEL = &H00B1

Const EN_CHANGE = &H0300

Const EN_KILLFOCUS = &H0200

Const EN_SETFOCUS = &H0100

Const GCL_HICON = -14

Const GCL_HICONSM = -34

Const Hid_Bottom = 66

Const Hid_Left = 33

Const Hid_Right = 34

Const HWND_DESKTOP = 0

Const ICON_BIG = 1

Const ICON_SMALL = 0

Const IDC_ARROW = 32512

Const IDI_APPLICATION = 32512

Const KEYEVENTF_KEYUP = &H0002

Const KL_NAMELENGTH = 9

Const LabelInfo = 201

Const MOUSE_ATTRIBUTES_CHANGED = &H04

Const MOUSE_MOVE_ABSOLUTE = &H01

Const MOUSE_MOVE_NOCOALESCE = &H08

Const MOUSE_MOVE_RELATIVE = &H00

Const MOUSE_VIRTUAL_DESKTOP = &H02

Const NULL = 0

Const RI_KEY_BREAK = 1

Const RI_KEY_E0 = 2

Const RI_KEY_E1 = 4

Const RI_KEY_MAKE = 0

Const RI_KEY_TERMSRV_SET_LED = 8

Const RI_KEY_TERMSRV_SHADOW = &H10

Const RID_INPUT = &H10000003

Const RIDEV_EXINPUTSINK = &H00001000

Const RIDI_DEVICEINFO = &H2000000B

Const RIM_TYPEMOUSE = 0

Const RIM_TYPEKEYBOARD = 1

Const RIM_TYPEHID = 2

Const RIM_TYPEUNKNOWN = -1 ' just a made up value to indicate type unknown

Const SIZE_MINIMIZED = 1

Const SW_SHOW = 5

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' BEGIN Virtual-Key Codes

' https://learn.microsoft.com/en-us/windows/win32/inputdev/virtual-key-codes

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' NOTE: raw.data.Keyboard.vKey may require set extended bit

Const VK_LBUTTON = &H01 ' dec = 1, Left mouse button

Const VK_RBUTTON = &H02 ' dec = 2, Right mouse button

Const VK_CANCEL = &H03 ' dec = 3, Control-break processing

Const VK_MBUTTON = &H04 ' dec = 4, Middle mouse button

Const VK_XBUTTON1 = &H05 ' dec = 5, X1 mouse button

Const VK_XBUTTON2 = &H06 ' dec = 6, X2 mouse button

'??? = &H07 ' dec = 7, Reserved

Const VK_BACK = &H08 ' dec = 8, BACKSPACE key

Const VK_TAB = &H09 ' dec = 9, TAB key

'??? = &H0A-0B ' dec = 10-11, Reserved

Const VK_CLEAR = &H0C ' dec = 12, CLEAR key

Const VK_RETURN = &H0D ' dec = 13, ENTER key

'??? = &H0E-0F ' dec = 14-15, Unassigned

Const VK_SHIFT = &H10 ' dec = 16, SHIFT key

Const VK_CONTROL = &H11 ' dec = 17, CTRL key

Const VK_MENU = &H12 ' dec = 18, ALT key

Const VK_PAUSE = &H13 ' dec = 19, PAUSE key

Const VK_CAPITAL = &H14 ' dec = 20, CAPS LOCK key

Const VK_KANA = &H15 ' dec = 21, IME Kana mode

Const VK_HANGUL = &H15 ' dec = 21, IME Hangul mode

Const VK_IME_ON = &H16 ' dec = 22, IME On

Const VK_JUNJA = &H17 ' dec = 23, IME Junja mode

Const VK_FINAL = &H18 ' dec = 24, IME final mode

Const VK_HANJA = &H19 ' dec = 25, IME Hanja mode

Const VK_KANJI = &H19 ' dec = 25, IME Kanji mode

Const VK_IME_OFF = &H1A ' dec = 26, IME Off

Const VK_ESCAPE = &H1B ' dec = 27, ESC key

Const VK_CONVERT = &H1C ' dec = 28, IME convert

Const VK_NONCONVERT = &H1D ' dec = 29, IME nonconvert

Const VK_ACCEPT = &H1E ' dec = 30, IME accept

Const VK_MODECHANGE = &H1F ' dec = 31, IME mode change request

Const VK_SPACE = &H20 ' dec = 32, SPACEBAR

Const VK_PRIOR = &H21 ' dec = 33, PAGE UP key

Const VK_NEXT = &H22 ' dec = 34, PAGE DOWN key

Const VK_END = &H23 ' dec = 35, END key

Const VK_HOME = &H24 ' dec = 36, HOME key

Const VK_LEFT = &H25 ' dec = 37, LEFT ARROW key

Const VK_UP = &H26 ' dec = 38, UP ARROW key

Const VK_RIGHT = &H27 ' dec = 39, RIGHT ARROW key

Const VK_DOWN = &H28 ' dec = 40, DOWN ARROW key

Const VK_SELECT = &H29 ' dec = 41, SELECT key

Const VK_PRINT = &H2A ' dec = 42, PRINT key

Const VK_EXECUTE = &H2B ' dec = 43, EXECUTE key

Const VK_SNAPSHOT = &H2C ' dec = 44, PRINT SCREEN key

Const VK_INSERT = &H2D ' dec = 45, INS key

Const VK_DELETE = &H2E ' dec = 46, DEL key

Const VK_HELP = &H2F ' dec = 47, HELP key

' MADE OUR OWN CONSTANTS FOR THESE:

Const VK_0 = &H30 ' dec = 48, 0 key

Const VK_1 = &H31 ' dec = 49, 1 key

Const VK_2 = &H32 ' dec = 50, 2 key

Const VK_3 = &H33 ' dec = 51, 3 key

Const VK_4 = &H34 ' dec = 52, 4 key

Const VK_5 = &H35 ' dec = 53, 5 key

Const VK_6 = &H36 ' dec = 54, 6 key

Const VK_7 = &H37 ' dec = 55, 7 key

Const VK_8 = &H38 ' dec = 56, 8 key

Const VK_9 = &H39 ' dec = 57, 9 key

'??? = &H3A-40 ' dec = 58-64, Undefined

Const VK_A = &H41 ' dec = 65, A key

Const VK_B = &H42 ' dec = 66, B key

Const VK_C = &H43 ' dec = 67, C key

Const VK_D = &H44 ' dec = 68, D key

Const VK_E = &H45 ' dec = 69, E key

Const VK_F = &H46 ' dec = 70, F key

Const VK_G = &H47 ' dec = 71, G key

Const VK_H = &H48 ' dec = 72, H key

Const VK_I = &H49 ' dec = 73, I key

Const VK_J = &H4A ' dec = 74, J key

Const VK_K = &H4B ' dec = 75, K key

Const VK_L = &H4C ' dec = 76, L key

Const VK_M = &H4D ' dec = 77, M key

Const VK_N = &H4E ' dec = 78, N key

Const VK_O = &H4F ' dec = 79, O key

Const VK_P = &H50 ' dec = 80, P key

Const VK_Q = &H51 ' dec = 81, Q key

Const VK_R = &H52 ' dec = 82, R key

Const VK_S = &H53 ' dec = 83, S key

Const VK_T = &H54 ' dec = 84, T key

Const VK_U = &H55 ' dec = 85, U key

Const VK_V = &H56 ' dec = 86, V key

Const VK_W = &H57 ' dec = 87, W key

Const VK_X = &H58 ' dec = 88, X key

Const VK_Y = &H59 ' dec = 89, Y key

Const VK_Z = &H5A ' dec = 90, Z key

' Microsoft's Virtual-Key Codes constants (continued):

Const VK_LWIN = &H5B ' dec = 91, Left Windows key

Const VK_RWIN = &H5C ' dec = 92, Right Windows key

Const VK_APPS = &H5D ' dec = 93, Applications key

'??? = &H5E ' dec = 94, Reserved

Const VK_SLEEP = &H5F ' dec = 95, Computer Sleep key

Const VK_NUMPAD0 = &H60 ' dec = 96, Numeric keypad 0 key

Const VK_NUMPAD1 = &H61 ' dec = 97, Numeric keypad 1 key

Const VK_NUMPAD2 = &H62 ' dec = 98, Numeric keypad 2 key

Const VK_NUMPAD3 = &H63 ' dec = 99, Numeric keypad 3 key

Const VK_NUMPAD4 = &H64 ' dec = 100, Numeric keypad 4 key

Const VK_NUMPAD5 = &H65 ' dec = 101, Numeric keypad 5 key

Const VK_NUMPAD6 = &H66 ' dec = 102, Numeric keypad 6 key

Const VK_NUMPAD7 = &H67 ' dec = 103, Numeric keypad 7 key

Const VK_NUMPAD8 = &H68 ' dec = 104, Numeric keypad 8 key

Const VK_NUMPAD9 = &H69 ' dec = 105, Numeric keypad 9 key

Const VK_MULTIPLY = &H6A ' dec = 106, Multiply key

Const VK_ADD = &H6B ' dec = 107, Add key

Const VK_SEPARATOR = &H6C ' dec = 108, Separator key

Const VK_SUBTRACT = &H6D ' dec = 109, Subtract key

Const VK_DECIMAL = &H6E ' dec = 110, Decimal key

Const VK_DIVIDE = &H6F ' dec = 111, Divide key

Const VK_F1 = &H70 ' dec = 112, F1 key

Const VK_F2 = &H71 ' dec = 113, F2 key

Const VK_F3 = &H72 ' dec = 114, F3 key

Const VK_F4 = &H73 ' dec = 115, F4 key

Const VK_F5 = &H74 ' dec = 116, F5 key

Const VK_F6 = &H75 ' dec = 117, F6 key

Const VK_F7 = &H76 ' dec = 118, F7 key

Const VK_F8 = &H77 ' dec = 119, F8 key

Const VK_F9 = &H78 ' dec = 120, F9 key

Const VK_F10 = &H79 ' dec = 121, F10 key

Const VK_F11 = &H7A ' dec = 122, F11 key

Const VK_F12 = &H7B ' dec = 123, F12 key

Const VK_F13 = &H7C ' dec = 124, F13 key

Const VK_F14 = &H7D ' dec = 125, F14 key

Const VK_F15 = &H7E ' dec = 126, F15 key

Const VK_F16 = &H7F ' dec = 127, F16 key

Const VK_F17 = &H80 ' dec = 128, F17 key

Const VK_F18 = &H81 ' dec = 129, F18 key

Const VK_F19 = &H82 ' dec = 130, F19 key

Const VK_F20 = &H83 ' dec = 131, F20 key

Const VK_F21 = &H84 ' dec = 132, F21 key

Const VK_F22 = &H85 ' dec = 133, F22 key

Const VK_F23 = &H86 ' dec = 134, F23 key

Const VK_F24 = &H87 ' dec = 135, F24 key

'??? = &H88-8F ' dec = 136-143, Reserved

Const VK_NUMLOCK = &H90 ' dec = 144, NUM LOCK key

Const VK_SCROLL = &H91 ' dec = 145, SCROLL LOCK key

'??? = &H92-96 ' dec = 146-150, OEM specific

'??? = &H97-9F ' dec = 151-159, Unassigned

Const VK_LSHIFT = &HA0 ' dec = 160, Left SHIFT key

Const VK_RSHIFT = &HA1 ' dec = 161, Right SHIFT key

Const VK_LCONTROL = &HA2 ' dec = 162, Left CONTROL key

Const VK_RCONTROL = &HA3 ' dec = 163, Right CONTROL key

Const VK_LMENU = &HA4 ' dec = 164, Left ALT key

Const VK_RMENU = &HA5 ' dec = 165, Right ALT key

Const VK_BROWSER_BACK = &HA6 ' dec = 166, Browser Back key

Const VK_BROWSER_FORWARD = &HA7 ' dec = 167, Browser Forward key

Const VK_BROWSER_REFRESH = &HA8 ' dec = 168, Browser Refresh key

Const VK_BROWSER_STOP = &HA9 ' dec = 169, Browser Stop key

Const VK_BROWSER_SEARCH = &HAA ' dec = 170, Browser Search key

Const VK_BROWSER_FAVORITES = &HAB ' dec = 171, Browser Favorites key

Const VK_BROWSER_HOME = &HAC ' dec = 172, Browser Start and Home key

Const VK_VOLUME_MUTE = &HAD ' dec = 173, Volume Mute key

Const VK_VOLUME_DOWN = &HAE ' dec = 174, Volume Down key

Const VK_VOLUME_UP = &HAF ' dec = 175, Volume Up key

Const VK_MEDIA_NEXT_TRACK = &HB0 ' dec = 176, Next Track key

Const VK_MEDIA_PREV_TRACK = &HB1 ' dec = 177, Previous Track key

Const VK_MEDIA_STOP = &HB2 ' dec = 178, Stop Media key

Const VK_MEDIA_PLAY_PAUSE = &HB3 ' dec = 179, Play/Pause Media key

Const VK_LAUNCH_MAIL = &HB4 ' dec = 180, Start Mail key

Const VK_LAUNCH_MEDIA_SELECT = &HB5 ' dec = 181, Select Media key

Const VK_LAUNCH_APP1 = &HB6 ' dec = 182, Start Application 1 key

Const VK_LAUNCH_APP2 = &HB7 ' dec = 183, Start Application 2 key

'??? = &HB8-B9 ' dec = 184-137, Reserved

Const VK_OEM_1 = &HBA ' dec = 186, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the ;: key

Const VK_OEM_PLUS = &HBB ' dec = 187, For any country/region, the + key

Const VK_OEM_COMMA = &HBC ' dec = 188, For any country/region, the , key

Const VK_OEM_MINUS = &HBD ' dec = 189, For any country/region, the - key

Const VK_OEM_PERIOD = &HBE ' dec = 190, For any country/region, the . key

Const VK_OEM_2 = &HBF ' dec = 191, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the /? key

Const VK_OEM_3 = &HC0 ' dec = 192, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the `~ key

'??? = &HC1-DA ' dec = 193-218, Reserved

Const VK_OEM_4 = &HDB ' dec = 219, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the [{ key

Const VK_OEM_5 = &HDC ' dec = 220, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the \\| key

Const VK_OEM_6 = &HDD ' dec = 221, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the ]} key

Const VK_OEM_7 = &HDE ' dec = 222, Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the '" key

Const VK_OEM_8 = &HDF ' dec = 223, Used for miscellaneous characters; it can vary by keyboard.

'??? = &HE0 ' dec = 224, Reserved

'??? = &HE1 ' dec = 225, OEM specific

Const VK_OEM_102 = &HE2 ' dec = 226, The <> keys on the US standard keyboard, or the \\| key on the non-US 102-key keyboard

'??? = &HE3-E4 ' dec = 227-228, OEM specific

Const VK_PROCESSKEY = &HE5 ' dec = 229, IME PROCESS key

'??? = &HE6 ' dec = 230, OEM specific

Const VK_PACKET = &HE7 ' dec = 231, Used to pass Unicode characters as if they were keystrokes. The VK_PACKET key is the low word of a 32-bit Virtual Key value used for non-keyboard input methods. For more information, see Remark in KEYBDINPUT, SendInput, WM_KEYDOWN, and WM_KEYUP

'??? = &HE8 ' dec = 232, Unassigned

'??? = &HE9-F5 ' dec = 233-245, OEM specific

Const VK_ATTN = &HF6 ' dec = 246, Attn key

Const VK_CRSEL = &HF7 ' dec = 247, CrSel key

Const VK_EXSEL = &HF8 ' dec = 248, ExSel key

Const VK_EREOF = &HF9 ' dec = 249, Erase EOF key

Const VK_PLAY = &HFA ' dec = 250, Play key

Const VK_ZOOM = &HFB ' dec = 251, Zoom key

Const VK_NONAME = &HFC ' dec = 252, Reserved

Const VK_PA1 = &HFD ' dec = 253, PA1 key

Const VK_OEM_CLEAR = &HFE ' dec = 254, Clear key

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' END Virtual-Key Codes

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' Messages a window receives through or sends from its WindowProc function:

' DefWindowProcA function (winuser.h)

' https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-defwindowproca

Const WM_APP = &H08000 ' dec=32768

Const WM_APPCOMMAND = &H0319 ' dec=793

Const WM_CHAR = &H0102 ' dec=258

Const WM_COMMAND = &H0111 ' dec=273

Const WM_DEADCHAR = &H0103 ' dec=259

Const WM_DESTROY = &H0002 ' dec=2

Const WM_INITDIALOG = &H0110 ' dec=272

Const WM_INPUT = &H00FF ' dec=255

Const WM_KEYDOWN = &H0100 ' dec=256

Const WM_KEYUP = &H0101 ' dec=257

Const WM_MOUSEMOVE = &H0200 ' dec=512

Const WM_NCACTIVATE = &H0086 ' dec=134

Const WM_NEXTDLGCTL = &H28 ' dec=40

Const WM_PAINT = &H000F ' dec=15

Const WM_SETICON = &H0080 ' dec=128

Const WM_SIZE = &H0005 ' dec=5

Const WM_SYSCHAR = &H0106 ' dec=262

Const WM_SYSDEADCHAR = &H0107 ' dec=263

Const WM_SYSKEYDOWN = &H0104 ' dec=260

Const WM_SYSKEYUP = &H0105 ' dec=261

Const WM_UNICHAR = &H0109 ' dec=265

' CONSTANTS USED FOR WINDOWS STYLES & FEATURES, SEE:

' Window Styles

' https://learn.microsoft.com/en-us/windows/win32/winmsg/window-styles

' Window Features

' https://learn.microsoft.com/en-us/windows/win32/winmsg/window-features

Const WS_CAPTION = &H00C00000 ' dec=12582912

Const WS_CHILD = &H40000000 ' dec=1073741824

Const WS_MAXIMIZEBOX = &H00010000 ' dec=65536

Const WS_MINIMIZEBOX = &H00020000 ' dec=131072

Const WS_OVERLAPPED = &H00000000 ' dec=0

Const WS_SYSMENU = &H00080000 ' dec=524288

Const WS_THICKFRAME = &H00040000 ' dec=262144

Const WS_VISIBLE = &H10000000 ' dec=268435456

Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX

' CONSTANTS USED BY MapVirtualKey FOR PARAMETER uMapType

' https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-mapvirtualkeya

Const MAPVK_VK_TO_VSC = 0 ' The uCode parameter is a virtual-key code and is translated into a scan code. If it is a virtual-key code that does not distinguish between left- and right-hand keys, the left-hand scan code is returned. If there is no translation, the function returns 0.

Const MAPVK_VSC_TO_VK = 1 ' The uCode parameter is a scan code and is translated into a virtual-key code that does not distinguish between left- and right-hand keys. If there is no translation, the function returns 0. Windows Vista and later: the high byte of the uCode value can contain either 0xe0 or 0xe1 to specify the extended scan code.

Const MAPVK_VK_TO_CHAR = 2 ' The uCode parameter is a virtual-key code and is translated into an unshifted character value in the low order word of the return value. Dead keys (diacritics) are indicated by setting the top bit of the return value. If there is no translation, the function returns 0. See Remarks.

Const MAPVK_VSC_TO_VK_EX = 3 ' The uCode parameter is a scan code and is translated into a virtual-key code that distinguishes between left- and right-hand keys. If there is no translation, the function returns 0. Windows Vista and later: the high byte of the uCode value can contain either 0xe0 or 0xe1 to specify the extended scan code.

Const MAPVK_VK_TO_VSC_EX = 4 ' Windows Vista and later: The uCode parameter is a virtual-key code and is translated into a scan code. If it is a virtual-key code that does not distinguish between left- and right-hand keys, the left-hand scan code is returned. If the scan code is an extended scan code, the high byte of the returned value will contain either 0xe0 or 0xe1 to specify the extended scan code. If there is no translation, the function returns 0.

' ================================================================================================================================================================

' END API CONSTANTS

' ================================================================================================================================================================

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN RAW INPUT TYPES

' FOR TYPE CONVERSION SEE: "QB64PE C Libraries" at:

' https://qb64phoenix.com/qb64wiki/index.php/C_Libraries

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWINPUTDEVICE structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevice

'typedef struct tagRAWINPUTDEVICE {

'  USHORT usUsagePage;

'  USHORT usUsage;

'  DWORD  dwFlags;

'  HWND   hwndTarget;

'} RAWINPUTDEVICE, *PRAWINPUTDEVICE, *LPRAWINPUTDEVICE;

' Spriggsy's version:

Type RAWINPUTDEVICE

    As Unsigned Integer usUsagePage, usUsage

    As Unsigned Long dwFlags

    As Offset hwndTarget

End Type

' ^^^ Should "Unsigned Integer" be "_UNSIGNED INTEGER"

'     and    "Unsigned Long" be "_UNSIGNED LONG"

'     and    "Offset" be "_OFFSET" like this?:

'

'TYPE RAWINPUTDEVICE

'    usUsagePage AS _UNSIGNED INTEGER ' WORD

'    usUsage     AS _UNSIGNED INTEGER ' WORD

'    dwFlags     AS _UNSIGNED LONG ' DWORD

'    hwndTarget  AS _OFFSET ' DWORD

'END TYPE

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWINPUTDEVICELIST structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputdevicelist

'typedef struct tagRAWINPUTDEVICELIST {

'  HANDLE hDevice;

'  DWORD  dwType;

'} RAWINPUTDEVICELIST, *PRAWINPUTDEVICELIST;

' Spriggsy's version:

Type RAWINPUTDEVICELIST

    As Offset hDevice

    As Unsigned Long dwType

    $If 64BIT Then

        As String * 4 alignment

    $End If

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'POINT structure (windef.h)

'https://learn.microsoft.com/en-us/windows/win32/api/windef/ns-windef-point

'typedef struct tagPOINT {

'  LONG x;

'  LONG y;

'} POINT, *PPOINT, *NPPOINT, *LPPOINT;

Type POINT

    As Long x, y

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'MSG structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-msg

'typedef struct tagMSG {

'  HWND   hwnd;

'  UINT   message;

'  WPARAM wParam;

'  LPARAM lParam;

'  DWORD  time;

'  POINT  pt;

'  DWORD  lPrivate;

'} MSG, *PMSG, *NPMSG, *LPMSG;

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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'WNDCLASSEXA structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-wndclassexa

'typedef struct WNDCLASSEXA {

'  UINT      cbSize;

'  UINT      style;

'  WNDPROC   lpfnWndProc;

'  int       cbClsExtra;

'  int       cbWndExtra;

'  HINSTANCE hInstance;

'  HICON     hIcon;

'  HCURSOR   hCursor;

'  HBRUSH    hbrBackground;

'  LPCSTR    lpszMenuName;

'  LPCSTR    lpszClassName;

'  HICON     hIconSm;

'} WNDCLASSEXA, *PWNDCLASSEXA, *NPWNDCLASSEXA, *LPWNDCLASSEXA;

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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RECT structure (windef.h)

'https://learn.microsoft.com/en-us/windows/win32/api/windef/ns-windef-rect

'typedef struct tagRECT {

'  LONG left;     Specifies the x-coordinate of the upper-left corner of the rectangle.

'  LONG top;      Specifies the y-coordinate of the upper-left corner of the rectangle.

'  LONG right;    Specifies the x-coordinate of the lower-right corner of the rectangle.

'  LONG bottom;   Specifies the y-coordinate of the lower-right corner of the rectangle.

'} RECT, *PRECT, *NPRECT, *LPRECT;

Type RECT

    As Long left, top, right, bottom

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'PAINTSTRUCT structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-paintstruct

'typedef struct tagPAINTSTRUCT {

'  HDC  hdc;

'  BOOL fErase;

'  RECT rcPaint;

'  BOOL fRestore;

'  BOOL fIncUpdate;

'  BYTE rgbReserved[32];

'} PAINTSTRUCT, *PPAINTSTRUCT, *NPPAINTSTRUCT, *LPPAINTSTRUCT;

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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWINPUTHEADER structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinputheader

'typedef struct tagRAWINPUTHEADER {

'  DWORD  dwType;

'  DWORD  dwSize;

'  HANDLE hDevice;

'  WPARAM wParam;

'} RAWINPUTHEADER, *PRAWINPUTHEADER, *LPRAWINPUTHEADER;

' Spriggsy's version:

Type RAWINPUTHEADER

    As Unsigned Long dwType, dwSize

    As Offset hDevice

    As Unsigned Offset wParam

End Type

' ^^^ Doesn't match the types I expected, should it be these?:

'TYPE RAWINPUTHEADER

'    dwType  AS _UNSIGNED LONG ' DWORD

'    dwSize  AS _UNSIGNED LONG ' DWORD

'    hDevice AS _UNSIGNED LONG ' DWORD <- should this be _OFFSET ?

'    wParam  AS LONG

'END TYPE

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWMOUSE structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawmouse

'typedef struct tagRAWMOUSE {

'  USHORT usFlags;

'  union {

'    ULONG ulButtons;

'    struct {

'      USHORT usButtonFlags;

'      USHORT usButtonData;

'    } DUMMYSTRUCTNAME;

'  } DUMMYUNIONNAME2;

'  ULONG  ulRawButtons;

'  LONG   lLastX;

'  LONG   lLastY;

'  ULONG  ulExtraInformation;

'} RAWMOUSE, *PRAWMOUSE, *LPRAWMOUSE;

' Spriggsy's simplified version:

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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWKEYBOARD structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawkeyboard

'typedef struct tagRAWKEYBOARD {

'  USHORT MakeCode;

'  USHORT Flags;

'  USHORT Reserved;

'  USHORT VKey;

'  UINT   Message;

'  ULONG  ExtraInformation;

'} RAWKEYBOARD, *PRAWKEYBOARD, *LPRAWKEYBOARD;

Type RAWKEYBOARD

    MakeCode As _Unsigned Integer ' USHORT

    Flags As _Unsigned Integer ' USHORT

    Reserved As _Unsigned Integer ' USHORT

    VKey As _Unsigned Integer ' USHORT

    Message As _Unsigned Long ' UINT

    ExtraInformation As _Unsigned _Offset ' ULONG

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWINPUT structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawinput

'typedef struct tagRAWINPUT {

'  RAWINPUTHEADER header;

'  union {

'    RAWMOUSE    mouse;

'    RAWKEYBOARD keyboard;

'    RAWHID      hid;

'  } data;

'} RAWINPUT, *PRAWINPUT, *LPRAWINPUT;

' Spriggsy's simplified version:

Type RAWINPUT

    As RAWINPUTHEADER header

    As RAWMOUSE mouse

    'As RAWKEYBOARD keyboard <- ADDING THIS CAUSES THE PROGRAM TO CRASH ON MOUSE INPUT

End Type

' Simplified copy for keyboard:

Type RAWINPUT_K

    As RAWINPUTHEADER header

    As RAWKEYBOARD keyboard

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RID_DEVICE_INFO_MOUSE structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_mouse

'typedef struct tagRID_DEVICE_INFO_MOUSE {

'  DWORD dwId;

'  DWORD dwNumberOfButtons;

'  DWORD dwSampleRate;

'  BOOL  fHasHorizontalWheel;

'} RID_DEVICE_INFO_MOUSE, *PRID_DEVICE_INFO_MOUSE;

Type RID_DEVICE_INFO_MOUSE

    dwId As _Unsigned Long

    dwNumberOfButtons As _Unsigned Long

    dwSampleRate As _Unsigned Long

    fHasHorizontalWheel As Integer

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RID_DEVICE_INFO_KEYBOARD structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_keyboard

'typedef struct tagRID_DEVICE_INFO_KEYBOARD {

'  DWORD dwType;

'  DWORD dwSubType;

'  DWORD dwKeyboardMode;

'  DWORD dwNumberOfFunctionKeys;

'  DWORD dwNumberOfIndicators;

'  DWORD dwNumberOfKeysTotal;

'} RID_DEVICE_INFO_KEYBOARD, *PRID_DEVICE_INFO_KEYBOARD;

Type RID_DEVICE_INFO_KEYBOARD

    dwType As _Unsigned Long ' DWORD

    dwSubType As _Unsigned Long ' DWORD

    dwKeyboardMode As _Unsigned Long ' DWORD

    dwNumberOfFunctionKeys As _Unsigned Long ' DWORD

    dwNumberOfIndicators As _Unsigned Long ' DWORD

    dwNumberOfKeysTotal As _Unsigned Long ' DWORD

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RID_DEVICE_INFO_HID structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info_hid

'typedef struct tagRID_DEVICE_INFO_HID {

'  DWORD  dwVendorId;

'  DWORD  dwProductId;

'  DWORD  dwVersionNumber;

'  USHORT usUsagePage;

'  USHORT usUsage;

'} RID_DEVICE_INFO_HID, *PRID_DEVICE_INFO_HID;

Type RID_DEVICE_INFO_HID

    dwVendorId As _Unsigned Long ' DWORD

    dwProductId As _Unsigned Long ' DWORD

    dwVersionNumber As _Unsigned Long ' DWORD

    usUsagePage As _Unsigned Integer ' USHORT

    usUsage As _Unsigned Integer ' USHORT

End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' NEEDS FIXING:

'RID_DEVICE_INFO structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rid_device_info

'typedef struct tagRID_DEVICE_INFO {

'  DWORD cbSize;

'  DWORD dwType;

'  union {

'    RID_DEVICE_INFO_MOUSE    mouse;

'    RID_DEVICE_INFO_KEYBOARD keyboard;

'    RID_DEVICE_INFO_HID      hid;

'  } DUMMYUNIONNAME1;

'} RID_DEVICE_INFO, *PRID_DEVICE_INFO, *LPRID_DEVICE_INFO;

' ^^^ NOT SURE HOW TO DEFINE THIS, SHOULD IT BE SOMETHING LIKE THIS?:

'Type DUMMYUNIONNAME1

'    My_RID_DEVICE_INFO_MOUSE As _Offset ' pointer to VAR A1

'    My_RID_DEVICE_INFO_KEYBOARD As _Offset ' pointer to VAR A2

'    My_RID_DEVICE_INFO_HID As _Offset ' pointer to VAR A3

'End Type

'Type RID_DEVICE_INFO

'    cbSize As _Unsigned Long ' DWORD

'    dwType As _Unsigned Long ' DWORD

'    My_DUMMYUNIONNAME1 As _Offset ' pointer to DUMMYUNIONNAME1

'End Type

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'RAWHID structure (winuser.h)

'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-rawhid

'typedef struct tagRAWHID {

'  DWORD dwSizeHid;

'  DWORD dwCount;

'  BYTE  bRawData[1];

'} RAWHID, *PRAWHID, *LPRAWHID;

Type RAWHID

    dwSizeHid As _Unsigned Long ' DWORD

    dwCount As _Unsigned Long ' DWORD

    bRawData As _Unsigned _Byte ' bRawData[1] AS BYTE

End Type

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END RAW INPUT TYPES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN CUSTOM TYPES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' UDT TO HOLD THE INFO FOR EACH MOUSE (READ MICE SUB)

Type MouseInfoType

    ID As String ' player identifier or mouse device ID

    char As String ' cursor character

    '' ReadMiceMain, ReadMiceSub:

    'UpdateCount As Integer ' if this value changes we know a value changed

    ' ReadMiceMain:

    'OldUpdateCount As Integer ' if this value changes we know a value changed

    'x As Integer ' screen x position

    'y As Integer ' screen y position

    dx As Integer ' mouse x movement -1=left, 1=right, 0=none

    dy As Integer ' mouse y movement -1=up  , 1=down , 0=none

    px As Long ' pointer x position (hires) for absolute position of mouse from raw input api

    py As Long ' pointer y position (hires) for absolute position of mouse from raw input api

    ' Multimouse:

    pdx As Long ' mouse x movement (hires) can be greater than just -1 or +1

    pdy As Long ' mouse y movement (hires) can be greater than just -1 or +1

    wheel As Integer ' mouse wheel value

    'wheelOld As Integer ' old mouse wheel value

    LeftDown As Integer ' tracks left mouse button state, TRUE=down

    'LeftDownOld As Integer ' old left mouse button state, TRUE=down

    MiddleDown As Integer ' tracks middle mouse button state, TRUE=down

    'MiddleDownOld As Integer ' old middle mouse button state, TRUE=down

    RightDown As Integer ' tracks right mouse button state, TRUE=down

    'RightDownOld As Integer ' old right mouse button state, TRUE=down

End Type ' MouseInfoType

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END CUSTOM TYPES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN API DECLARATIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ================================================================================================================================================================

' BEGIN CustomType Library definitions

' ================================================================================================================================================================

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' FOR RAW INPUT API

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

Declare CustomType Library

    'DECLARE FUNCTION GetRawInputDeviceList LIB "USER32.DLL" ALIAS "GetRawInputDeviceList"( _

    '    BYREF pRawInputDeviceList AS RAWINPUTDEVICELIST, _

    '    BYREF puiNumDevices AS _UNSIGNED LONG, _

    '    BYVAL cbSize AS _UNSIGNED LONG _

    '    ) AS _UNSIGNED LONG

    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)

    'DECLARE FUNCTION RegisterRawInputDevices LIB "USER32.DLL" ALIAS "RegisterRawInputDevices"( _

    '    BYREF pRawInputDevices AS RAWINPUTDEVICE, _

    '    BYVAL uiNumDevices AS _UNSIGNED LONG, _

    '    BYVAL cbSize AS _UNSIGNED LONG _

    '    ) AS 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)

    'DECLARE FUNCTION GetRawInputData LIB "USER32.DLL" ALIAS "GetRawInputData"( _

    '    BYVAL hRawInput AS _UNSIGNED LONG, _

    '    BYVAL uiCommand AS _UNSIGNED LONG, _

    '    BYREF pData AS _OFFSET, _

    '    BYREF pcbSize AS _UNSIGNED LONG, _

    '    BYVAL cbSizeHeader AS _UNSIGNED LONG _

    '    ) AS _UNSIGNED LONG

    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)

    'DECLARE FUNCTION SendMessage LIB "USER32.DLL" ALIAS "SendMessageA"( _

    '    BYVAL hWnd AS _OFFSET, _

    '    BYVAL Msg AS _UNSIGNED LONG, _

    '    BYVAL wParam AS _UNSIGNED LONG, _

    '    BYVAL lParam AS LONG _

    '    ) 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)

    'Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

    Sub GetClientRect (ByVal hWnd As Offset, Byval lpRect As Offset)

    'Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

    Sub DrawText (ByVal hdc As Offset, Byval lpchText As Offset, Byval cchText As Long, Byval lprc As Offset, Byval format As Unsigned Long)

    'Public Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As 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 ' CustomType Library

' 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

' ================================================================================================================================================================

' END CustomType Library definitions

' ================================================================================================================================================================

' ================================================================================================================================================================

' BEGIN Library definitions

' ================================================================================================================================================================

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

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' Needed for acquiring the hWnd of the window

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

Declare Library

    Function FindWindow& (ByVal ClassName As _Offset, WindowName$) ' To get hWnd handle

End Declare

' ================================================================================================================================================================

' END Library definitions

' ================================================================================================================================================================

' ================================================================================================================================================================

' BEGIN Dynamic Library definitions

' ================================================================================================================================================================

Declare Dynamic Library "user32"

    ' FOR CONTROLLING WINDOW ON TOP, ETC.:

    Function FindWindowA%& (ByVal lpClassName%&, Byval lpWindowName%&)

    Function SetWindowPos& (ByVal hWnd%&, Byval hWndInsertAfter%&, Byval X&, Byval Y&, Byval cx&, Byval cy&, Byval uFlags~&)

    Function GetForegroundWindow%&

    ' To make window invisible

    Function SetLayeredWindowAttributes& (ByVal hwnd As _Offset, Byval crKey As Long, Byval bAlpha As _Unsigned _Byte, Byval dwFlags As Long)

    Function GetWindowLong& Alias "GetWindowLongA" (ByVal hwnd As _Offset, Byval nIndex As Long)

    Function SetWindowLong& Alias "SetWindowLongA" (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)

End Declare

Declare Dynamic Library "kernel32"

    Function GetLastError~& ()

End Declare

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

' To keep focus on window

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------

'Declare Dynamic Library "user32"

'    Sub ShowWindow (ByVal hWnd As _Offset, Byval nCmdShow As Long)

'End Declare

' ================================================================================================================================================================

' END Dynamic Library definitions

' ================================================================================================================================================================

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END API DECLARATIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN GLOBAL VARIABLES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' GLOBAL VARIABLES TO TRACK ERROR STATE

Dim Shared m_sError As String: m_sError = ""

Dim Shared m_sIncludeError As String: m_sIncludeError = ""

' 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)

Dim Shared m_sTriggerFile As String: m_sTriggerFile = m_ProgramPath$ + "ReadMiceSub.DELETE-TO-CLOSE"

Dim Shared m_sDebugFile As String: m_sDebugFile = m_ProgramPath$ + m_ProgramName$ + ".txt"

' RAW INPUT VARIABLES

Dim Shared rawinputdevices As String

Dim Shared hDlg As _Unsigned Long ' DWORD

' MOUSE VARIABLES

Dim Shared arrMouse(0 To 8) As MouseInfoType ' STORES INFO FOR EACH MOUSE

Dim Shared iMouseCount As Integer ' # OF MICE ATTACHED

Dim Shared iMinX As Long

Dim Shared iMaxX As Long

Dim Shared iMinY As Long

Dim Shared iMaxY As Long

' KEYBOARD VARIABLES

'Dim Shared arrKeyIndex(8) As String ' STORES KEYBOARD ID

'Dim Shared arrLastKeyDown(8) As Integer ' STORES LAST KEY PRESSED

'Dim Shared arrLastKeyUp(8) As Integer ' STORES LAST KEY RELEASED

'Dim Shared iKeyBoardCount As Integer ' # OF KEYBOARDS ATTACHED

Dim Shared iLastKeyDown As Integer

Dim Shared iLastKeyUp As Integer

' NETWORK VARIABLES

Dim Shared uintPort As _Unsigned Integer ' port

Dim Shared lngConn As Long ' c&

Dim Shared iData As Integer ' i

Dim Shared sOutput As String ' s$

' HANDLE FOR THE PROGRAM WINDOW

Dim Shared MyHwnd As _Offset ' _Integer64 hwnd%&

Dim Shared hwndMain As _Offset

' SCREEN SIZE

Dim Shared lngScreenWidth As Long

Dim Shared lngScreenHeight As Long

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END GLOBAL VARIABLES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' EXECUTION STARTS HERE!

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ENABLE / DISABLE DEBUG CONSOLE WINDOW

If cDebugEnabled = TRUE Then

    ' $Console

    ' _Delay 4

    ' _Console On

    ' _Echo "Started " + m_ProgramName$

    ' _Echo "Debugging on..."

End If

' INITIALIZE

iMinX = 0

iMaxX = 1024 '_DesktopWidth '3583

iMinY = 0

iMaxY = 768 '_DesktopHeight ' 8202

lngScreenWidth = 1024 ' _DESKTOPWIDTH

lngScreenHeight = 768 ' _DESKTOPHEIGHT

' START THE MAIN ROUTINE

main

' DEACTIVATE DEBUGGING WINDOW

If cDebugEnabled = TRUE Then

    ' _Console Off

End If

' EXIT PROGRAM

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

    Dim sPort As String

    Dim iLoop As Integer

    Dim in$

    Dim MyTime##

    ' MAKE SURE WE HAVE INPUT

    sPort = Command$(1)

    If Len(sPort) > 0 Then

        If IsNumber%(sPort) = TRUE Then

            ' OPEN CONNECTION

            uintPort = Val(sPort)

            lngConn = _OpenClient("tcp/ip:" + _Trim$(Str$(uintPort)) + ":localhost")

            Print lngConn

            ' INITIALIZE

            iMinX = 0

            iMaxX = 1024 '3583

            iMinY = 0

            iMaxY = 768 '8202

            ' ****************************************************************************************************************************************************************

            ' ****************************************************************************************************************************************************************

            ' SET UP WINDOW TO BE SAME SIZE AS, AND OVERLAPPED WITH HOST WINDOW

            ' ****************************************************************************************************************************************************************

            ' ****************************************************************************************************************************************************************

            ' 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?

            '' ATTEMPT FULLSCREEN <- NOT REALLY WORKING

            '_FULLSCREEN _STRETCH, _SMOOTH

            'IF _FULLSCREEN = 0 THEN _FULLSCREEN _OFF 'check that a full screen mode initialized

            ' MAXIMIZE WINDOW

            'DOESN'T WORK: $RESIZE:STRETCH

            'DOESN'T WORK: $RESIZE:SMOOTH

            ' TRY JUST SAVING THE DESKTOP SIZE AND USING THAT WHEN DOING A NEW SCREEN

            ' Use _DESKTOPWIDTH and _DESKTOPHEIGHT to find the current desktop resolution to place the program’s window.

            lngScreenWidth = 1024 '_DesktopWidth

            lngScreenHeight = 768 '_DesktopHeight

            '' CLICK ON SCREEN TO GIVE IT THE FOCUS

            ''_SCREENCLICK column%, row%[, button%]

            '_SCREENCLICK 0, 0

            ' CREATE TRIGGER FILE

            Open m_sTriggerFile For Output As #1

            Print #1, "Deleting this file will cause program " + m_ProgramName$ + " to stop running."

            Close #1

            ' WAIT UNTIL FILE IS CREATED

            ' (time out after 10 seconds)

            MyTime## = ExtendedTimer + 10

            Do

                If _FileExists(m_sTriggerFile) = TRUE Then Exit Do

            Loop Until Timer > MyTime##

            If _FileExists(m_sTriggerFile) = FALSE Then

                m_sError = "Trigger file not found: " + Chr$(34) + m_sTriggerFile + Chr$(34)

            End If

            If Len(m_sError) = 0 Then

                ' GET HANDLE TO THE PROGRAM WINDOW

                Do

                    MyHwnd = _WindowHandle

                Loop Until MyHwnd

                ' GIVE CONTROL TO THE EVENT-ORIENTED CODE

                System Val(Str$(WinMain))

            Else

                Print "ERROR: " + m_sError

            End If

        Else

            Print "Invalid non-numeric input " + Chr$(34) + sPort + Chr$(34) + ". Exiting."

        End If

    Else

        Print "No input. Exiting."

    End If

End Sub ' main

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END MAIN ROUTINES

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN RAW INPUT FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' Runs first

Function WinMain~%& ()

    'Dim As Offset hwndMain

    Dim As Offset hInst

    Dim As Offset hWndTop

    Dim As MSG msg

    Dim As WNDCLASSEX wndclass

    Dim As String szMainWndClass

    Dim As String szWinTitle

    Dim As Unsigned Integer reg

    Dim sData As String

    Dim iKeyLoop As Integer

    Dim iKeyCode As Integer

    Dim iLoop As Integer

    Dim sResult As String

    'DEBUG: TRY FULL SCREEN <- PROGRAM CRASHES!

    '_FullScreen _SquarePixels

    hInst = GetModuleHandle(0)

    szMainWndClass = "WinTestWin" + 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

    ' INITIALIZE RAW INPUT

    InitRawInput

    If Len(m_sError) = 0 Then

        ' SET WINDOW SiZE + INITIALIZE WINDOW

        'Q: HOW CAN WE USE THE QB64PE PROGRAM'S WINDOW HANDLE e.g. _WindowHandle ?

        hwndMain = CreateWindowEx( _

            0, _

            MAKELPARAM(reg, 0), _

            Offset(szWinTitle), _

            WS_OVERLAPPEDWINDOW, _

            0, _

            0, _

            lngScreenWidth, _

            lngScreenHeight, _

            0, _

            0, _

            hInst, _

            0)

        ShowWindow hwndMain, SW_SHOW

        ' TURN SUB WINDOW INVISIBLE

        ''SetWindowOpacity MyHwnd, cInvisible

        'SetWindowOpacity hwndMain, cTransparent ' <- USE THIS FOR TESTING

        'SetWindowOpacity hwndMain, 50 ' <- USE THIS FOR TESTING

        SetWindowOpacity hwndMain, cInvisible

        ' KEEP WINDOW VISIBLE

        'DEBUG: SUBSTITUTE _WindowHandle

        'UpdateWindow _WindowHandle

        UpdateWindow hwndMain

        ' MOVE WINDOW TO TOP

        '' GET WINDOW HANDLES

        'hWndThis = _WindowHandle ' FindWindowA(0, _OFFSET(t))

        hWndTop = GetForegroundWindow%& ' find currently focused process handle

        ' GET FOCUS

        If hwndMain <> hWndTop Then

            _ScreenClick 240, 240 ' add 40 to x and y to focus on positioned window

        End If

        ' MOVE TO TOP

        'Function SetWindowPos& (ByVal hWnd%&, Byval hWndInsertAfter%&, Byval X&, Byval Y&, Byval cx&, Byval cy&, Byval uFlags~&)

        'If SetWindowPos(hwndMain, HWND_TOPMOST, 200, 200, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE) = 0 Then

        If SetWindowPos(hwndMain, HWND_TOPMOST, 0, 0, 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

        '' DEBUG

        'DebugLog ""

        'DebugLog "AFTER InitRawInput:"

        'For iLoop = LBound(arrMouse) To UBound(arrMouse)

        '   DebugLog "    arrMouse(" + _Trim$(Str$(iLoop)) + ").ID = " + chr$(34) + arrMouse(iLoop).ID + chr$(34)

        'Next iLoop

        'DebugLog ""

        ' IF EVERYTHING IS WORKING, CONTINUE

        If Len(m_sError) = 0 Then

            ' START THE INPUT ROUTINES

            InitInputVars

            '' DEBUG

            'DebugLog "AFTER InitInputVars:"

            'For iLoop = LBound(arrMouse) To UBound(arrMouse)

            '   DebugLog "    arrMouse(" + _Trim$(Str$(iLoop)) + ").ID = " + chr$(34) + arrMouse(iLoop).ID + chr$(34)

            'Next iLoop

            'DebugLog ""

            ' SEND SUB WINDOW HANDLE BACK TO MAIN

            _Delay 2

            sData = "w:" + _Trim$(Str$(hwndMain)) + Chr$(13)

            'If cDebugEnabled = TRUE Then

            '    DebugLog "Put #lngConn, , sData"

            '    DebugLog "Put #" + _Trim$(Str$(lngConn)) + ", , " + Chr$(34) + sData + Chr$(34)

            'End If

            _Delay 2

            Put #lngConn, , sData

            _Delay 2

            ' MAIN PROGRAM LOOP

            While GetMessage(Offset(msg), 0, 0, 0)

                TranslateMessage Offset(msg)

                DispatchMessage Offset(msg)

                ' QUIT IF TRIGGER FILE IS GONE

                If _FileExists(m_sTriggerFile) = FALSE Then

                    System

                End If

                ' KEEP WINDOW ON TOP

                If _WindowHasFocus = 0 Then

                    _ScreenIcon

                    ''ShowWindow MyHwnd, 1

                    'ShowWindow hwndMain, 1

                    ShowWindow hwndMain, SW_SHOW

                End If

            Wend

        Else

            'If cDebugEnabled = TRUE Then

            '    DebugLog "Error, can't return hwndMain: " + m_sError

            'End If

        End If

    End If

    ' SEND ANY ERROR MESSAGES BACK TO MAIN

    If Len(m_sError) > 0 Then

        _Delay 2

        sData = "e:" + m_sError + Chr$(13)

        Put #lngConn, , sData

        _Delay 2

        ' SHOW EROR MESSAGE

        If cDebugEnabled Then

            Screen 0

            Cls

            Print "Error:"

            Print m_sError

            Sleep

        End If

    End If

    ' RETURN A VALUE

    WinMain = msg.wParam

End Function ' WinMain

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

' Handles main window events

' MESSAGE TYPES FOR READING THE KEYBOARD:

' WM_CHAR

' WM_KEYDOWN

' WM_KEYUP

' WM_SYSCHAR

' WM_SYSKEYDOWN

' WM_SYSKEYUP

Function MainWndProc%& (hwnd As Offset, nMsg As Unsigned Long, wParam As Unsigned Offset, lParam As Offset)

    ' EVENT HANDLER VARIABLES PART 1

    Static As Offset hwndButton

    Static As Long cx, cy

    Dim As Offset hdc

    Dim As PAINTSTRUCT ps

    Dim As RECT rc

    Dim As RECT TargetRect

    Dim As MEM lpb

    Dim As Unsigned Long dwSize

    Dim As RAWINPUT rawm ' MOUSE VERSION

    Dim As RAWINPUT_K rawk ' KEYBOARD VERSION

    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 iLine As Integer

    Dim iLen As Integer

    Dim iCount As Integer

    Dim sCount As String

    Dim sText As String

    Dim sX As String

    Dim sY As String

    Dim sPX As String

    Dim sPY 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

    Dim iInputType As Integer

    ' EVENT HANDLER VARIABLES PART 2

    Dim pRawInput As _Offset ' RAWINPUT POINTER

    Dim zKeyName As String ' ASCIIZ * 50 = NULL-terminated string

    Dim sRawInput As String

    Dim sBuffer As String

    Dim ScanCode As _Unsigned Long ' DWORD

    Static hFocusBak As _Unsigned Long ' DWORD

    Dim RawInputDevCount As Long

    Dim KeyboardTypeCount As Long

    Dim RawInputDeviceIndex As Long

    Dim ByteCount As Long

    Dim int_wParam As Integer

    Dim vbCrLf As String: vbCrLf = Chr$(13) + Chr$(10)

    Dim vbCr As String: vbCr = Chr$(13)

    Dim vbLf As String: vbLf = Chr$(10)

    ReDim arrText$(0)

    ' HANDLE EVENT MESSAGES

    Select Case nMsg

        Case WM_DESTROY:

            'DebugPrint "nMsg = WM_DESTROY"

            PostQuitMessage 0

            MainWndProc = 0

            Exit Function

        Case WM_INPUT:

            'DebugPrint "nMsg = WM_INPUT"

            ' MOUSE VERSION:

            GetRawInputData lParam, RID_INPUT, 0, Offset(dwSize), Len(rih)

            ' KEYBOARD VERSION:

            'GetRawInputData(CBLPARAM, %RID_INPUT, BYVAL %NULL, ByteCount, SIZEOF(RAWINPUTHEADER)) ' Get size of raw input buffer

            lpb = MemNew(dwSize)

            If lpb.SIZE = 0 Then

                MainWndProc = 0

                Exit Function

            End If

            ' GET THE RAW INPUT

            If GetRawInputData(lParam, RID_INPUT, lpb.OFFSET, Offset(dwSize), Len(rih)) <> dwSize Then

                'TODO: BUBBLE UP THE ERROR MESSAGE?

                Print "GetRawInputData doesn't return correct size!"

                'DebugPrint "WRONG SIZE: GetRawInputData doesn't return correct size!"

            End If

            ' IDENTIFY TYPE OF INPUT

            Select Case dwSize

                Case Len(rawm):

                    ' MOUSE INPUT

                    'DebugPrint "dwSize = Len(rawm) so MOUSE INPUT DETECTED"

                    iInputType = RIM_TYPEMOUSE

                    MemGet lpb, lpb.OFFSET, rawm

                Case Len(rawk):

                    ' KEYBOARD INPUT

                    'DebugPrint "dwSize = Len(rawk) so KEYBOARD INPUT DETECTED"

                    iInputType = RIM_TYPEKEYBOARD

                    MemGet lpb, lpb.OFFSET, rawk

                Case Else:

                    ' SOME OTHER TYPE (MAYBE HID) BUT ONE WE CAN'T PROCESS

                    'DebugPrint "dwSize = SOME OTHER TYPE (MAYBE HID)"

                    iInputType = RIM_TYPEUNKNOWN

            End Select

            If iInputType = RIM_TYPEMOUSE Then

                'DebugLog "iInputType = RIM_TYPEMOUSE"

                If rawm.header.dwType = RIM_TYPEMOUSE Then

                    'DebugLog "    rawm.header.dwType = RIM_TYPEMOUSE"

                    tmpx = rawm.mouse.lLastX

                    tmpy = rawm.mouse.lLastY

                    maxx = tmpx

                    ' UPDATE RANGE OF MOUSE COORDINATES

                    If GET_X_LPARAM(lParam) < iMinX Then iMinX = GET_X_LPARAM(lParam)

                    If GET_X_LPARAM(lParam) > iMaxX Then iMaxX = GET_X_LPARAM(lParam)

                    If GET_Y_LPARAM(lParam) < iMinY Then iMinY = GET_Y_LPARAM(lParam)

                    If GET_Y_LPARAM(lParam) > iMaxY Then iMaxY = GET_Y_LPARAM(lParam)

                    ' IDENTIFY WHICH MOUSE IT IS

                    strNextID = _Trim$(Str$(rawm.header.hDevice))

                    'DebugPrint "    strNextID = " + Chr$(34) + strNextID + Chr$(34)

                    'DebugLog "        strNextID = " + Chr$(34) + strNextID + Chr$(34)

                    ' GET ARRAY INDEX FROM strnextID

                    iIndex = GetMouseIndex%(strNextID)

                    'DebugPrint "    iIndex =  GetMouseIndex%(" + chr$(34) + strNextID + chr$(34) + ") = " + _Trim$(Str$(iIndex))

                    'DebugLog "    iIndex =  GetMouseIndex%(" + chr$(34) + strNextID + chr$(34) + ") = " + _Trim$(Str$(iIndex))

                    ' DETECT INPUT

                    If iIndex >= LBound(arrMouse) Then

                        'DebugLog "            iIndex >= LBound(arrMouse)"

                        If iIndex <= UBound(arrMouse) Then

                            'DebugLog "                iIndex <= UBound(arrMouse)"

                            'DebugLog "                    iIndex = " + _Trim$(Str$(iIndex))

                            ' INCREMENT/DECREMENT FIXED DELTA X

                            If rawm.mouse.lLastX < 0 Then

                                arrMouse(iIndex).dx = -1

                                'arrMouse(iIndex).x = arrMouse(iIndex).x - 1

                            ElseIf rawm.mouse.lLastX > 0 Then

                                arrMouse(iIndex).dx = 1

                                'arrMouse(iIndex).x = arrMouse(iIndex).x + 1

                            End If

                            'DebugLog "                    arrMouse(iIndex).dx = " + _Trim$(Str$(arrMouse(iIndex).dx))

                            ' INCREMENT/DECREMENT FIXED DELTA Y

                            If rawm.mouse.lLastY < 0 Then

                                arrMouse(iIndex).dy = -1

                                'arrMouse(iIndex).y = arrMouse(iIndex).y - 1

                            ElseIf rawm.mouse.lLastY > 0 Then

                                arrMouse(iIndex).dy = 1

                                'arrMouse(iIndex).y = arrMouse(iIndex).y + 1

                            End If

                            'DebugLog "                    arrMouse(iIndex).dy = " + _Trim$(Str$(arrMouse(iIndex).dy))

                            ' INCREMENT/DECREMENT TRUE DELTA

                            arrMouse(iIndex).pdx = rawm.mouse.lLastX

                            arrMouse(iIndex).pdy = rawm.mouse.lLastY

                            arrMouse(iIndex).px = arrMouse(iIndex).px + arrMouse(iIndex).pdx

                            arrMouse(iIndex).py = arrMouse(iIndex).py + arrMouse(iIndex).pdy

                            ' CHECK HIRES CURSOR BOUNDARIES

                            If arrMouse(iIndex).px < cMinPX Then arrMouse(iIndex).px = cMinPX

                            If arrMouse(iIndex).px > cMaxPX Then arrMouse(iIndex).px = cMaxPX

                            If arrMouse(iIndex).py < cMinPY Then arrMouse(iIndex).py = cMinPY

                            If arrMouse(iIndex).py > cMaxPY Then arrMouse(iIndex).py = cMaxPY

                            'DebugLog "                    arrMouse(iIndex).px = " + _Trim$(Str$(arrMouse(iIndex).px))

                            'DebugLog "                    arrMouse(iIndex).py = " + _Trim$(Str$(arrMouse(iIndex).py))

                            ' =============================================================================

                            ' left button = 1 when down, 2 when released

                            If ((rawm.mouse.usButtonFlags And 1) = 1) Then

                                arrMouse(iIndex).LeftDown = TRUE

                            ElseIf ((rawm.mouse.usButtonFlags And 2) = 2) Then

                                arrMouse(iIndex).LeftDown = FALSE

                            End If

                            'DebugLog "                    arrMouse(iIndex).LeftDown = " + TrueFalse$(arrMouse(iIndex).LeftDown)

                            ' =============================================================================

                            ' middle button = 16 when down, 32 when released

                            If ((rawm.mouse.usButtonFlags And 16) = 16) Then

                                arrMouse(iIndex).MiddleDown = TRUE

                            ElseIf ((rawm.mouse.usButtonFlags And 32) = 32) Then

                                arrMouse(iIndex).MiddleDown = FALSE

                            End If

                            'DebugLog "                    arrMouse(iIndex).MiddleDown = " + TrueFalse$(arrMouse(iIndex).MiddleDown)

                            ' =============================================================================

                            ' right button = 4 when down, 8 when released

                            If ((rawm.mouse.usButtonFlags And 4) = 4) Then

                                arrMouse(iIndex).RightDown = TRUE

                            ElseIf ((rawm.mouse.usButtonFlags And 8) = 8) Then

                                arrMouse(iIndex).RightDown = FALSE

                            End If

                            'DebugLog "                    arrMouse(iIndex).RightDown = " + TrueFalse$(arrMouse(iIndex).RightDown)

                            ' =============================================================================

                            ' scroll wheel = ???

                            'Hex$(rawm.mouse.usButtonFlags)

                            '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

                            ' COLLECT VALUES FOR THIS MOUSE TO SEND

                            ' IN THE FOLOWING TAB-DELIMITED FORMAT:

                            ' {mouse #}\t{dx}\t{dy}\t{wheel}\t{leftDown}\t{middleDown}\t{rightDown}\n

                            sOutput = "m:"

                            sOutput = sOutput + _Trim$(Str$(iIndex)) + Chr$(9)

                            'sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).UpdateCount)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).dx)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).dy)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).px)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).py)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).wheel)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).LeftDown)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).MiddleDown)) + Chr$(9)

                            sOutput = sOutput + _Trim$(Str$(arrMouse(iIndex).RightDown)) + Chr$(13)

                            ' SEND VALUES FOR THIS MOUSE TO HOST

                            'DebugLog "                    Put #lngConn, , sOutput"

                            'DebugLog "                    Put #" + _Trim$(Str$(lngConn)) + ", , " + chr$(34) + sOutput + chr$(34)

                            Put #lngConn, , sOutput

                            'DebugLog "                    m_sError = " + chr$(34) + m_sError + chr$(34)

                            ' CLEAR MOVEMENT

                            arrMouse(iIndex).dx = 0

                            arrMouse(iIndex).dy = 0

                            'arrMouse(iIndex).wheelOld = arrMouse(iIndex).wheel

                            'arrMouse(iIndex).LeftDownOld = arrMouse(iIndex).LeftDown

                            'arrMouse(iIndex).MiddleDownOld = arrMouse(iIndex).MiddleDown

                            'arrMouse(iIndex).RightDownOld = arrMouse(iIndex).RightDown

                        End If

                    End If

                    '' INVOKE PAINT

                    'InvalidateRect hwnd, 0, -1

                    'SendMessage hwnd, WM_PAINT, 0, 0

                End If

            ElseIf iInputType = RIM_TYPEKEYBOARD Then

                ' *** FOR NOW RAW KEYBOARD INPUT NOT WORKING

                'DebugPrint "iInputType = RIM_TYPEKEYBOARD"

                'If rawk.header.dwType = RIM_TYPEKEYBOARD Then

                '    DebugPrint "* FOUND RAW INPUT KEYBOARD *"

                '

                '    ' HOW DO WE READ THE KEYBOARD USING RawInputAPI ???

                '    DebugPrint "rawk.header.dwType = RIM_TYPEKEYBOARD"

                '

                '    ' IDENTIFY WHICH KEYBOARD IT IS

                '    strNextID = _Trim$(Str$(rawk.header.hDevice))

                '    DebugPrint "    strNextID = " + Chr$(34) + strNextID + Chr$(34)

                '

                '    '' GET ARRAY INDEX FROM strnextID

                '    'iIndex = GetKeyboardIndex%(strNextID)

                '    'DebugPrint "    iIndex = " + _Trim$(Str$(iIndex))

                '

                'End If

            End If

            ' FINISHUP WM_INPUT

            MemFree lpb

            MainWndProc = 0

            Exit Function

        Case WM_MOUSEMOVE:

            'DebugPrint "nMsg = WM_MOUSEMOVE"

            Exit Function

        Case WM_PAINT:

            'DebugPrint "nMsg = WM_PAINT"

            'hdc = BeginPaint(hwnd, Offset(ps))

            'GetClientRect hwnd, Offset(rc)

            '

            '' -----------------------------------------------------------------------------

            '' DISPLAY MOUSE INFO ON SCREEN AT MOUSE POSITIONS

            'iCount = 0

            'For iIndex = LBound(arrMouse) To UBound(arrMouse)

            '    iCount = iCount + 1

            '

            '    If Len(arrMouse(iIndex).ID) > 0 Then

            '        ' CHECK CURSOR BOUNDARIES

            '        If arrMouse(iIndex).x < cMinX Then arrMouse(iIndex).x = cMinX

            '        If arrMouse(iIndex).x > cMaxX Then arrMouse(iIndex).x = cMaxX

            '        If arrMouse(iIndex).y < cMinY Then arrMouse(iIndex).y = cMinY

            '        If arrMouse(iIndex).y > cMaxY Then arrMouse(iIndex).y = cMaxY

            '

            '        ' CHECK HIRES CURSOR BOUNDARIES

            '        If arrMouse(iIndex).px < cMinPX Then arrMouse(iIndex).px = cMinPX

            '        If arrMouse(iIndex).px > cMaxPX Then arrMouse(iIndex).px = cMaxPX

            '        If arrMouse(iIndex).py < cMinPY Then arrMouse(iIndex).py = cMinPY

            '        If arrMouse(iIndex).py > cMaxPY Then arrMouse(iIndex).py = cMaxPY

            '

            '        ' DEFINE TARGET RECT FOR WHERE TO DRAW ON SCREEN

            '        TargetRect.left = rc.left + arrMouse(iIndex).px

            '        TargetRect.top = rc.top + arrMouse(iIndex).py

            '        TargetRect.right = rc.right + arrMouse(iIndex).px

            '        TargetRect.bottom = rc.bottom + arrMouse(iIndex).py

            '

            '        ' COLLECT VALUES FOR THIS MOUSE IN A STRING

            '        sText = ""

            '        sText = sText + _Trim$(Str$(iCount))

            '        sText = sText + " ("

            '        sText = sText + _Trim$(Str$(arrMouse(iIndex).px))

            '        sText = sText + ","

            '        sText = sText + _Trim$(Str$(arrMouse(iIndex).py))

            '        sText = sText + ") "

            '        sText = sText + IIFS$(arrMouse(iIndex).LeftDown, "1", " ")

            '        sText = sText + IIFS$(arrMouse(iIndex).MiddleDown, "2", " ")

            '        sText = sText + IIFS$(arrMouse(iIndex).RightDown, "3", " ")

            '

            '        'arrMouse(iIndex).wheel

            '        'arrMouse(iIndex).char

            '        'arrMouse(iIndex).y

            '        'arrMouse(iIndex).x

            '

            '        ' DRAW VALUES FOR THIS MOUSE TO SCREEN AT POINTER POSITION

            '        DrawText hdc, Offset(sText), Len(sText), Offset(TargetRect), DT_LEFT

            '        OffsetRect Offset(TargetRect), arrMouse(iIndex).px, arrMouse(iIndex).px

            '    End If

            'Next iIndex

            '

            '' -----------------------------------------------------------------------------

            '' DISPLAY INSTRUCTIONS ON SCREEN

            '' DEFINE TARGET RECT FOR WHERE TO DRAW ON SCREEN

            'TargetRect.left = rc.left + 100

            'TargetRect.top = rc.top + 500

            'TargetRect.right = rc.right + 100

            'TargetRect.bottom = rc.bottom + 500

            '

            '' COLLECT VALUES FOR THIS KEYBOARD IN A STRING

            'sText = ""

            'sText = sText + "Raw Input API multi-mouse demo:"

            'sText = sText + Chr$(13)

            'sText = sText + Chr$(13)

            'sText = sText + "1. Plug in 2 or more USB mice"

            'sText = sText + Chr$(13)

            'sText = sText + "2. Move them around and click the buttons."

            'sText = sText + Chr$(13)

            'sText = sText + "3. Try pressing some keys on the keyboard."

            'sText = sText + Chr$(13)

            'sText = sText + Chr$(13)

            'sText = sText + "Press ESC to exit."

            '

            '' DRAW VALUES FOR THIS KEYBOARD TO SCREEN AT NEXT POSITION

            'DrawText hdc, Offset(sText), Len(sText), Offset(TargetRect), DT_LEFT

            'OffsetRect Offset(TargetRect), 0, 0 ' y,x

            '

            '' -----------------------------------------------------------------------------

            '' DISPLAY KEYBOARD INFO ON SCREEN

            '' DEFINE TARGET RECT FOR WHERE TO DRAW ON SCREEN

            'TargetRect.left = rc.left + 400

            'TargetRect.top = rc.top + 100

            'TargetRect.right = rc.right + 400

            'TargetRect.bottom = rc.bottom + 100

            '

            '' COLLECT VALUES FOR THIS KEYBOARD IN A STRING

            'sText = ""

            'sText = sText + "Keyboard: "

            'sText = sText + IIFS$(iLastKeyDown > 0, VirtualKeyCodeToString$(iLastKeyDown) + " (" + _Trim$(Str$(iLastKeyDown)) + ")", "")

            ''sText = sText + Chr$(13)

            ''sText = sText + "  LAST DOWN="

            ''sText = sText + IIFS$(iLastKeyDown > 0, VirtualKeyCodeToString$(iLastKeyDown), "")

            ''sText = sText + Chr$(13)

            ''sText = sText + "  LAST UP  ="

            ''sText = sText + IIFS$(iLastKeyUp > 0, VirtualKeyCodeToString$(iLastKeyUp), "")

            '

            '' DRAW VALUES FOR THIS KEYBOARD TO SCREEN AT NEXT POSITION

            'DrawText hdc, Offset(sText), Len(sText), Offset(TargetRect), DT_LEFT

            'OffsetRect Offset(TargetRect), 0, 0 ' y,x

            '

            '' -----------------------------------------------------------------------------

            '' FINISH PAINT

            'EndPaint hwnd, Offset(ps)

            '

            MainWndProc = 0

            Exit Function

        Case WM_CHAR:

            'DebugPrint "nMsg = WM_CHAR"

            '' GET AN INTEGER FROM WPARAM

            'If wParam < 32768 Then

            '    int_wParam = Val(_Trim$(Str$(wParam)))

            'Else

            '    int_wParam = -1

            'End If

            '

            '' WM_CHAR message

            '' https://learn.microsoft.com/en-us/windows/win32/inputdev/wm-char

            '' Posted to the window with the keyboard focus when a WM_KEYDOWN message is translated by the TranslateMessage function. The WM_CHAR message contains the character code of the key that was pressed.

            'DebugPrint "nMsg = WM_CHAR"

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            '

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            'MainWndProc = 0

            Exit Function

        Case WM_KEYDOWN:

            'DebugPrint "nMsg = WM_KEYDOWN"

            ' GET AN INTEGER FROM WPARAM

            If wParam < 32768 Then

                int_wParam = Val(_Trim$(Str$(wParam)))

            Else

                int_wParam = -1

            End If

            ' REMEMBER KEY

            iLastKeyDown = int_wParam

            ' WM_KEYDOWN message

            ' Posted to the window with the keyboard focus when a nonsystem key is pressed. A nonsystem key is a key that is pressed when the ALT key is not pressed.

            ' https://learn.microsoft.com/en-us/windows/win32/inputdev/wm-keydown

            'DebugPrint "nMsg = WM_KEYDOWN"

            'DebugPrint "    strNextID  =" + Chr$(34) + strNextID + Chr$(34)

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            ' SEND KEYDOWN EVENT TO HOST

            sOutput = "d:" + _Trim$(Str$(int_wParam)) + Chr$(13)

            Put #lngConn, , sOutput

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            MainWndProc = 0

            Exit Function

        Case WM_KEYUP:

            'DebugPrint "nMsg = WM_KEYUP"

            ' GET AN INTEGER FROM WPARAM

            If wParam < 32768 Then

                int_wParam = Val(_Trim$(Str$(wParam)))

            Else

                int_wParam = -1

            End If

            ' REMEMBER KEY

            iLastKeyUp = int_wParam

            iLastKeyDown = 0

            ' WM_KEYUP message

            ' https://learn.microsoft.com/en-us/windows/win32/inputdev/wm-keyup

            ' Posted to the window with the keyboard focus when a nonsystem key is released. A nonsystem key is a key that is pressed when the ALT key is not pressed, or a keyboard key that is pressed when a window has the keyboard focus.

            'DebugPrint "nMsg = WM_KEYUP"

            'DebugPrint "    strNextID  =" + Chr$(34) + strNextID + Chr$(34)

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            ' SEND KEYUP EVENT TO HOST

            sOutput = "u:" + _Trim$(Str$(int_wParam)) + Chr$(13)

            Put #lngConn, , sOutput

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            MainWndProc = 0

            '' EXIT WHEN USER RELEASES ESCAPE KEY

            'If int_wParam = 27 Then System

            Exit Function

        Case WM_SYSCHAR:

            'DebugPrint "nMsg = WM_SYSCHAR"

            '' GET AN INTEGER FROM WPARAM

            'If wParam < 32768 Then

            '    int_wParam = Val(_Trim$(Str$(wParam)))

            'Else

            '    int_wParam = -1

            'End If

            '

            '' WM_SYSCHAR message

            '' https://learn.microsoft.com/en-us/windows/win32/menurc/wm-syschar

            '' Posted to the window with the keyboard focus when a WM_SYSKEYDOWN message is translated by the TranslateMessage function. It specifies the character code of a system character key that is, a character key that is pressed while the ALT key is down.

            'DebugPrint "nMsg = WM_SYSCHAR"

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            '

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            'MainWndProc = 0

            Exit Function

        Case WM_SYSKEYDOWN:

            'DebugPrint "nMsg = WM_SYSKEYDOWN"

            ' GET AN INTEGER FROM WPARAM

            If wParam < 32768 Then

                int_wParam = Val(_Trim$(Str$(wParam)))

            Else

                int_wParam = -1

            End If

            ' REMEMBER KEY

            iLastKeyDown = int_wParam

            ' WM_SYSKEYDOWN message

            ' https://learn.microsoft.com/en-us/windows/win32/inputdev/wm-syskeydown

            ' Posted to the window with the keyboard focus when the user presses the F10 key (which activates the menu bar) or holds down the ALT key and then presses another key. It also occurs when no window currently has the keyboard focus; in this case, the WM_SYSKEYDOWN message is sent to the active window. The window that receives the message can distinguish between these two contexts by checking the context code in the lParam parameter.

            'DebugPrint "nMsg = WM_SYSKEYDOWN"

            'DebugPrint "    strNextID  =" + Chr$(34) + strNextID + Chr$(34)

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            ' SEND KEYDOWN EVENT TO HOST

            sOutput = "d:" + _Trim$(Str$(int_wParam)) + Chr$(13)

            Put #lngConn, , sOutput

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            MainWndProc = 0

            Exit Function

        Case WM_SYSKEYUP:

            'DebugPrint "nMsg = WM_SYSKEYUP"

            ' GET AN INTEGER FROM WPARAM

            If wParam < 32768 Then

                int_wParam = Val(_Trim$(Str$(wParam)))

            Else

                int_wParam = -1

            End If

            ' REMEMBER KEY

            iLastKeyUp = int_wParam

            iLastKeyDown = 0

            ' WM_SYSKEYUP message

            ' https://learn.microsoft.com/en-us/windows/win32/inputdev/wm-syskeyup

            ' Posted to the window with the keyboard focus when the user releases a key that was pressed while the ALT key was held down. It also occurs when no window currently has the keyboard focus; in this case, the WM_SYSKEYUP message is sent to the active window. The window that receives the message can distinguish between these two contexts by checking the context code in the lParam parameter.

            ' A window receives this message through its WindowProc function.

            'DebugPrint "nMsg = WM_SYSKEYUP"

            'DebugPrint "    strNextID  =" + Chr$(34) + strNextID + Chr$(34)

            'DebugPrint "    Offset hwnd=" + _Trim$(Str$(hwnd)) + ", Unsigned Long nMsg=" + _Trim$(Str$(nMsg)) + ", Unsigned Offset wParam=" + _Trim$(Str$(wParam)) + ", Offset lParam=" + _Trim$(Str$(lParam))

            'DebugPrint "    Pressed key: " + VirtualKeyCodeToString$(int_wParam)

            ' SEND KEYUP EVENT TO HOST

            sOutput = "u:" + _Trim$(Str$(int_wParam)) + Chr$(13)

            Put #lngConn, , sOutput

            '' INVOKE PAINT

            'InvalidateRect hwnd, 0, -1

            'SendMessage hwnd, WM_PAINT, 0, 0

            MainWndProc = 0

            Exit Function

        Case Else:

            ' some other message

            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 iLoop2 As Integer

    Dim strNextID As String

    If GetRawInputDeviceList(0, Offset(nDevices), Len(RawInputDeviceList)) <> 0 Then

        Exit Sub

    End If

    pRawInputDeviceList = MemNew(Len(RawInputDeviceList) * nDevices)

    GetRawInputDeviceList pRawInputDeviceList.OFFSET, Offset(nDevices), Len(RawInputDeviceList)

    ' This small block of commented code proves that we've got the device list

    ReDim As RAWINPUTDEVICELIST rawdevs(0 To nDevices - 1)

    MemGet pRawInputDeviceList, pRawInputDeviceList.OFFSET, rawdevs()

    ' GET DEVICE INFO

    rawinputdevices = "Number of raw input devices:" + Str$(nDevices) + Chr$(13)

    iMouseCount = 0

    'iKeyBoardCount = 0

    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 = RIM_TYPEMOUSE Then

            iMouseCount = iMouseCount + 1 ' INCREMENT THE MOUSE COUNT

            strNextID = _Trim$(Str$(rawdevs(x).hDevice)) ' GET THE MOUSE DEVICE ID

            arrMouse(iMouseCount - 1).ID = strNextID ' SAVE THE MOUSE DEVICE ID

            'arrMouse(iMouseCount - 1).UpdateCount = 0

        ElseIf rawdevs(x).dwType = RIM_TYPEKEYBOARD Then

            'iKeyBoardCount = iKeyBoardCount + 1 ' INCREMENT THE KEYBAORD COUNT

            'strNextID = _Trim$(Str$(rawdevs(x).hDevice)) ' GET THE KEYBOARD DEVICE ID

            'arrKeyIndex(iKeyBoardCount - 1) = strNextID ' SAVE THE KEYBOARD DEVICE ID

            'arrLastKeyDown(iKeyBoardCount - 1) = 0

        End If

    Next x

    ' FOR NOW KEYBOARD INFO IS NOT RAW INPUT, UNTIL WE FIGURE IT OUT:

    iLastKeyDown = 0

    iLastKeyUp = 0

    rawinputdevices = rawinputdevices + Chr$(0)

    MemFree pRawInputDeviceList

    Rid(0).usUsagePage = &H01

    Rid(0).usUsage = &H02

    Rid(0).dwFlags = 0

    Rid(0).hwndTarget = 0

    If RegisterRawInputDevices(Offset(Rid()), 1, Len(Rid(0))) = 0 Then

        m_sError = "RawInput init failed" + Chr$(0)

    End If

End Sub ' InitRawInput

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END RAW INPUT FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN WINDOW FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' hWnd = handle to window to set opacity for

' Level = 0 TO 255, 0=totally invisible, 128=transparent, 255=100% solid

Sub SetWindowOpacity (hWnd As _Offset, Level As _Unsigned _Byte)

    Const cIndex = -20

    Const LWA_ALPHA = &H2

    Const WS_EX_LAYERED = &H80000

    Dim lngMsg As Long

    Dim lngValue As Long

    'Function GetWindowLong& Alias "GetWindowLongA" (ByVal hwnd As _Offset, Byval nIndex As Long)

    lngMsg = GetWindowLong(hWnd, cIndex)

    lngMsg = lngMsg Or WS_EX_LAYERED

    'Function SetWindowLong& Alias "SetWindowLongA" (ByVal hwnd As _Offset, Byval nIndex As Long, Byval dwNewLong As Long)

    lngValue = SetWindowLong(hWnd, cIndex, lngMsg)

    'Function SetLayeredWindowAttributes& (ByVal hwnd As _Offset, Byval crKey As Long, Byval bAlpha As _Unsigned _Byte, Byval dwFlags As Long)

    lngValue = SetLayeredWindowAttributes(hWnd, 0, Level, LWA_ALPHA)

End Sub ' SetWindowOpacity

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END WINDOW FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN RAW INPUT VARIABLE FUNCTIONS #1

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' Initialize variables that store mouse + keyboard input

Sub InitInputVars

    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.

    iIndex = LBound(arrMouse) - 1

    For iLoop = 1 To iMouseCount

        iIndex = iIndex + 1

        'DON'T ERASE THE ID!: arrMouse(iIndex).ID = ""

        'arrMouse(iIndex).UpdateCount = 1

        arrMouse(iIndex).dx = 0

        arrMouse(iIndex).dy = 0

        arrMouse(iIndex).px = cMaxPX / 2 ' 0

        arrMouse(iIndex).py = cMaxPY / 2 ' 0

        arrMouse(iIndex).pdx = 0 ' 100

        arrMouse(iIndex).pdy = 0 ' 100

        arrMouse(iIndex).wheel = 0

        'arrMouse(iIndex).wheelOld = 0

        arrMouse(iIndex).LeftDown = FALSE

        'arrMouse(iIndex).LeftDownOld = FALSE

        arrMouse(iIndex).MiddleDown = FALSE

        'arrMouse(iIndex).MiddleDownOld = FALSE

        arrMouse(iIndex).RightDown = FALSE

        'arrMouse(iIndex).RightDownOld = FALSE

    Next iLoop

    ' INITIALIZE KEYBOARD STATE VARIABLES

    iLastKeyDown = 0

    iLastKeyUp = 0

End Sub ' InitInputVars

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

' 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

        End If

    Next iLoop

    GetMouseIndex% = iIndex%

End Function ' GetMouseIndex%

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

'' Finds position in array arrKeyIndex containing KeyboardID

'

'Function GetKeyboardIndex% (KeyboardID As String)

'    Dim iLoop As Integer

'    Dim iIndex%

'    iIndex% = LBound(arrKeyIndex) - 1

'    For iLoop = LBound(arrKeyIndex) To UBound(arrKeyIndex)

'        If arrKeyIndex(iLoop) = KeyboardID Then

'            iIndex% = iLoop

'            Exit For

'        End If

'    Next iLoop

'    GetKeyboardIndex% = iIndex%

'End Function ' GetKeyboardIndex%

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END RAW INPUT VARIABLE FUNCTIONS #1

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN FILE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Help Me!

' Using shell to delete a file

' https://qb64phoenix.com/forum/showthread.php?tid=2618&pid=24683#pid24683

' a740g

' #5

' 04-24-2024, 06:05 AM

'

' There are no commands to directly make copies or backup of files.

' But you could write one with a few lines of code like:

'

' Copies src to dst

' Set overwite to true if dst should be overwritten if present

Sub CopyFile (src As String, dst As String, overwrite As _Byte)

    If _FileExists(src) Then

        If Not _FileExists(dst) Or (_FileExists(dst) And overwrite) Then

            _WriteFile dst, _ReadFile$(src)

        End If

    End If

End Sub ' CopyFile

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

' Convert a value to string and trim it (because normal Str$ adds spaces)

Function cstr$ (myValue)

    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))

    cstr$ = _Trim$(Str$(myValue))

End Function ' cstr$

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

Sub DebugLog (sText As String)

    Dim sTime As String

    Dim sResult As String

    ReDim arrLines(0) As String

    Dim iLoop As Integer

    Dim sNextLine As String

    If _FileExists(m_sDebugFile) = FALSE Then

        sResult = PrintFile$(m_sDebugFile, "", FALSE)

    End If

    If Len(sResult) = 0 Then

        sTime = GetCurrentDateTime$("{mm}/{dd}/{yyyy} {hh}:{nn}:{ss} {ampm}")

        split sText, Chr$(13), arrLines()

        For iLoop = LBound(arrLines) To UBound(arrLines)

            sNextLine = sTime + " " + arrLines(iLoop)

            sResult = PrintFile$(m_sDebugFile, sNextLine, TRUE)

        Next iLoop

    End If

End Sub ' DebugLog

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

Sub DebugLog1 (sText As String)

    Dim sResult As String

    If _FileExists(m_sDebugFile) Then

        sResult = PrintFile$(m_sDebugFile, sText, TRUE)

    Else

        sResult = PrintFile$(m_sDebugFile, sText, FALSE)

    End If

End Sub ' DebugLog

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

' QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Help Me!

' Using shell to delete a file

' https://qb64phoenix.com/forum/showthread.php?tid=2618

Sub DeleteFile (sFile As String)

    If _FileExists(sFile) Then

        'Shell "DELETE " + sFile

        'Shell "del " + sFile

        Kill sFile

    End If

End Sub ' DeleteFile

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

Function FileExt$ (sFile As String)

    Dim iPos As Integer

    iPos = _InStrRev(sFile, ".")

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                FileExt$ = Right$(sFile, Len(sFile) - iPos)

            Else

                ' dot is first character, return everything after it

                FileExt$ = Right$(sFile, Len(sFile) - 1)

            End If

        Else

            ' file only has one character, the dot, the file extension is blank

            FileExt$ = ""

        End If

    Else

        ' no dot found, the file extension is blank

        FileExt$ = ""

    End If

End Function ' FileExt$

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

Function NameOnly$ (sFile As String, sSlash As String)

    Dim iPos As Integer

    'sFile = Replace$(sFile, "/", "\")

    iPos = _InStrRev(sFile, sSlash)

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                NameOnly$ = Right$(sFile, Len(sFile) - iPos)

            Else

                ' slash is first character, return everything after it

                NameOnly$ = Right$(sFile, Len(sFile) - 1)

            End If

        Else

            ' file only has one character, the slash, name is blank

            NameOnly$ = ""

        End If

    Else

        ' slash not found, return the entire thing

        NameOnly$ = sFile

    End If

End Function ' NameOnly$

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

Function NoExt$ (sFile As String)

    Dim iPos As Integer

    iPos = _InStrRev(sFile, ".")

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                NoExt$ = Left$(sFile, iPos - 1)

            Else

                ' dot is first character, removing it returns blank!

                ' our version will just return the name unchanged

                ' but you can return blank if you prefer

                NoExt$ = sFile

            End If

        Else

            ' file only has one character, the dot, removing it returns blank!

            ' our version will just return the name unchanged

            ' but you can return blank if you prefer

            NoExt$ = sFile

        End If

    Else

        ' no dot found

        ' return the name unchanged

        NoExt$ = sFile

    End If

End Function ' NoExt$

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

Function PathOnly$ (sFile As String, sSlash As String)

    Dim iPos As Integer

    'sFile = Replace$(sFile, "/", "\")

    iPos = _InStrRev(sFile, sSlash)

    If iPos > 0 Then

        If Len(sFile) > 1 Then

            If iPos > 1 Then

                PathOnly$ = Left$(sFile, iPos)

            Else

                ' slash is first character, so not much of a path, return blank

                PathOnly$ = ""

            End If

        Else

            ' file only has one character, the slash, name is blank

            PathOnly$ = ""

        End If

    Else

        ' slash not found, so not a path, return blank

        PathOnly$ = ""

    End If

End Function ' PathOnly$

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

' Writes sText to file sFileName.

' If bAppend=TRUE appends to file, else overwrites it.

' Returns blank if successful else returns error message.

' Example:

' ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))

' ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

' sFileName = ProgramPath$ + ProgramName$ + ".OUT.txt"

' sText = "This is a test." + chr$(13) + "Here is line 2." + chr$(13) + "End."

' sError = PrintFile$(sFileName, sText, FALSE)

Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)

    Dim sError As String: sError = ""

    If (bAppend = TRUE) Then

        If _FileExists(sFileName) Then

            Open sFileName For Append As #1 ' opens an existing file for appending

        Else

            sError = "Error in PrintFile$ : File not found. Cannot append."

        End If

    Else

        Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file

    End If

    If Len(sError) = 0 Then

        ' NOTE: WRITE places text in quotes in the file

        'WRITE #1, x, y, z$

        'WRITE #1, sText

        ' PRINT does not put text inside quotes

        Print #1, sText

        Close #1

    End If

    PrintFile$ = sError

End Function ' PrintFile$

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

' Fastest way is always to just read the whole life at once and then parse it.

Function ReadTextFile$ (sFileName As String, sDefault As String)

    Dim x$

    If _FileExists(sFileName) Then

        Open sFileName For Binary As #1

        x$ = Space$(LOF(1))

        Get #1, 1, x$

        Close #1

        ReadTextFile$ = x$

    Else

        ReadTextFile$ = sDefault

    End If

End Function ' ReadTextFile$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END FILE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN CONSTANT TO STRING FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

Function VirtualKeyCodeToString$ (MyInteger As Integer)

    Dim Mystring As String

    Select Case MyInteger

        Case VK_LBUTTON:

            Mystring = "VK_LBUTTON"

        Case VK_RBUTTON:

            Mystring = "VK_RBUTTON"

        Case VK_CANCEL:

            Mystring = "VK_CANCEL"

        Case VK_MBUTTON:

            Mystring = "VK_MBUTTON"

        Case VK_XBUTTON1:

            Mystring = "VK_XBUTTON1"

        Case VK_XBUTTON2:

            Mystring = "VK_XBUTTON2"

        Case VK_BACK:

            Mystring = "VK_BACK"

        Case VK_TAB:

            Mystring = "VK_TAB"

        Case VK_CLEAR:

            Mystring = "VK_CLEAR"

        Case VK_RETURN:

            Mystring = "VK_RETURN"

        Case VK_SHIFT:

            Mystring = "VK_SHIFT"

        Case VK_CONTROL:

            Mystring = "VK_CONTROL"

        Case VK_MENU:

            Mystring = "VK_MENU"

        Case VK_PAUSE:

            Mystring = "VK_PAUSE"

        Case VK_CAPITAL:

            Mystring = "VK_CAPITAL"

        Case VK_KANA:

            Mystring = "VK_KANA"

        Case VK_HANGUL:

            Mystring = "VK_HANGUL"

        Case VK_IME_ON:

            Mystring = "VK_IME_ON"

        Case VK_JUNJA:

            Mystring = "VK_JUNJA"

        Case VK_FINAL:

            Mystring = "VK_FINAL"

        Case VK_HANJA:

            Mystring = "VK_HANJA"

        Case VK_KANJI:

            Mystring = "VK_KANJI"

        Case VK_IME_OFF:

            Mystring = "VK_IME_OFF"

        Case VK_ESCAPE:

            Mystring = "VK_ESCAPE"

        Case VK_CONVERT:

            Mystring = "VK_CONVERT"

        Case VK_NONCONVERT:

            Mystring = "VK_NONCONVERT"

        Case VK_ACCEPT:

            Mystring = "VK_ACCEPT"

        Case VK_MODECHANGE:

            Mystring = "VK_MODECHANGE"

        Case VK_SPACE:

            Mystring = "VK_SPACE"

        Case VK_PRIOR:

            Mystring = "VK_PRIOR"

        Case VK_NEXT:

            Mystring = "VK_NEXT"

        Case VK_END:

            Mystring = "VK_END"

        Case VK_HOME:

            Mystring = "VK_HOME"

        Case VK_LEFT:

            Mystring = "VK_LEFT"

        Case VK_UP:

            Mystring = "VK_UP"

        Case VK_RIGHT:

            Mystring = "VK_RIGHT"

        Case VK_DOWN:

            Mystring = "VK_DOWN"

        Case VK_SELECT:

            Mystring = "VK_SELECT"

        Case VK_PRINT:

            Mystring = "VK_PRINT"

        Case VK_EXECUTE:

            Mystring = "VK_EXECUTE"

        Case VK_SNAPSHOT:

            Mystring = "VK_SNAPSHOT"

        Case VK_INSERT:

            Mystring = "VK_INSERT"

        Case VK_DELETE:

            Mystring = "VK_DELETE"

        Case VK_HELP:

            Mystring = "VK_HELP"

        Case VK_0:

            Mystring = "VK_0"

        Case VK_1:

            Mystring = "VK_1"

        Case VK_2:

            Mystring = "VK_2"

        Case VK_3:

            Mystring = "VK_3"

        Case VK_4:

            Mystring = "VK_4"

        Case VK_5:

            Mystring = "VK_5"

        Case VK_6:

            Mystring = "VK_6"

        Case VK_7:

            Mystring = "VK_7"

        Case VK_8:

            Mystring = "VK_8"

        Case VK_9:

            Mystring = "VK_9"

        Case VK_A:

            Mystring = "VK_A"

        Case VK_B:

            Mystring = "VK_B"

        Case VK_C:

            Mystring = "VK_C"

        Case VK_D:

            Mystring = "VK_D"

        Case VK_E:

            Mystring = "VK_E"

        Case VK_F:

            Mystring = "VK_F"

        Case VK_G:

            Mystring = "VK_G"

        Case VK_H:

            Mystring = "VK_H"

        Case VK_I:

            Mystring = "VK_I"

        Case VK_J:

            Mystring = "VK_J"

        Case VK_K:

            Mystring = "VK_K"

        Case VK_L:

            Mystring = "VK_L"

        Case VK_M:

            Mystring = "VK_M"

        Case VK_N:

            Mystring = "VK_N"

        Case VK_O:

            Mystring = "VK_O"

        Case VK_P:

            Mystring = "VK_P"

        Case VK_Q:

            Mystring = "VK_Q"

        Case VK_R:

            Mystring = "VK_R"

        Case VK_S:

            Mystring = "VK_S"

        Case VK_T:

            Mystring = "VK_T"

        Case VK_U:

            Mystring = "VK_U"

        Case VK_V:

            Mystring = "VK_V"

        Case VK_W:

            Mystring = "VK_W"

        Case VK_X:

            Mystring = "VK_X"

        Case VK_Y:

            Mystring = "VK_Y"

        Case VK_Z:

            Mystring = "VK_Z"

        Case VK_LWIN:

            Mystring = "VK_LWIN"

        Case VK_RWIN:

            Mystring = "VK_RWIN"

        Case VK_APPS:

            Mystring = "VK_APPS"

        Case VK_SLEEP:

            Mystring = "VK_SLEEP"

        Case VK_NUMPAD0:

            Mystring = "VK_NUMPAD0"

        Case VK_NUMPAD1:

            Mystring = "VK_NUMPAD1"

        Case VK_NUMPAD2:

            Mystring = "VK_NUMPAD2"

        Case VK_NUMPAD3:

            Mystring = "VK_NUMPAD3"

        Case VK_NUMPAD4:

            Mystring = "VK_NUMPAD4"

        Case VK_NUMPAD5:

            Mystring = "VK_NUMPAD5"

        Case VK_NUMPAD6:

            Mystring = "VK_NUMPAD6"

        Case VK_NUMPAD7:

            Mystring = "VK_NUMPAD7"

        Case VK_NUMPAD8:

            Mystring = "VK_NUMPAD8"

        Case VK_NUMPAD9:

            Mystring = "VK_NUMPAD9"

        Case VK_MULTIPLY:

            Mystring = "VK_MULTIPLY"

        Case VK_ADD:

            Mystring = "VK_ADD"

        Case VK_SEPARATOR:

            Mystring = "VK_SEPARATOR"

        Case VK_SUBTRACT:

            Mystring = "VK_SUBTRACT"

        Case VK_DECIMAL:

            Mystring = "VK_DECIMAL"

        Case VK_DIVIDE:

            Mystring = "VK_DIVIDE"

        Case VK_F1:

            Mystring = "VK_F1"

        Case VK_F2:

            Mystring = "VK_F2"

        Case VK_F3:

            Mystring = "VK_F3"

        Case VK_F4:

            Mystring = "VK_F4"

        Case VK_F5:

            Mystring = "VK_F5"

        Case VK_F6:

            Mystring = "VK_F6"

        Case VK_F7:

            Mystring = "VK_F7"

        Case VK_F8:

            Mystring = "VK_F8"

        Case VK_F9:

            Mystring = "VK_F9"

        Case VK_F10:

            Mystring = "VK_F10"

        Case VK_F11:

            Mystring = "VK_F11"

        Case VK_F12:

            Mystring = "VK_F12"

        Case VK_F13:

            Mystring = "VK_F13"

        Case VK_F14:

            Mystring = "VK_F14"

        Case VK_F15:

            Mystring = "VK_F15"

        Case VK_F16:

            Mystring = "VK_F16"

        Case VK_F17:

            Mystring = "VK_F17"

        Case VK_F18:

            Mystring = "VK_F18"

        Case VK_F19:

            Mystring = "VK_F19"

        Case VK_F20:

            Mystring = "VK_F20"

        Case VK_F21:

            Mystring = "VK_F21"

        Case VK_F22:

            Mystring = "VK_F22"

        Case VK_F23:

            Mystring = "VK_F23"

        Case VK_F24:

            Mystring = "VK_F24"

        Case VK_NUMLOCK:

            Mystring = "VK_NUMLOCK"

        Case VK_SCROLL:

            Mystring = "VK_SCROLL"

        Case VK_LSHIFT:

            Mystring = "VK_LSHIFT"

        Case VK_RSHIFT:

            Mystring = "VK_RSHIFT"

        Case VK_LCONTROL:

            Mystring = "VK_LCONTROL"

        Case VK_RCONTROL:

            Mystring = "VK_RCONTROL"

        Case VK_LMENU:

            Mystring = "VK_LMENU"

        Case VK_RMENU:

            Mystring = "VK_RMENU"

        Case VK_BROWSER_BACK:

            Mystring = "VK_BROWSER_BACK"

        Case VK_BROWSER_FORWARD:

            Mystring = "VK_BROWSER_FORWARD"

        Case VK_BROWSER_REFRESH:

            Mystring = "VK_BROWSER_REFRESH"

        Case VK_BROWSER_STOP:

            Mystring = "VK_BROWSER_STOP"

        Case VK_BROWSER_SEARCH:

            Mystring = "VK_BROWSER_SEARCH"

        Case VK_BROWSER_FAVORITES:

            Mystring = "VK_BROWSER_FAVORITES"

        Case VK_BROWSER_HOME:

            Mystring = "VK_BROWSER_HOME"

        Case VK_VOLUME_MUTE:

            Mystring = "VK_VOLUME_MUTE"

        Case VK_VOLUME_DOWN:

            Mystring = "VK_VOLUME_DOWN"

        Case VK_VOLUME_UP:

            Mystring = "VK_VOLUME_UP"

        Case VK_MEDIA_NEXT_TRACK:

            Mystring = "VK_MEDIA_NEXT_TRACK"

        Case VK_MEDIA_PREV_TRACK:

            Mystring = "VK_MEDIA_PREV_TRACK"

        Case VK_MEDIA_STOP:

            Mystring = "VK_MEDIA_STOP"

        Case VK_MEDIA_PLAY_PAUSE:

            Mystring = "VK_MEDIA_PLAY_PAUSE"

        Case VK_LAUNCH_MAIL:

            Mystring = "VK_LAUNCH_MAIL"

        Case VK_LAUNCH_MEDIA_SELECT:

            Mystring = "VK_LAUNCH_MEDIA_SELECT"

        Case VK_LAUNCH_APP1:

            Mystring = "VK_LAUNCH_APP1"

        Case VK_LAUNCH_APP2:

            Mystring = "VK_LAUNCH_APP2"

        Case VK_OEM_1:

            Mystring = "VK_OEM_1"

        Case VK_OEM_PLUS:

            Mystring = "VK_OEM_PLUS"

        Case VK_OEM_COMMA:

            Mystring = "VK_OEM_COMMA"

        Case VK_OEM_MINUS:

            Mystring = "VK_OEM_MINUS"

        Case VK_OEM_PERIOD:

            Mystring = "VK_OEM_PERIOD"

        Case VK_OEM_2:

            Mystring = "VK_OEM_2"

        Case VK_OEM_3:

            Mystring = "VK_OEM_3"

        Case VK_OEM_4:

            Mystring = "VK_OEM_4"

        Case VK_OEM_5:

            Mystring = "VK_OEM_5"

        Case VK_OEM_6:

            Mystring = "VK_OEM_6"

        Case VK_OEM_7:

            Mystring = "VK_OEM_7"

        Case VK_OEM_8:

            Mystring = "VK_OEM_8"

        Case VK_OEM_102:

            Mystring = "VK_OEM_102"

        Case VK_PROCESSKEY:

            Mystring = "VK_PROCESSKEY"

        Case VK_PACKET:

            Mystring = "VK_PACKET"

        Case VK_ATTN:

            Mystring = "VK_ATTN"

        Case VK_CRSEL:

            Mystring = "VK_CRSEL"

        Case VK_EXSEL:

            Mystring = "VK_EXSEL"

        Case VK_EREOF:

            Mystring = "VK_EREOF"

        Case VK_PLAY:

            Mystring = "VK_PLAY"

        Case VK_ZOOM:

            Mystring = "VK_ZOOM"

        Case VK_NONAME:

            Mystring = "VK_NONAME"

        Case VK_PA1:

            Mystring = "VK_PA1"

        Case VK_OEM_CLEAR:

            Mystring = "VK_OEM_CLEAR"

        Case Else:

            Mystring = _Trim$(Str$(MyInteger))

    End Select

    VirtualKeyCodeToString$ = Mystring

End Function ' VirtualKeyCodeToString$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END CONSTANT TO STRING FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN GENERAL PURPOSE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

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

' SMcNeill

' More efficient version of ExtendedTimer.

' This stores our day values and only updates them when necessary.

' We really don't need to figure out how many seconds are in today over and over endlessly

' -- just count them once, and when the clock swaps back to 0:0:0, add 24*60*60 seconds to the count.

' Re: how to time something (ie do loop for n seconds)

' https://forum.qb64.org/index.php?topic=4682.0

Function ExtendedTimer##

    'modified extendedtimer to store the old day's count, and not have to recalculate it every time the routine is called.

    Static olds As _Float, old_day As _Float

    Dim m As Integer, d As Integer, y As Integer

    Dim s As _Float, day As String

    Dim oldt As Single

    If olds = 0 Then 'calculate the day the first time the extended timer runs

        day = Date$

        m = Val(Left$(day, 2))

        d = Val(Mid$(day, 4, 2))

        y = Val(Right$(day, 4)) - 1970

        Select Case m 'Add the number of days for each previous month passed

            Case 2: d = d + 31

            Case 3: d = d + 59

            Case 4: d = d + 90

            Case 5: d = d + 120

            Case 6: d = d + 151

            Case 7: d = d + 181

            Case 8: d = d + 212

            Case 9: d = d + 243

            Case 10: d = d + 273

            Case 11: d = d + 304

            Case 12: d = d + 334

        End Select

        If (y Mod 4) = 2 And m > 2 Then d = d + 1 'add a day if this is leap year and we're past february

        d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year

        d = d + (y + 2) \ 4 'add in days for leap years passed

        s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds

        old_day = s

    End If

    If Timer < oldt Then 'we went from 23:59:59 (a second before midnight) to 0:0:0 (midnight)

        old_day = s + 83400 'add another worth of seconds to our counter

    End If

    oldt = Timer

    olds = old_day + oldt

    ExtendedTimer## = olds

End Function ' ExtendedTimer##

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

' Simple timestamp function

' Format: {YYYY}-{MM}-{DD} {hh}:[mm}:{ss}

' Uses:

'     TIME$

'         The TIME$ Function returns a STRING representation

'         of the current computer time in a 24 hour format.

'         https://qb64phoenix.com/qb64wiki/index.php/TIME$

'     DATE$

'         The DATE$ function returns the current computer date

'         as a string in the format "mm-dd-yyyy".

'         https://qb64phoenix.com/qb64wiki/index.php/DATE$

'

' TODO: support template where

'       {yyyy} = 4 digit year

'       {mm}   = 2 digit month

'       {dd}   = 2 digit day

'       {hh}   = 2 digit hour (12-hour)

'       {rr}   = 2 digit hour (24-hour)

'       {nn}   = 2 digit minute

'       {ss}   = 2 digit second

'       {ampm} = AM/PM

' We got the nn for minute from Microsoft > Office VBA Reference > DateDiff function

' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/datediff-function

' PRINT "Current date time (simple format) = " + Chr$(34) + GetCurrentDateTime$("{yyyy}-{mm}-{dd} {rr}:{nn}:{ss}") + Chr$(34)

' PRINT "Current date time (US format)     = " + Chr$(34) + GetCurrentDateTime$("{mm}/{dd}/{yyyy} {hh}:{nn}:{ss} {ampm}") + Chr$(34)

' PRINT "Filename timestamp                = " + Chr$(34) + GetCurrentDateTime$("{yyyy}{mm}{dd}_{rr}{nn}{ss}") + Chr$(34)

Function GetCurrentDateTime$ (sTemplate$)

    Dim sDate$: sDate$ = Date$

    Dim sTime$: sTime$ = Time$

    Dim sYYYY$: sYYYY$ = Mid$(sDate$, 7, 4)

    Dim sMM$: sMM$ = Mid$(sDate$, 1, 2)

    Dim sDD$: sDD$ = Mid$(sDate$, 4, 2)

    Dim sHH24$: sHH24$ = Mid$(sTime$, 1, 2)

    Dim sHH$: sHH$ = ""

    Dim sMI$: sMI$ = Mid$(sTime$, 4, 2)

    Dim sSS$: sSS$ = Mid$(sTime$, 7, 2)

    Dim iHour%: iHour% = Val(sHH24$)

    Dim sAMPM$: sAMPM$ = ""

    Dim result$: result$ = ""

    ' FIGURE OUT AM/PM

    If InStr(sTemplate$, "{ampm}") > 0 Then

        If iHour% = 0 Then

            sAMPM$ = "AM"

            iHour% = 12

        ElseIf iHour% > 0 And iHour% < 12 Then

            sAMPM$ = "AM"

        ElseIf iHour% = 12 Then

            sAMPM$ = "PM"

        Else

            sAMPM$ = "PM"

            iHour% = iHour% - 12

        End If

        sHH$ = Right$("00" + _Trim$(Str$(iHour%)), 2)

    End If

    ' POPULATE TEMPLATE

    result$ = sTemplate$

    result$ = Replace$(result$, "{yyyy}", sYYYY$)

    result$ = Replace$(result$, "{mm}", sMM$)

    result$ = Replace$(result$, "{dd}", sDD$)

    result$ = Replace$(result$, "{hh}", sHH$)

    result$ = Replace$(result$, "{rr}", sHH24$)

    result$ = Replace$(result$, "{nn}", sMI$)

    result$ = Replace$(result$, "{ss}", sSS$)

    result$ = Replace$(result$, "{ampm}", sAMPM$)

    ' RETURN RESULT

    GetCurrentDateTime$ = result$

End Function ' GetCurrentDateTime$

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

' 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%

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

' IIF function for QB for integers

Function IIF (Condition, IfTrue, IfFalse)

    If Condition Then IIF = IfTrue Else IIF = IfFalse

End Function

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

' IIF function for QB for strings

Function IIFS$ (Condition, IfTrue$, IfFalse$)

    If Condition Then IIFS$ = IfTrue$ Else IIFS$ = IfFalse$

End Function

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

' 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%

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

' FROM: String Manipulation

' found at abandoned, outdated and now likely malicious qb64 dot net website

' http://www.qb64.[net]/forum/index_topic_5964-0/

'

'SUMMARY:

'   Purpose:  A library of custom functions that transform strings.

'   Author:   Dustinian Camburides (dustinian@gmail.com)

'   Platform: QB64 (www.qb64.org)

'   Revision: 1.6

'   Updated:  5/28/2012

'SUMMARY:

'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.

'INPUT:

'Text: The input string; the text that's being manipulated.

'Find: The specified sub-string; the string sought within the [Text] string.

'Add: The sub-string that's being added to the [Text] string.

Function Replace$ (Text1 As String, Find1 As String, Add1 As String)

    ' VARIABLES:

    Dim Text2 As String

    Dim Find2 As String

    Dim Add2 As String

    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.

    Dim strBefore As String ' The characters before the string to be replaced.

    Dim strAfter As String ' The characters after the string to be replaced.

    ' INITIALIZE:

    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)

    Text2 = Text1

    Find2 = Find1

    Add2 = Add1

    lngLocation = InStr(1, Text2, Find2)

    ' PROCESSING:

    ' While [Find2] appears in [Text2]...

    While lngLocation

        ' Extract all Text2 before the [Find2] substring:

        strBefore = Left$(Text2, lngLocation - 1)

        ' Extract all text after the [Find2] substring:

        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))

        ' Return the substring:

        Text2 = strBefore + Add2 + strAfter

        ' Locate the next instance of [Find2]:

        lngLocation = InStr(1, Text2, Find2)

        ' Next instance of [Find2]...

    Wend

    ' OUTPUT:

    Replace$ = Text2

End Function ' Replace$

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

' 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 As Integer

    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

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

'

'Sub SplitTest

'    Dim in$

'    Dim delim$

'    ReDim arrText$(0)

'    Dim iLoop%

'

'    delim$ = Chr$(10)

'    in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"

'    Print "in$ = " + Chr$(34) + in$ + Chr$(34)

'    Print "delim$ = " + Chr$(34) + delim$ + Chr$(34)

'    split in$, delim$, arrText$()

'

'    For iLoop% = LBound(arrText$) To UBound(arrText$)

'        Print "arrText$(" + _Trim$(Str$(iLoop%)) + ") = " + Chr$(34) + arrText$(iLoop%) + Chr$(34)

'    Next iLoop%

'    Print

'    Print "Split test finished."

'End Sub ' SplitTest

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

'

'Sub SplitAndReplaceTest

'    Dim in$

'    Dim out$

'    Dim iLoop%

'    ReDim arrText$(0)

'

'    Print "-------------------------------------------------------------------------------"

'    Print "SplitAndReplaceTest"

'    Print

'

'    Print "Original value"

'    in$ = "This line 1 " + Chr$(13) + Chr$(10) + "and line 2" + Chr$(10) + "and line 3 " + Chr$(13) + "finally THE END."

'    out$ = in$

'    out$ = Replace$(out$, Chr$(13), "\r")

'    out$ = Replace$(out$, Chr$(10), "\n")

'    out$ = Replace$(out$, Chr$(9), "\t")

'    Print "in$ = " + Chr$(34) + out$ + Chr$(34)

'    Print

'

'    Print "Fixing linebreaks..."

'    in$ = Replace$(in$, Chr$(13) + Chr$(10), Chr$(13))

'    in$ = Replace$(in$, Chr$(10), Chr$(13))

'    out$ = in$

'    out$ = Replace$(out$, Chr$(13), "\r")

'    out$ = Replace$(out$, Chr$(10), "\n")

'    out$ = Replace$(out$, Chr$(9), "\t")

'    Print "in$ = " + Chr$(34) + out$ + Chr$(34)

'    Print

'

'    Print "Splitting up..."

'    split in$, Chr$(13), arrText$()

'

'    For iLoop% = LBound(arrText$) To UBound(arrText$)

'        out$ = arrText$(iLoop%)

'        out$ = Replace$(out$, Chr$(13), "\r")

'        out$ = Replace$(out$, Chr$(10), "\n")

'        out$ = Replace$(out$, Chr$(9), "\t")

'        Print "arrText$(" + cstr$(iLoop%) + ") = " + Chr$(34) + out$ + Chr$(34)

'    Next iLoop%

'    Print

'

'    Print "SplitAndReplaceTest finished."

'End Sub ' SplitAndReplaceTest

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

' Use to pretty print TRUE and FALSE values.

Function TrueFalse$ (myValue)

    If myValue = TRUE Then

        TrueFalse$ = "TRUE"

    Else

        TrueFalse$ = "FALSE"

    End If

End Function ' TrueFalse$

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END GENERAL PURPOSE FUNCTIONS

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' BEGIN handle MEM for any type

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' QB64 GPT Just Rewrote My Code

' https://qb64phoenix.com/forum/showthread.php?tid=2728

' And the revisions QB64 GPT made (after minor changes and me asking it to redo some syntax errors):

' It separated out a lot of processing out to separate subs.

' It is quite impressive how little input I had to give it to fix its mistakes.

' The code actually worked just as well as it did before the changes, which blows my mind.

' It actually even listened to me when I told it that it would need to cast an OFFSET type by using VAL(STR$(var)).

' To be fair, I had to tell it "ByRef" was invalid and a couple of other things.

' I also had to declare "y" each time it was used. But the last iteration only required me to declare "y".

' I think that is a decent enough result. Too bad I can't get it to be this good every time.

' 1) This is the paid version of GPT4. I am on the plus plan, so whatever that one has.

' 2) I think I deleted the session. Sorry. I only used it for as long as I needed it.

' 3) I don't know what the hard limit is. It's in "tokens", which I have no idea how those are calculated.

' I got a pretty large source code from one output and it can take a lot of input. I would just say it can handle quite a bit.

' The GPT I used was one I trained using the Wiki, sample code, etc. At the time, it used GPT4.

' Custom GPTs now use 4o. I will probably need to republish it to take advantage of 4o for it.

' I guess training is the wrong word. A custom GPT has a "knowledge base".

' You can have a maximum of 20 files.

' It can use those files to create an answer. Even a zip folder can be used.

' It will basically only use the knowledge base when specifically asked. Otherwise, it is using whatever it already had in its model.

' As for testing code and such, you can create "actions" for your GPT that allow it to do things outside of ChatGPT, including REST API.

' So if dbox ever made a REST API for QBJS, you could definitely have it write QBJS code and then ask it to run it.

Sub anyArg (args() As _MEM)

    Dim As _Unsigned Integer x, y

    Dim As _Unsigned _Offset z

    Dim As _Unsigned Long size, elementsize

    For x = LBound(args) To UBound(args)

        If _MemExists(args(x)) Then

            z = 0

            size = Val(Str$(args(x).SIZE))

            elementsize = Val(Str$(args(x).ELEMENTSIZE))

            If _ReadBit(args(x).TYPE, 7) And _ReadBit(args(x).TYPE, 13) = 0 Then

                HandleNumericType args(x), size, elementsize, z

            ElseIf _ReadBit(args(x).TYPE, 8) Then

                HandleFloatingType args(x), size, elementsize, z

            ElseIf _ReadBit(args(x).TYPE, 9) Then

                HandleStringType args(x), size, elementsize

            ElseIf _ReadBit(args(x).TYPE, 13) And _ReadBit(args(x).TYPE, 7) Then

                HandleOffsetType args(x), size, elementsize, z

            ElseIf args(x).TYPE = 0 And args(x).SIZE > 0 Then

                HandleSoundType args(x)

            ElseIf _ReadBit(args(x).TYPE, 14) Then

                Print args(x).SIZE, "MEM"

                ' TODO: Handle other types if necessary

            End If

            If _ReadBit(args(x).TYPE, 11) Then

                Screen args(x).IMAGE

            End If

        End If

    Next

End Sub ' anyArg

' Subroutines for handling specific types

Sub HandleNumericType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)

    If _ReadBit(arg.TYPE, 10) Then

        If _ReadBit(arg.TYPE, 16) Then

            Select Case elementsize

                Case 1

                    Dim As _Unsigned _Byte unsignedbytearray(1 To (size / elementsize))

                    ProcessArray_UByte unsignedbytearray(), arg, size, elementsize, z, "UBYTE ARRAY"

                Case 2

                    Dim As _Unsigned Integer unsignedintarray(1 To (size / elementsize))

                    ProcessArray_UInteger unsignedintarray(), arg, size, elementsize, z, "USHORT ARRAY"

                Case 4

                    Dim As _Unsigned Long unsignedlongarray(1 To (size / elementsize))

                    ProcessArray_ULong unsignedlongarray(), arg, size, elementsize, z, "ULONG ARRAY"

                Case 8

                    Dim As _Unsigned _Integer64 unsignedint64array(1 To (size / elementsize))

                    ProcessArray_UInt64 unsignedint64array(), arg, size, elementsize, z, "UINT64 ARRAY"

            End Select

        Else

            PrintSingleValue arg, size, elementsize

        End If

    Else

        If _ReadBit(arg.TYPE, 16) Then

            Select Case elementsize

                Case 1

                    Dim As _Byte bytearray(1 To (size / elementsize))

                    ProcessArray_Byte bytearray(), arg, size, elementsize, z, "BYTE ARRAY"

                Case 2

                    Dim As Integer intarray(1 To (size / elementsize))

                    ProcessArray_Integer intarray(), arg, size, elementsize, z, "SHORT ARRAY"

                Case 4

                    Dim As Long longarray(1 To (size / elementsize))

                    ProcessArray_Long longarray(), arg, size, elementsize, z, "LONG ARRAY"

                Case 8

                    Dim As _Integer64 int64array(1 To (size / elementsize))

                    ProcessArray_Int64 int64array(), arg, size, elementsize, z, "INT64 ARRAY"

            End Select

        Else

            PrintSingleValue arg, size, elementsize

        End If

    End If

End Sub ' HandleNumericType

Sub HandleFloatingType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)

    If _ReadBit(arg.TYPE, 16) Then

        Select Case elementsize

            Case 4

                Dim As Single singlearray(1 To (size / elementsize))

                ProcessArray_Single singlearray(), arg, size, elementsize, z, "SINGLE ARRAY"

            Case 8

                Dim As Double doublearray(1 To (size / elementsize))

                ProcessArray_Double doublearray(), arg, size, elementsize, z, "DOUBLE ARRAY"

            Case 32

                Dim As _Float floatarray(1 To (size / elementsize))

                ProcessArray_Float floatarray(), arg, size, elementsize, z, "FLOAT ARRAY"

        End Select

    Else

        Select Case size

            Case 4

                Print _MemGet(arg, arg.OFFSET, Single), "SINGLE"

            Case 8

                Print _MemGet(arg, arg.OFFSET, Double), "DOUBLE"

            Case 32

                Print _MemGet(arg, arg.OFFSET, _Float), "FLOAT"

        End Select

    End If

End Sub ' HandleFloatingType

Sub HandleStringType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long)

    If _ReadBit(arg.TYPE, 16) Then

        Dim As String stringarray(1 To (size / elementsize))

        Dim As _Unsigned Long y

        For y = LBound(stringarray) To UBound(stringarray)

            stringarray(y) = Space$(elementsize)

            _MemGet arg, (arg.OFFSET) + (y * elementsize - elementsize), stringarray(y)

            Print stringarray(y), "STRING ARRAY"

        Next

    Else

        Dim As String stringtest: stringtest = Space$(elementsize)

        _MemGet arg, arg.OFFSET, stringtest

        Print stringtest

    End If

End Sub ' HandleStringType

Sub HandleOffsetType (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset)

    If _ReadBit(arg.TYPE, 10) Then

        If _ReadBit(arg.TYPE, 16) Then

            Dim As _Unsigned _Offset unsignedoffsetarray(1 To (size / elementsize))

            ProcessArray_UOffset unsignedoffsetarray(), arg, size, elementsize, z, "ULONG_PTR ARRAY"

        Else

            Print _MemGet(arg, arg.OFFSET, _Unsigned _Offset), "ULONG_PTR"

        End If

    Else

        If _ReadBit(arg.TYPE, 16) Then

            Dim As _Offset offsetarray(1 To (size / elementsize))

            ProcessArray_Offset offsetarray(), arg, size, elementsize, z, "LONG_PTR ARRAY"

        Else

            Print _MemGet(arg, arg.OFFSET, _Offset), "LONG_PTR"

        End If

    End If

End Sub ' HandleOffsetType

Sub HandleSoundType (arg As _MEM)

    If Not _SndPlaying(arg.SOUND) Then

        _SndPlay (arg.SOUND)

    End If

    Print "SOUND", arg.SIZE, arg.ELEMENTSIZE

End Sub ' HandleSoundType

' Subroutines for processing arrays

Sub ProcessArray_UByte (unsignedbytearray() As _Unsigned _Byte, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(unsignedbytearray) To UBound(unsignedbytearray)

        _MemGet arg, arg.OFFSET + z, unsignedbytearray(y)

        z = z + elementsize

        Print unsignedbytearray(y), typeName

    Next

End Sub ' ProcessArray_UByte

Sub ProcessArray_UInteger (unsignedintarray() As _Unsigned Integer, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(unsignedintarray) To UBound(unsignedintarray)

        _MemGet arg, arg.OFFSET + z, unsignedintarray(y)

        z = z + elementsize

        Print unsignedintarray(y), typeName

    Next

End Sub ' ProcessArray_UInteger

Sub ProcessArray_ULong (unsignedlongarray() As _Unsigned Long, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(unsignedlongarray) To UBound(unsignedlongarray)

        _MemGet arg, arg.OFFSET + z, unsignedlongarray(y)

        z = z + elementsize

        Print unsignedlongarray(y), typeName

    Next

End Sub ' ProcessArray_ULong

Sub ProcessArray_UInt64 (unsignedint64array() As _Unsigned _Integer64, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(unsignedint64array) To UBound(unsignedint64array)

        _MemGet arg, arg.OFFSET + z, unsignedint64array(y)

        z = z + elementsize

        Print unsignedint64array(y), typeName

    Next

End Sub ' ProcessArray_UInt64

Sub ProcessArray_Byte (bytearray() As _Byte, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(bytearray) To UBound(bytearray)

        _MemGet arg, arg.OFFSET + z, bytearray(y)

        z = z + elementsize

        Print bytearray(y), typeName

    Next

End Sub ' ProcessArray_Byte

Sub ProcessArray_Integer (intarray() As Integer, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(intarray) To UBound(intarray)

        _MemGet arg, arg.OFFSET + z, intarray(y)

        z = z + elementsize

        Print intarray(y), typeName

    Next

End Sub ' ProcessArray_Integer

Sub ProcessArray_Long (longarray() As Long, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(longarray) To UBound(longarray)

        _MemGet arg, arg.OFFSET + z, longarray(y)

        z = z + elementsize

        Print longarray(y), typeName

    Next

End Sub ' ProcessArray_Long

Sub ProcessArray_Int64 (int64array() As _Integer64, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(int64array) To UBound(int64array)

        _MemGet arg, arg.OFFSET + z, int64array(y)

        z = z + elementsize

        Print int64array(y), typeName

    Next

End Sub ' ProcessArray_Int64

Sub ProcessArray_Single (singlearray() As Single, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(singlearray) To UBound(singlearray)

        _MemGet arg, arg.OFFSET + z, singlearray(y)

        z = z + elementsize

        Print singlearray(y), typeName

    Next

End Sub ' ProcessArray_Single

Sub ProcessArray_Double (doublearray() As Double, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(doublearray) To UBound(doublearray)

        _MemGet arg, arg.OFFSET + z, doublearray(y)

        z = z + elementsize

        Print doublearray(y), typeName

    Next

End Sub ' ProcessArray_Double

Sub ProcessArray_Float (floatarray() As _Float, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(floatarray) To UBound(floatarray)

        _MemGet arg, arg.OFFSET + z, floatarray(y)

        z = z + elementsize / 2

        Print floatarray(y), typeName

    Next

End Sub ' ProcessArray_Float

Sub ProcessArray_UOffset (unsignedoffsetarray() As _Unsigned _Offset, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(unsignedoffsetarray) To UBound(unsignedoffsetarray)

        _MemGet arg, arg.OFFSET + z, unsignedoffsetarray(y)

        z = z + elementsize

        Print unsignedoffsetarray(y), typeName

    Next

End Sub ' ProcessArray_UOffset

Sub ProcessArray_Offset (offsetarray() As _Offset, arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long, z As _Unsigned _Offset, typeName As String)

    Dim As _Unsigned Long y

    For y = LBound(offsetarray) To UBound(offsetarray)

        _MemGet arg, arg.OFFSET + z, offsetarray(y)

        z = z + elementsize

        Print offsetarray(y), typeName

    Next

End Sub ' ProcessArray_Offset

Sub PrintSingleValue (arg As _MEM, size As _Unsigned Long, elementsize As _Unsigned Long)

    Select Case size

        Case 1

            Print _MemGet(arg, arg.OFFSET, _Byte), "BYTE"

        Case 2

            Print _MemGet(arg, arg.OFFSET, Integer), "SHORT"

        Case 4

            Print _MemGet(arg, arg.OFFSET, Long), "LONG"

        Case 8

            Print _MemGet(arg, arg.OFFSET, _Integer64), "INT64"

    End Select

End Sub ' PrintSingleValue

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' END handle MEM for any type

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' ################################################################################################################################################################

' 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 cDebugEnabled = 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 cDebugEnabled = TRUE Then

    '    _Echo s$

    'End If

End Sub ' DebugPrint1

' ################################################################################################################################################################

' END DEBUGGING ROUTINES @DEBUG

' ################################################################################################################################################################

' ################################################################################################################################################################

' BEGIN REFERENCE #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 REFERENCE @REFERENCE

' ################################################################################################################################################################

' @END

"makeint.h":

Code: (Select All)
LPSTR MAKEINTRSC(ptrszint i){

    return MAKEINTRESOURCE(i);

}

"winproc.h":

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

LRESULT CALLBACK MainWndProc(HWND hwnd, UINT nMsg, WPARAM wParam, LPARAM lParam){

    return FUNC_MAINWNDPROC((ptrszint *) (&hwnd), &nMsg, &wParam, (ptrszint *)(&lParam));

}

void * WindowProc(){

    return (void *) MainWndProc;

}