Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Life
#18
I've put together several mouse and keyboard routines for SCREEN 0 over the years.

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 SUB


Pete
Reply


Messages In This Thread
Life - by james2464 - 08-13-2022, 01:19 AM
RE: Life - by johnno56 - 08-13-2022, 10:36 AM
RE: Life - by James D Jarvis - 08-13-2022, 01:18 PM
RE: Life - by bplus - 08-13-2022, 04:46 PM
RE: Life - by james2464 - 08-13-2022, 05:31 PM
RE: Life - by ChiaPet - 08-14-2022, 12:11 AM
RE: Life - by bplus - 08-13-2022, 10:28 PM
RE: Life - by james2464 - 08-14-2022, 12:36 AM
RE: Life - by ChiaPet - 08-14-2022, 12:41 AM
RE: Life - by james2464 - 08-14-2022, 01:17 AM
RE: Life - by dcromley - 08-14-2022, 02:33 AM
RE: Life - by james2464 - 08-14-2022, 07:21 PM
RE: Life - by james2464 - 08-14-2022, 07:27 PM
RE: Life - by ChiaPet - 08-14-2022, 08:21 PM
RE: Life - by bplus - 08-14-2022, 10:03 PM
RE: Life - by james2464 - 08-15-2022, 12:39 AM
RE: Life - by bplus - 08-15-2022, 01:42 AM
RE: Life - by james2464 - 08-15-2022, 01:27 PM
RE: Life - by Pete - 08-15-2022, 05:25 AM
RE: Life - by james2464 - 08-15-2022, 01:35 PM
RE: Life - by bplus - 08-15-2022, 02:13 PM
RE: Life - by james2464 - 08-16-2022, 01:32 AM
RE: Life - by dcromley - 08-15-2022, 06:49 PM
RE: Life - by james2464 - 08-16-2022, 02:19 AM



Users browsing this thread: 1 Guest(s)