08-15-2022, 05:25 AM
I've put together several mouse and keyboard routines for SCREEN 0 over the years.
Here is one demo example...
Pete
Here is one demo example...
Code: (Select All)
mydemo% = -1
DIM UI AS UserInput
TYPE UserInput
KeyPress AS STRING
KeyCombos AS INTEGER
MbStatus AS INTEGER
MbEnvoked AS INTEGER
drag AS INTEGER
DoubleClick AS INTEGER
MbLeftx AS INTEGER
MbLefty AS INTEGER
mx AS INTEGER
oldmx AS INTEGER
my AS INTEGER
oldmy AS INTEGER
END TYPE
PRINT "Press keys or use mouse for demo.";
DO
CALL keyboard_mouse(UI, mydemo%)
IF UI.MbStatus < 0 AND UI.MbEnvoked = 0 THEN
SOUND 1000, .3: UI.MbEnvoked = -1
END IF
IF UI.KeyPress = CHR$(13) THEN BEEP: EXIT DO
LOOP
DO
CALL keyboard_mouse(UI, mydemo%)
IF UI.MbStatus > 0 AND UI.MbEnvoked = 0 THEN
SOUND 300, .3: UI.MbEnvoked = 1
END IF
LOOP
END
SUB keyboard_mouse (UI AS UserInput, mydemo%)
STATIC z1, lclick
_LIMIT 30
DEF SEG = 0
IF PEEK(1047) MOD 16 = 1 OR PEEK(1047) MOD 16 = 2 THEN
UI.KeyCombos = 1 ' Shift = -1 ELSE Shift = 0
ELSEIF PEEK(1047) MOD 16 = 3 OR PEEK(1047) MOD 16 = 4 THEN
UI.KeyCombos = 2 ' Ctrl = -1 ELSE Ctrl = 0
ELSEIF PEEK(1047) MOD 16 = 5 OR PEEK(1047) MOD 16 = 6 THEN
UI.KeyCombos = 3 ' Ctrl+Shift = -1 ELSE Ctrl+Shift = 0
ELSEIF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
UI.KeyCombos = 4 ' Alt = -1 ELSE Alt = 0
ELSEIF PEEK(1047) MOD 16 = 9 OR PEEK(1047) MOD 16 = 10 THEN
UI.KeyCombos = 5 ' Shift+Alt = -1 ELSE Shift+Alt = -1
ELSEIF PEEK(1047) MOD 16 = 12 THEN
UI.KeyCombos = 6 ' Ctrl+Alt = -1 ELSE Ctrl+Alt = 0
ELSE
UI.KeyCombos = 0
END IF
DEF SEG
IF mydemo% THEN GOSUB check_UI.KeyCombos
UI.KeyPress = INKEY$
IF LEN(UI.KeyPress) THEN ' A key was pressed.
UI.MbEnvoked = 0: UI.MbLeftx = 0
SELECT CASE LEN(UI.KeyPress)
CASE 1 ' 1-byte key A-Z, etc.
IF mydemo% THEN mydemo% = 1: GOSUB mydemo
SELECT CASE UI.KeyPress
' Place key selection routine here...
CASE CHR$(27): SYSTEM
END SELECT
CASE 2 '2-byte key F1-F12, etc.
IF mydemo% THEN mydemo% = 2: GOSUB mydemo
SELECT CASE RIGHT$(UI.KeyPress, 1)
' Place key selection routine here...
END SELECT
END SELECT
ELSE ' Check for mouse input since no keyboard input was detected.
IF lclick THEN ' Check timer for double-clicks.
IF TIMER < z1 THEN z1 = z1 - 86400 ' Midnight adjustment.
IF TIMER - z1 > .33 THEN lclick = 0 ' Too much time ellapsed for a double click.
END IF
WHILE _MOUSEINPUT
mw = mw + _MOUSEWHEEL ' Check for mouse wheel use.
WEND
' Get mouse status.
UI.mx = _MOUSEX
UI.my = _MOUSEY
lb = _MOUSEBUTTON(1)
rb = _MOUSEBUTTON(2)
mb = _MOUSEBUTTON(3)
SELECT CASE UI.MbEnvoked
CASE 0
IF lb OR rb OR mb THEN
END IF
CASE 1
IF lb OR rb OR mb THEN UI.MbEnvoked = 0
CASE -1
IF lb = 0 AND rb = 0 AND mb = 0 THEN UI.MbEnvoked = 0
END SELECT
' Check for mouse movement.
IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN
oldcsrlin = CSRLIN: oldpos = POS(0)
LOCATE 3, 1: PRINT "Mouse row/col ="; UI.my; UI.mx; " ";: LOCATE oldcsrlin, oldpos
END IF
IF UI.MbStatus < 0 THEN ' Mouse button pressed. UI.MbStatus identity is by number. -1=left, -2=right, -3=middle.
SELECT CASE UI.MbStatus
CASE -1 ' Left button was pressed.
IF lb = 0 THEN ' Left button released.
SELECT CASE lclick ' Single or double click analysis.
CASE 0
IF mydemo% THEN mydemo% = 3: GOSUB mydemo
lclick = lclick + 1
CASE ELSE ' Double click. Completed upon 2nd left button release.
IF mydemo% THEN mydemo% = 11: GOSUB mydemo
UI.DoubleClick = -1
lclick = 0
END SELECT
UI.MbStatus = 1
IF UI.MbLeftx THEN
IF UI.mx <> UI.MbLeftx OR UI.my <> UI.MbLefty THEN UI.MbStatus = 0: lclick = 0
UI.MbLeftx = 0: UI.MbLefty = 0
END IF
IF UI.drag THEN UI.drag = 0
ELSE ' Left button is being held down. Check for UI.drag.
IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN ' Mouse cursor has moved. UI.drag.
IF mydemo% THEN mydemo% = 12: GOSUB mydemo
UI.drag = -1
END IF
END IF
CASE -2 ' Right button was pressed.
IF rb = 0 THEN ' Right button was relased.
IF mydemo% THEN mydemo% = 4: GOSUB mydemo
UI.MbStatus = 2
END IF
CASE -3 ' Middle button was pressed
IF mb = 0 THEN ' Middle button was released.
IF mydemo% THEN mydemo% = 5: GOSUB mydemo
UI.MbStatus = 3
END IF
END SELECT
ELSE
IF lb THEN ' Left button just pressed.
IF mydemo% THEN mydemo% = 6: GOSUB mydemo
UI.MbStatus = -1
IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
z1 = TIMER
ELSEIF rb THEN ' Right button just pressed.
IF mydemo% THEN mydemo% = 7: GOSUB mydemo
IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
UI.MbStatus = -2
ELSEIF mb THEN ' Middle button just pressed.
IF mydemo% THEN mydemo% = 8: GOSUB mydemo
IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
UI.MbStatus = -3
ELSEIF mw THEN ' Mouse wheel just moved.
SELECT CASE mw
CASE IS > 0 ' Scroll down.
IF mydemo% THEN mydemo% = 9: GOSUB mydemo
CASE IS < 0 ' Scroll up.
IF mydemo% THEN mydemo% = 10: GOSUB mydemo
END SELECT
END IF
END IF
UI.oldmx = UI.mx: UI.oldmy = UI.my: mw = 0 ' Mouse position past and present.
END IF
EXIT SUB
mydemo:
LOCATE 1, 1: PRINT "Last User Status: ";
LOCATE , 19
SELECT CASE mydemo%
CASE 1
PRINT "1-byte Key = "; UI.KeyPress
CASE 2
PRINT "2-byte Key = "; UI.KeyPress
CASE 3
PRINT "Left button released."
CASE 4
PRINT "Right button released."
CASE 5
PRINT "Middle button released."
CASE 6
PRINT "Left button down."
CASE 7
PRINT "Right button down."
CASE 8
PRINT "Middle button down."
CASE 9
PRINT "Wheel scroll down."
CASE 10
PRINT "Wheel scroll up."
CASE 11
PRINT "Left button double click."
CASE 12
PRINT "Drag..."
END SELECT
mydemo% = -1
RETURN
check_UI.KeyCombos:
IF UI.KeyCombos THEN
LOCATE 1, 50
SELECT CASE UI.KeyCombos
CASE 1
PRINT "Shift key down. ";
CASE 2
PRINT "Ctrl key down. ";
CASE 3
PRINT "Ctrl + Shift keys down. ";
CASE 4
PRINT "Alt key down. ";
CASE 5
PRINT "Alt + Shift keys down. ";
CASE 6
PRINT "Ctrl + Alt keys down."
END SELECT
ELSE
LOCATE 1, 50: PRINT SPACE$(29);
END IF
RETURN
END SUBPete