Author Topic: Virtual Keyboard (Read 6440 times)

SMcNeill · « **on:** February 05, 2021, 01:11:19 am »

And here's my newest little toy for folks to have fun and play around with -- a virtual keyboard creator!

Code: QB64: [Select]

TYPE Keyboard_Internal_Type
    AS LONG In_Use, Is_Hidden, Handle, Hardware_Handle, Xoffset, Yoffset, Xsize, Ysize
END TYPE
DIM SHARED Virtual_KB(0 TO 10) AS Keyboard_Internal_Type
DIM SHARED Keyboard_Values(0 TO 10, 0 TO 10, 0 TO 255) AS LONG '11 keyboards of up to 11 rows of 256 keys
 
SCREEN _NEWIMAGE(800, 600, 32)
_CONTROLCHR OFF
 
DIM My_Keyboard(5) AS STRING
My_Keyboard(0) = CHR$(0) + "27,ESC" + STRING$(2,0) + "15104,F1" + STRING$(2,0) + "15360,F2" + _
    STRING$(2,0) + "15616,F3" + STRING$(2,0) + "15872,F4" + STRING$(2,0) + "16128,F5" + _
    STRING$(2,0) + "16384,F6" + STRING$(2,0) + "16640,F7" + STRING$(2,0) + "16896,F8" + _
    STRING$(2,0) + "17152,F9" + STRING$(2,0) + "17408,F10" + STRING$(2,0) + "34048,F11" + _
    STRING$(2,0) + "34304,F12" + CHR$(0)
My_Keyboard(1) = "`1234567890-=" + CHR$(0) + "19200,BKSP" + CHR$(0)
My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "QWERTYUIOP[]\"
My_Keyboard(3) = CHR$(0) + "100301,TOGGLE" + CHR$(0) + "ASDFGHJKL;'" + CHR$(0) + "13,ENTER" + CHR$(0)
My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "ZXCVBNM,./" + CHR$(0) + "100303,SHIFT" + CHR$(0)
My_Keyboard(5) = CHR$(0) + "100306,CTRL" + STRING$(2,0) + "0,WIN" + STRING$(2,0) + "100308,ALT" + _
    STRING$(2,0) + "32,SPACE" + STRING$(2,0) + "100307,ALT" + STRING$(2,0) + "0,WIN" + STRING$(2,0) + "0,MENU" + _
    STRING$(2,0) + "100305,CTRL" +  CHR$(0)
 
 
FullsizeKB1 = Create_KB(My_Keyboard(), 16, 50, 30)
 
 
 
My_Keyboard(1) = "~!@#$%^&*()_+" + CHR$(0) + "19200,BKSP" + CHR$(0)
My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "qwertyuiop{}|"
My_Keyboard(3) = CHR$(0) + "100301,TOGGLE" + CHR$(0) + "asdfghjkl:" + CHR$(34) + CHR$(0) + "13,ENTER" + CHR$(0)
My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "zxcvbnm<>?" + CHR$(0) + "100303,SHIFT" + CHR$(0)
FullsizeKB2 = Create_KB(My_Keyboard(), 16, 50, 30)
 
 
Keyboard_In_Use = FullsizeKB1
DO
    Display_KB Keyboard_In_Use, 10, 100, 1
    WHILE _MOUSEINPUT: WEND 'must update mouse buffer before reading virtual keyboard
    k = check_KB(Keyboard_In_Use)
    SELECT CASE k
        CASE 100301 'swap keyboards, rather than having a CAPS LOCK key
            IF Keyboard_In_Use = FullsizeKB1 THEN
                Keyboard_In_Use = FullsizeKB2
            ELSE
                Keyboard_In_Use = FullsizeKB1
            END IF
            _DELAY .2
        CASE IS <> 0
            PRINT k;
            IF k > 0 AND k < 255 THEN PRINT CHR$(k);
            PRINT ,
            _DELAY .2 'delay is so we don't spam clicks from mousedown events
    END SELECT
 
    _DISPLAY
    _LIMIT 30
LOOP UNTIL _KEYHIT
SYSTEM
 
FUNCTION check_KB& (Which)
    STATIC AS INTEGER x, y 'so as to not interfer with any global variables
    x = _MOUSEX - Virtual_KB(Which).Xoffset
    y = _MOUSEY - Virtual_KB(Which).Yoffset
 
    yon = x \ Virtual_KB(Which).Xsize
    xon = y \ Virtual_KB(Which).Ysize
    IF xon >= 0 AND xon <= 10 AND yon >= 0 AND yon <= 255 THEN
        IF _MOUSEBUTTON(1) THEN check_KB& = Keyboard_Values(Which, xon, yon)
    END IF
 
END FUNCTION
 
 
 
SUB Display_KB (Which AS INTEGER, Xwhere AS INTEGER, Ywhere AS INTEGER, style AS INTEGER)
    IF Virtual_KB(Which).In_Use = 0 THEN EXIT SUB
    IF Virtual_KB(Which).Is_Hidden THEN EXIT SUB
    Virtual_KB(Which).Xoffset = Xwhere
    Virtual_KB(Which).Yoffset = Ywhere
    IF style THEN 'we want a hardware image
        _PUTIMAGE (Xwhere, Ywhere), Virtual_KB(Which).Hardware_Handle
    ELSE
        _PUTIMAGE (Xwhere, Ywhere), Virtual_KB(Which).Handle
    END IF
END SUB
 
FUNCTION Create_KB (KB() AS STRING, Font AS LONG, Xsize AS LONG, Ysize AS LONG)
    STATIC AS LONG D, S 'stored as static so as to not interfer with any globals of the same name.
    D = _DEST: S = _SOURCE
 
    FOR i = 0 TO 10
        IF Virtual_KB(i).In_Use = 0 THEN
            Virtual_KB(i).In_Use = -1
            Virtual_KB(i).Xsize = Xsize
            Virtual_KB(i).Ysize = Ysize
 
            Create_KB = i
            EXIT FOR
        END IF
    NEXT
    IF i = 11 THEN
        CLS
        PRINT "Too many keyboards registered in use at the same time!  Can not create a new one."
        END
    END IF
    This_KB = i
 
    keyboard_image = _NEWIMAGE(4096, 4096, 32)
    _DEST keyboard_image: _SOURCE keyboard_image
    _FONT Font
 
    'now build the keyboard
    FOR i = 0 TO UBOUND(KB)
        top = (i - l) * Ysize + Ypos
        count = 0
        FOR j = 1 TO LEN(KB(i))
            left = (count) * Xsize + Xpos
            count = count + 1
            repeat = 1
            c = ASC(KB(i), j): out$ = ""
            IF c = 0 THEN
                'look for the comma
                comma_position = INSTR(j, KB(i), ",")
                IF comma_position THEN 'we have a value, label
                    value$ = MID$(KB(i), j + 1, comma_position - j - 1)
                    c = VAL(value$)
                    j = comma_position + 1
                ELSE 'cry loud and hard so we can sort it out while programming our keyboard layout
                    scream_and_die:
                    SLEEP
                    CLS
                    PRINT "You have an invalid keyboard layout!"
                    END
                END IF
 
                end_position = INSTR(j, KB(i), CHR$(0))
                IF end_position THEN 'we're extracting the label
                    out$ = MID$(KB(i), j, end_position - j)
                    repeat = ASC(out$, LEN(out$))
                    IF repeat > 0 AND repeat < 9 THEN
                        out$ = LEFT$(out$, LEN(out$) - 1)
                    ELSE
                        repeat = 1
                    END IF
                    j = end_position
                ELSE
                    GOTO scream_and_die
                END IF
            END IF
            LINE (left, top)-STEP(Xsize * repeat, Ysize), -1, B
            IF left + Xsize * repeat > max_width THEN max_width = left + Xsize * repeat
            IF top + Ysize > max_height THEN max_height = top + Ysize
            IF c < 256 AND out$ = "" THEN out$ = CHR$(c)
            _PRINTSTRING (left + (Xsize * repeat - _FONTWIDTH * LEN(out$)) / 2, top + (Ysize - _FONTHEIGHT) / 2), out$
 
            DO UNTIL repeat = 1
                Keyboard_Values(This_KB, i, count - 1) = c
                count = count + 1
                repeat = repeat - 1
            LOOP
            Keyboard_Values(This_KB, i, count - 1) = c
        NEXT
    NEXT
 
    'resize to proper size to put upon the screen
    Virtual_KB(This_KB).Handle = _NEWIMAGE(max_width + 1, max_height + 1, 32)
    _PUTIMAGE (0, 0)-(max_width, max_height), keyboard_image, Virtual_KB(This_KB).Handle, (0, 0)-(max_width, max_height)
    Virtual_KB(This_KB).Hardware_Handle = _COPYIMAGE(Virtual_KB(This_KB).Handle, 33)
    _FREEIMAGE keyboard_image
 
    clean_exit:
    _SOURCE S: _DEST D
END FUNCTION

I'll let the demo speak for itself, but if anyone has questions or ideas, I'd be more than happy to hear them. ;)

SMcNeill · « **Reply #1 on:** February 05, 2021, 01:33:36 am »

And here's a keyboard that can actually DO SOMETHING for you. It's a simple calculator!

Code: QB64: [Select]

TYPE Keyboard_Internal_Type
    AS LONG In_Use, Is_Hidden, Handle, Hardware_Handle, Xoffset, Yoffset, Xsize, Ysize
END TYPE
DIM SHARED Virtual_KB(0 TO 10) AS Keyboard_Internal_Type
DIM SHARED Keyboard_Values(0 TO 10, 0 TO 10, 0 TO 255) AS LONG '11 keyboards of up to 11 rows of 256 keys
REDIM SHARED OName(0) AS STRING 'Operation Name
REDIM SHARED PL(0) AS INTEGER 'Priority Level
REDIM SHARED PP_TypeMod(0) AS STRING, PP_ConvertedMod(0) AS STRING 'Prepass Name Conversion variables.
 
 
SCREEN _NEWIMAGE(640, 480, 32)
_CONTROLCHR OFF
 
DIM My_Keyboard(4) AS STRING
My_Keyboard(0) = "^/*-"
My_Keyboard(1) = "789+"
My_Keyboard(2) = "456" + CHR$(0) + "27,End" + CHR$(0)
My_Keyboard(3) = "123" + CHR$(0) + "8,Del" + CHR$(0)
My_Keyboard(4) = "0." + CHR$(0) + "13,Enter" + CHR$(0)
 
 
Numpad = Create_KB(My_Keyboard(), 16, 30, 30)
 
 
 
 
 
ypos = 1
DO
    Display_KB Numpad, 250, 150, 1
    WHILE _MOUSEINPUT: WEND 'must update mouse buffer before reading virtual keyboard
    k = check_KB(Numpad)
 
    SELECT CASE k
        CASE 8
            out$ = LEFT$(out$, LEN(out$) - 1)
            _DELAY .2
        CASE 13
            LOCATE ypos, 1: PRINT out$; " = "; Evaluate_Expression(out$)
            out$ = ""
            ypos = ypos + 1
            _DELAY .2
        CASE 27
            SYSTEM
        CASE IS <> 0
            out$ = out$ + CHR$(k)
            _DELAY .2
    END SELECT
    LOCATE ypos, 1: PRINT out$; " "; answer$
    answer$ = ""
 
    _DISPLAY
    _LIMIT 30
LOOP UNTIL _KEYHIT
SYSTEM
 
FUNCTION check_KB& (Which)
    STATIC AS INTEGER x, y 'so as to not interfer with any global variables
    x = _MOUSEX - Virtual_KB(Which).Xoffset
    y = _MOUSEY - Virtual_KB(Which).Yoffset
 
    yon = x \ Virtual_KB(Which).Xsize
    xon = y \ Virtual_KB(Which).Ysize
    IF xon >= 0 AND xon <= 10 AND yon >= 0 AND yon <= 255 THEN
        IF _MOUSEBUTTON(1) THEN check_KB& = Keyboard_Values(Which, xon, yon)
    END IF
 
END FUNCTION
 
 
 
SUB Display_KB (Which AS INTEGER, Xwhere AS INTEGER, Ywhere AS INTEGER, style AS INTEGER)
    IF Virtual_KB(Which).In_Use = 0 THEN EXIT SUB
    IF Virtual_KB(Which).Is_Hidden THEN EXIT SUB
    Virtual_KB(Which).Xoffset = Xwhere
    Virtual_KB(Which).Yoffset = Ywhere
    IF style THEN 'we want a hardware image
        _PUTIMAGE (Xwhere, Ywhere), Virtual_KB(Which).Hardware_Handle
    ELSE
        _PUTIMAGE (Xwhere, Ywhere), Virtual_KB(Which).Handle
    END IF
END SUB
 
FUNCTION Create_KB (KB() AS STRING, Font AS LONG, Xsize AS LONG, Ysize AS LONG)
    STATIC AS LONG D, S 'stored as static so as to not interfer with any globals of the same name.
    D = _DEST: S = _SOURCE
 
    FOR i = 0 TO 10
        IF Virtual_KB(i).In_Use = 0 THEN
            Virtual_KB(i).In_Use = -1
            Virtual_KB(i).Xsize = Xsize
            Virtual_KB(i).Ysize = Ysize
 
            Create_KB = i
            EXIT FOR
        END IF
    NEXT
    IF i = 11 THEN
        CLS
        PRINT "Too many keyboards registered in use at the same time!  Can not create a new one."
        END
    END IF
    This_KB = i
 
    keyboard_image = _NEWIMAGE(4096, 4096, 32)
    _DEST keyboard_image: _SOURCE keyboard_image
    _FONT Font
 
    'now build the keyboard
    FOR i = 0 TO UBOUND(KB)
        top = (i - l) * Ysize + Ypos
        count = 0
        FOR j = 1 TO LEN(KB(i))
            left = (count) * Xsize + Xpos
            count = count + 1
            repeat = 1
            c = ASC(KB(i), j): out$ = ""
            IF c = 0 THEN
                'look for the comma
                comma_position = INSTR(j, KB(i), ",")
                IF comma_position THEN 'we have a value, label
                    value$ = MID$(KB(i), j + 1, comma_position - j - 1)
                    c = VAL(value$)
                    j = comma_position + 1
                ELSE 'cry loud and hard so we can sort it out while programming our keyboard layout
                    scream_and_die:
                    SLEEP
                    CLS
                    PRINT "You have an invalid keyboard layout!"
                    END
                END IF
 
                end_position = INSTR(j, KB(i), CHR$(0))
                IF end_position THEN 'we're extracting the label
                    out$ = MID$(KB(i), j, end_position - j)
                    repeat = ASC(out$, LEN(out$))
                    IF repeat > 0 AND repeat < 9 THEN
                        out$ = LEFT$(out$, LEN(out$) - 1)
                    ELSE
                        repeat = 1
                    END IF
                    j = end_position
                ELSE
                    GOTO scream_and_die
                END IF
            END IF
            LINE (left, top)-STEP(Xsize * repeat, Ysize), -1, B
            IF left + Xsize * repeat > max_width THEN max_width = left + Xsize * repeat
            IF top + Ysize > max_height THEN max_height = top + Ysize
            IF c < 256 AND out$ = "" THEN out$ = CHR$(c)
            _PRINTSTRING (left + (Xsize * repeat - _FONTWIDTH * LEN(out$)) / 2, top + (Ysize - _FONTHEIGHT) / 2), out$
 
            DO UNTIL repeat = 1
                Keyboard_Values(This_KB, i, count - 1) = c
                count = count + 1
                repeat = repeat - 1
            LOOP
            Keyboard_Values(This_KB, i, count - 1) = c
        NEXT
    NEXT
 
    'resize to proper size to put upon the screen
    Virtual_KB(This_KB).Handle = _NEWIMAGE(max_width + 1, max_height + 1, 32)
    _PUTIMAGE (0, 0)-(max_width, max_height), keyboard_image, Virtual_KB(This_KB).Handle, (0, 0)-(max_width, max_height)
    Virtual_KB(This_KB).Hardware_Handle = _COPYIMAGE(Virtual_KB(This_KB).Handle, 33)
    _FREEIMAGE keyboard_image
 
    clean_exit:
    _SOURCE S: _DEST D
END FUNCTION
 
'Steve Subs/Functins for _MATH support with CONST
FUNCTION Evaluate_Expression$ (e$)
    t$ = e$ 'So we preserve our original data, we parse a temp copy of it
    PreParse t$
 
 
    IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
 
    'Deal with brackets first
    EXP$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
 
    DO
        Eval_E = INSTR(EXP$, ")")
        IF Eval_E > 0 THEN
            c = 0
            DO UNTIL Eval_E - c <= 0
                c = c + 1
                IF Eval_E THEN
                    IF MID$(EXP$, Eval_E - c, 1) = "(" THEN EXIT DO
                END IF
            LOOP
            s = Eval_E - c + 1
            IF s < 1 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT SUB
            eval$ = " " + MID$(EXP$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
 
            'PRINT "Before ParseExpression: "; eval$
            ParseExpression eval$
            'PRINT "After ParseExpression: "; eval$
            eval$ = LTRIM$(RTRIM$(eval$))
            IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT SUB
            EXP$ = DWD(LEFT$(EXP$, s - 2) + eval$ + MID$(EXP$, Eval_E + 1))
            'PRINT exp$
            IF MID$(EXP$, 1, 1) = "N" THEN MID$(EXP$, 1) = "-"
 
            'temppp$ = DWD(LEFT$(exp$, s - 2) + " ## " + eval$ + " ## " + MID$(exp$, e + 1))
        END IF
    LOOP UNTIL Eval_E = 0
    c = 0
    DO
        c = c + 1
        SELECT CASE MID$(EXP$, c, 1)
            CASE "0" TO "9", ".", "-" 'At this point, we should only have number values left.
            CASE ELSE: Evaluate_Expression$ = "ERROR - Unknown Diagnosis: (" + EXP$ + ") ": EXIT SUB
        END SELECT
    LOOP UNTIL c >= LEN(EXP$)
 
    Evaluate_Expression$ = EXP$
END FUNCTION
 
 
 
SUB ParseExpression (EXP$)
    DIM num(10) AS STRING
    'PRINT exp$
    EXP$ = DWD(EXP$)
    'We should now have an expression with no () to deal with
    'IF MID$(exp$, 2, 1) = "-" THEN exp$ = "0+" + MID$(exp$, 2)
    FOR J = 1 TO 250
        lowest = 0
        DO UNTIL lowest = LEN(EXP$)
            lowest = LEN(EXP$): OpOn = 0
            FOR P = 1 TO UBOUND(OName)
                'Look for first valid operator
                IF J = PL(P) THEN 'Priority levels match
                    IF LEFT$(EXP$, 1) = "-" THEN op = INSTR(2, EXP$, OName(P)) ELSE op = INSTR(EXP$, OName(P))
                    IF op > 0 AND op < lowest THEN lowest = op: OpOn = P
                END IF
            NEXT
            IF OpOn = 0 THEN EXIT DO 'We haven't gotten to the proper PL for this OP to be processed yet.
            IF LEFT$(EXP$, 1) = "-" THEN op = INSTR(2, EXP$, OName(OpOn)) ELSE op = INSTR(EXP$, OName(OpOn))
            numset = 0
 
            '*** SPECIAL OPERATION RULESETS
            IF OName(OpOn) = "-" THEN 'check for BOOLEAN operators before the -
                SELECT CASE MID$(EXP$, op - 3, 3)
                    CASE "NOT", "XOR", "AND", "EQV", "IMP"
                        EXIT DO 'Not an operator, it's a negative
                END SELECT
                IF MID$(EXP$, op - 3, 2) = "OR" THEN EXIT DO 'Not an operator, it's a negative
            END IF
 
            IF op THEN
                c = LEN(OName(OpOn)) - 1
                DO
                    SELECT CASE MID$(EXP$, op + c + 1, 1)
                        CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N": numset = -1 'Valid digit
                        CASE "-" 'We need to check if it's a minus or a negative
                            IF OName(OpOn) = "_PI" OR numset THEN EXIT DO
                        CASE ",": numset = 0
                        CASE ELSE 'Not a valid digit, we found our separator
                            EXIT DO
                    END SELECT
                    c = c + 1
                LOOP UNTIL op + c >= LEN(EXP$)
                e = op + c
 
                c = 0
                DO
                    c = c + 1
                    SELECT CASE MID$(EXP$, op - c, 1)
                        CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N" 'Valid digit
                        CASE "-" 'We need to check if it's a minus or a negative
                            c1 = c
                            bad = 0
                            DO
                                c1 = c1 + 1
                                SELECT CASE MID$(EXP$, op - c1, 1)
                                    CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "."
                                        bad = -1
                                        EXIT DO 'It's a minus sign
                                    CASE ELSE
                                        'It's a negative sign and needs to count as part of our numbers
                                END SELECT
                            LOOP UNTIL op - c1 <= 0
                            IF bad THEN EXIT DO 'We found our seperator
                        CASE ELSE 'Not a valid digit, we found our separator
                            EXIT DO
                    END SELECT
                LOOP UNTIL op - c <= 0
                s = op - c
                num(1) = MID$(EXP$, s + 1, op - s - 1) 'Get our first number
                num(2) = MID$(EXP$, op + LEN(OName(OpOn)), e - op - LEN(OName(OpOn)) + 1) 'Get our second number
                IF MID$(num(1), 1, 1) = "N" THEN MID$(num(1), 1) = "-"
                IF MID$(num(2), 1, 1) = "N" THEN MID$(num(2), 1) = "-"
                IF num(1) = "-" THEN
                    num(3) = "N" + EvaluateNumbers(OpOn, num())
                ELSE
                    num(3) = EvaluateNumbers(OpOn, num())
                END IF
                IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N"
                'PRINT "*************"
                'PRINT num(1), OName(OpOn), num(2), num(3), exp$
                IF LEFT$(num(3), 5) = "ERROR" THEN EXP$ = num(3): EXIT SUB
                EXP$ = LTRIM$(N2S(DWD(LEFT$(EXP$, s) + RTRIM$(LTRIM$(num(3))) + MID$(EXP$, e + 1))))
                'PRINT exp$
            END IF
            op = 0
        LOOP
    NEXT
 
END SUB
 
 
 
SUB Set_OrderOfOperations
    'PL sets our priortity level. 1 is highest to 65535 for the lowest.
    'I used a range here so I could add in new priority levels as needed.
    'OName ended up becoming the name of our commands, as I modified things.... Go figure!  LOL!
    REDIM OName(10000) AS STRING, PL(10000) AS INTEGER
    'Constants get evaluated first, with a Priority Level of 1
 
    i = i + 1: OName(i) = "C_UOF": PL(i) = 5 'convert to unsigned offset
    i = i + 1: OName(i) = "C_OF": PL(i) = 5 'convert to offset
    i = i + 1: OName(i) = "C_UBY": PL(i) = 5 'convert to unsigned byte
    i = i + 1: OName(i) = "C_BY": PL(i) = 5 'convert to byte
    i = i + 1: OName(i) = "C_UIN": PL(i) = 5 'convert to unsigned integer
    i = i + 1: OName(i) = "C_IN": PL(i) = 5 'convert to integer
    i = i + 1: OName(i) = "C_UIF": PL(i) = 5 'convert to unsigned int64
    i = i + 1: OName(i) = "C_IF": PL(i) = 5 'convert to int64
    i = i + 1: OName(i) = "C_ULO": PL(i) = 5 'convert to unsigned long
    i = i + 1: OName(i) = "C_LO": PL(i) = 5 'convert to long
    i = i + 1: OName(i) = "C_SI": PL(i) = 5 'convert to single
    i = i + 1: OName(i) = "C_FL": PL(i) = 5 'convert to float
    i = i + 1: OName(i) = "C_DO": PL(i) = 5 'convert to double
    i = i + 1: OName(i) = "C_UBI": PL(i) = 5 'convert to unsigned bit
    i = i + 1: OName(i) = "C_BI": PL(i) = 5 'convert to bit
 
    'Then Functions with PL 10
    i = i + 1:: OName(i) = "_PI": PL(i) = 10
    i = i + 1: OName(i) = "_ACOS": PL(i) = 10
    i = i + 1: OName(i) = "_ASIN": PL(i) = 10
    i = i + 1: OName(i) = "_ARCSEC": PL(i) = 10
    i = i + 1: OName(i) = "_ARCCSC": PL(i) = 10
    i = i + 1: OName(i) = "_ARCCOT": PL(i) = 10
    i = i + 1: OName(i) = "_SECH": PL(i) = 10
    i = i + 1: OName(i) = "_CSCH": PL(i) = 10
    i = i + 1: OName(i) = "_COTH": PL(i) = 10
    i = i + 1: OName(i) = "COS": PL(i) = 10
    i = i + 1: OName(i) = "SIN": PL(i) = 10
    i = i + 1: OName(i) = "TAN": PL(i) = 10
    i = i + 1: OName(i) = "LOG": PL(i) = 10
    i = i + 1: OName(i) = "EXP": PL(i) = 10
    i = i + 1: OName(i) = "ATN": PL(i) = 10
    i = i + 1: OName(i) = "_D2R": PL(i) = 10
    i = i + 1: OName(i) = "_D2G": PL(i) = 10
    i = i + 1: OName(i) = "_R2D": PL(i) = 10
    i = i + 1: OName(i) = "_R2G": PL(i) = 10
    i = i + 1: OName(i) = "_G2D": PL(i) = 10
    i = i + 1: OName(i) = "_G2R": PL(i) = 10
    i = i + 1: OName(i) = "ABS": PL(i) = 10
    i = i + 1: OName(i) = "SGN": PL(i) = 10
    i = i + 1: OName(i) = "INT": PL(i) = 10
    i = i + 1: OName(i) = "_ROUND": PL(i) = 10
    i = i + 1: OName(i) = "_CEIL": PL(i) = 10
    i = i + 1: OName(i) = "FIX": PL(i) = 10
    i = i + 1: OName(i) = "_SEC": PL(i) = 10
    i = i + 1: OName(i) = "_CSC": PL(i) = 10
    i = i + 1: OName(i) = "_COT": PL(i) = 10
    i = i + 1: OName(i) = "ASC": PL(i) = 10
    i = i + 1: OName(i) = "CHR$": PL(i) = 10
    i = i + 1: OName(i) = "C_RG": PL(i) = 10 '_RGB32 converted
    i = i + 1: OName(i) = "C_RA": PL(i) = 10 '_RGBA32 converted
    i = i + 1: OName(i) = "_RGB": PL(i) = 10
    i = i + 1: OName(i) = "_RGBA": PL(i) = 10
    i = i + 1: OName(i) = "C_RX": PL(i) = 10 '_RED32 converted
    i = i + 1: OName(i) = "C_GR": PL(i) = 10 ' _GREEN32 converted
    i = i + 1: OName(i) = "C_BL": PL(i) = 10 '_BLUE32 converted
    i = i + 1: OName(i) = "C_AL": PL(i) = 10 '_ALPHA32 converted
    i = i + 1: OName(i) = "_RED": PL(i) = 10
    i = i + 1: OName(i) = "_GREEN": PL(i) = 10
    i = i + 1: OName(i) = "_BLUE": PL(i) = 10
    i = i + 1: OName(i) = "_ALPHA": PL(i) = 10
 
    'Exponents with PL 20
    i = i + 1: OName(i) = "^": PL(i) = 20
    i = i + 1: OName(i) = "SQR": PL(i) = 20
    i = i + 1: OName(i) = "ROOT": PL(i) = 20
    'Multiplication and Division PL 30
    i = i + 1: OName(i) = "*": PL(i) = 30
    i = i + 1: OName(i) = "/": PL(i) = 30
    'Integer Division PL 40
    i = i + 1: OName(i) = "\": PL(i) = 40
    'MOD PL 50
    i = i + 1: OName(i) = "MOD": PL(i) = 50
    'Addition and Subtraction PL 60
    i = i + 1: OName(i) = "+": PL(i) = 60
    i = i + 1: OName(i) = "-": PL(i) = 60
 
    'Relational Operators =, >, <, <>, <=, >=   PL 70
    i = i + 1: OName(i) = "<>": PL(i) = 70 'These next three are just reversed symbols as an attempt to help process a common typo
    i = i + 1: OName(i) = "><": PL(i) = 70
    i = i + 1: OName(i) = "<=": PL(i) = 70
    i = i + 1: OName(i) = ">=": PL(i) = 70
    i = i + 1: OName(i) = "=<": PL(i) = 70 'I personally can never keep these things straight.  Is it < = or = <...
    i = i + 1: OName(i) = "=>": PL(i) = 70 'Who knows, check both!
    i = i + 1: OName(i) = ">": PL(i) = 70
    i = i + 1: OName(i) = "<": PL(i) = 70
    i = i + 1: OName(i) = "=": PL(i) = 70
    'Logical Operations PL 80+
    i = i + 1: OName(i) = "NOT": PL(i) = 80
    i = i + 1: OName(i) = "AND": PL(i) = 90
    i = i + 1: OName(i) = "OR": PL(i) = 100
    i = i + 1: OName(i) = "XOR": PL(i) = 110
    i = i + 1: OName(i) = "EQV": PL(i) = 120
    i = i + 1: OName(i) = "IMP": PL(i) = 130
    i = i + 1: OName(i) = ",": PL(i) = 1000
 
    REDIM _PRESERVE OName(i) AS STRING, PL(i) AS INTEGER
END SUB
 
FUNCTION EvaluateNumbers$ (p, num() AS STRING)
    DIM n1 AS _FLOAT, n2 AS _FLOAT, n3 AS _FLOAT
    'PRINT "EVALNUM:"; OName(p), num(1), num(2)
    IF INSTR(num(1), ",") THEN
        EvaluateNumbers$ = "ERROR - Invalid comma (" + num(1) + ")": EXIT FUNCTION
    END IF
    l2 = INSTR(num(2), ",")
    IF l2 THEN
        SELECT CASE OName(p) 'only certain commands should pass a comma value
            CASE "C_RG", "C_RA", "_RGB", "_RGBA", "_RED", "_GREEN", "C_BL", "_ALPHA"
            CASE ELSE
                C$ = MID$(num(2), l2)
                num(2) = LEFT$(num(2), l2 - 1)
        END SELECT
    END IF
 
    SELECT CASE PL(p) 'divide up the work so we want do as much case checking
        CASE 5 'Type conversions
            'Note, these are special cases and work with the number BEFORE the command and not after
            SELECT CASE OName(p) 'Depending on our operator..
                CASE "C_UOF": n1~%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%&)))
                CASE "C_ULO": n1%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%&)))
                CASE "C_UBY": n1~%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%%)))
                CASE "C_UIN": n1~% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%)))
                CASE "C_BY": n1%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%%)))
                CASE "C_IN": n1% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%)))
                CASE "C_UIF": n1~&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&&)))
                CASE "C_OF": n1~& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&)))
                CASE "C_IF": n1&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&&)))
                CASE "C_LO": n1& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&)))
                CASE "C_UBI": n1~` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~`)))
                CASE "C_BI": n1` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1`)))
                CASE "C_FL": n1## = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1##)))
                CASE "C_DO": n1# = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1#)))
                CASE "C_SI": n1! = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1!)))
            END SELECT
            EXIT FUNCTION
        CASE 10 'functions
            SELECT CASE OName(p) 'Depending on our operator..
                CASE "_PI"
                    n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
                    IF num(2) <> "" THEN n1 = n1 * VAL(num(2))
                CASE "_ACOS": n1 = _ACOS(VAL(num(2)))
                CASE "_ASIN": n1 = _ASIN(VAL(num(2)))
                CASE "_ARCSEC": n1 = _ARCSEC(VAL(num(2)))
                CASE "_ARCCSC": n1 = _ARCCSC(VAL(num(2)))
                CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
                CASE "_SECH": n1 = _SECH(VAL(num(2)))
                CASE "_CSCH": n1 = _CSCH(VAL(num(2)))
                CASE "_COTH": n1 = _COTH(VAL(num(2)))
                CASE "C_RG"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB32": EXIT FUNCTION
                    c1 = INSTR(n$, ",")
                    IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
                    IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
                    IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
                    IF c1 = 0 THEN 'there's no comma in the command to parse.  It's a grayscale value
                        n = VAL(num(2))
                        n1 = _RGB32(n, n, n)
                    ELSEIF c2 = 0 THEN 'there's one comma and not 2.  It's grayscale with alpha.
                        n = VAL(LEFT$(num(2), c1))
                        n2 = VAL(MID$(num(2), c1 + 1))
                        n1 = _RGBA32(n, n, n, n2)
                    ELSEIF c3 = 0 THEN 'there's two commas.  It's _RGB values
                        n = VAL(LEFT$(num(2), c1))
                        n2 = VAL(MID$(num(2), c1 + 1))
                        n3 = VAL(MID$(num(2), c2 + 1))
                        n1 = _RGB32(n, n2, n3)
                    ELSEIF c4 = 0 THEN 'there's three commas.  It's _RGBA values
                        n = VAL(LEFT$(num(2), c1))
                        n2 = VAL(MID$(num(2), c1 + 1))
                        n3 = VAL(MID$(num(2), c2 + 1))
                        n4 = VAL(MID$(num(2), c3 + 1))
                        n1 = _RGBA32(n, n2, n3, n4)
                    ELSE 'we have more than three commas.  I have no idea WTH type of values got passed here!
                        EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
                    END IF
                CASE "C_RA"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA32": EXIT FUNCTION
                    c1 = INSTR(n$, ",")
                    IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
                    IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
                    IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
                    IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
                    'we have to have 3 commas; not more, not less.
                    n = VAL(LEFT$(num(2), c1))
                    n2 = VAL(MID$(num(2), c1 + 1))
                    n3 = VAL(MID$(num(2), c2 + 1))
                    n4 = VAL(MID$(num(2), c3 + 1))
                    n1 = _RGBA32(n, n2, n3, n4)
                CASE "_RGB"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB": EXIT FUNCTION
                    c1 = INSTR(n$, ",")
                    IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
                    IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
                    IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
                    IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGB requires 4 parameters for Red, Green, Blue, ScreenMode.": EXIT FUNCTION
                    'we have to have 3 commas; not more, not less.
                    n = VAL(LEFT$(num(2), c1))
                    n2 = VAL(MID$(num(2), c1 + 1))
                    n3 = VAL(MID$(num(2), c2 + 1))
                    n4 = VAL(MID$(num(2), c3 + 1))
                    SELECT CASE n4
                        CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
                        CASE ELSE
                            EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n4) + ")": EXIT FUNCTION
                    END SELECT
                    t = _NEWIMAGE(1, 1, n4)
                    n1 = _RGB(n, n2, n3, t)
                    _FREEIMAGE t
                CASE "_RGBA"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA": EXIT FUNCTION
                    c1 = INSTR(n$, ",")
                    IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
                    IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
                    IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
                    IF c4 THEN c5 = INSTR(c4 + 1, n$, ",")
                    IF c4 = 0 OR c5 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGBA requires 5 parameters for Red, Green, Blue, Alpha, ScreenMode.": EXIT FUNCTION
                    'we have to have 4 commas; not more, not less.
                    n = VAL(LEFT$(num(2), c1))
                    n2 = VAL(MID$(num(2), c1 + 1))
                    n3 = VAL(MID$(num(2), c2 + 1))
                    n4 = VAL(MID$(num(2), c3 + 1))
                    n5 = VAL(MID$(num(2), c4 + 1))
                    SELECT CASE n5
                        CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
                        CASE ELSE
                            EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n5) + ")": EXIT FUNCTION
                    END SELECT
                    t = _NEWIMAGE(1, 1, n5)
                    n1 = _RGBA(n, n2, n3, n4, t)
                    _FREEIMAGE t
                CASE "_RED", "_GREEN", "_BLUE", "_ALPHA"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
                    c1 = INSTR(n$, ",")
                    IF c1 = 0 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
                    IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
                    IF c2 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
                    n = VAL(LEFT$(num(2), c1))
                    n2 = VAL(MID$(num(2), c1 + 1))
                    SELECT CASE n2
                        CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
                        CASE ELSE
                            EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n2) + ")": EXIT FUNCTION
                    END SELECT
                    t = _NEWIMAGE(1, 1, n4)
                    SELECT CASE OName(p)
                        CASE "_RED": n1 = _RED(n, t)
                        CASE "_BLUE": n1 = _BLUE(n, t)
                        CASE "_GREEN": n1 = _GREEN(n, t)
                        CASE "_ALPHA": n1 = _ALPHA(n, t)
                    END SELECT
                    _FREEIMAGE t
                CASE "C_RX", "C_GR", "C_BL", "C_AL"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
                    n = VAL(num(2))
                    SELECT CASE OName(p)
                        CASE "C_RX": n1 = _RED32(n)
                        CASE "C_BL": n1 = _BLUE32(n)
                        CASE "C_GR": n1 = _GREEN32(n)
                        CASE "C_AL": n1 = _ALPHA32(n)
                    END SELECT
                CASE "COS": n1 = COS(VAL(num(2)))
                CASE "SIN": n1 = SIN(VAL(num(2)))
                CASE "TAN": n1 = TAN(VAL(num(2)))
                CASE "LOG": n1 = LOG(VAL(num(2)))
                CASE "EXP": n1 = EXP(VAL(num(2)))
                CASE "ATN": n1 = ATN(VAL(num(2)))
                CASE "_D2R": n1 = 0.0174532925 * (VAL(num(2)))
                CASE "_D2G": n1 = 1.1111111111 * (VAL(num(2)))
                CASE "_R2D": n1 = 57.2957795 * (VAL(num(2)))
                CASE "_R2G": n1 = 0.015707963 * (VAL(num(2)))
                CASE "_G2D": n1 = 0.9 * (VAL(num(2)))
                CASE "_G2R": n1 = 63.661977237 * (VAL(num(2)))
                CASE "ABS": n1 = ABS(VAL(num(2)))
                CASE "SGN": n1 = SGN(VAL(num(2)))
                CASE "INT": n1 = INT(VAL(num(2)))
                CASE "_ROUND": n1 = _ROUND(VAL(num(2)))
                CASE "_CEIL": n1 = _CEIL(VAL(num(2)))
                CASE "FIX": n1 = FIX(VAL(num(2)))
                CASE "_SEC": n1 = _SEC(VAL(num(2)))
                CASE "_CSC": n1 = _CSC(VAL(num(2)))
                CASE "_COT": n1 = _COT(VAL(num(2)))
            END SELECT
        CASE 20 TO 60 'Math Operators
            SELECT CASE OName(p) 'Depending on our operator..
                CASE "^": n1 = VAL(num(1)) ^ VAL(num(2))
                CASE "SQR": n1 = SQR(VAL(num(2)))
                CASE "ROOT"
                    n1 = VAL(num(1)): n2 = VAL(num(2))
                    IF n2 = 1 THEN EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))): EXIT FUNCTION
                    IF n1 < 0 AND n2 >= 1 THEN sign = -1: n1 = -n1 ELSE sign = 1
                    n3 = 1## / n2
                    IF n3 <> INT(n3) AND n2 < 1 THEN sign = SGN(n1): n1 = ABS(n1)
                    n1 = sign * (n1 ^ n3)
                CASE "*": n1 = VAL(num(1)) * VAL(num(2))
                CASE "/": n1 = VAL(num(1)) / VAL(num(2))
                CASE "\"
                    IF VAL(num(2)) <> 0 THEN
                        n1 = VAL(num(1)) \ VAL(num(2))
                    ELSE
                        EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
                        EXIT FUNCTION
                    END IF
                CASE "MOD": n1 = VAL(num(1)) MOD VAL(num(2))
                CASE "+": n1 = VAL(num(1)) + VAL(num(2))
                CASE "-":
                    n1 = VAL(num(1)) - VAL(num(2))
            END SELECT
        CASE 70 'Relational Operators =, >, <, <>, <=, >=
            SELECT CASE OName(p) 'Depending on our operator..
                CASE "=": n1 = VAL(num(1)) = VAL(num(2))
                CASE ">": n1 = VAL(num(1)) > VAL(num(2))
                CASE "<": n1 = VAL(num(1)) < VAL(num(2))
                CASE "<>", "><": n1 = VAL(num(1)) <> VAL(num(2))
                CASE "<=", "=<": n1 = VAL(num(1)) <= VAL(num(2))
                CASE ">=", "=>": n1 = VAL(num(1)) >= VAL(num(2))
            END SELECT
        CASE ELSE 'a value we haven't processed elsewhere
            SELECT CASE OName(p) 'Depending on our operator..
                CASE "NOT": n1 = NOT VAL(num(2))
                CASE "AND": n1 = VAL(num(1)) AND VAL(num(2))
                CASE "OR": n1 = VAL(num(1)) OR VAL(num(2))
                CASE "XOR": n1 = VAL(num(1)) XOR VAL(num(2))
                CASE "EQV": n1 = VAL(num(1)) EQV VAL(num(2))
                CASE "IMP": n1 = VAL(num(1)) IMP VAL(num(2))
            END SELECT
    END SELECT
 
    EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))) + C$
 
    'PRINT "AFTEREVN:"; EvaluateNumbers$
END FUNCTION
 
FUNCTION DWD$ (EXP$) 'Deal With Duplicates
    'To deal with duplicate operators in our code.
    'Such as --  becomes a +
    '++ becomes a +
    '+- becomes a -
    '-+ becomes a -
    t$ = EXP$
    DO
        bad = 0
        DO
            l = INSTR(t$, "++")
            IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
        LOOP UNTIL l = 0
        DO
            l = INSTR(t$, "+-")
            IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
        LOOP UNTIL l = 0
        DO
            l = INSTR(t$, "-+")
            IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
        LOOP UNTIL l = 0
        DO
            l = INSTR(t$, "--")
            IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
        LOOP UNTIL l = 0
        'PRINT "FIXING: "; t$
    LOOP UNTIL NOT bad
    DWD$ = t$
END FUNCTION
 
SUB PreParse (e$)
    DIM f AS _FLOAT
 
    IF PP_TypeMod(0) = "" THEN
        REDIM PP_TypeMod(100) AS STRING, PP_ConvertedMod(100) AS STRING 'Large enough to hold all values to begin with
        PP_TypeMod(0) = "Initialized" 'Set so we don't do this section over and over, as we keep the values in shared memory.
        Set_OrderOfOperations 'Call this once to set up our proper order of operations and variable list
        'and the below is a conversion list so symbols don't get cross confused.
        i = i + 1: PP_TypeMod(i) = "~`": PP_ConvertedMod(i) = "C_UBI" 'unsigned bit
        i = i + 1: PP_TypeMod(i) = "~%%": PP_ConvertedMod(i) = "C_UBY" 'unsigned byte
        i = i + 1: PP_TypeMod(i) = "~%&": PP_ConvertedMod(i) = "C_UOF" 'unsigned offset
        i = i + 1: PP_TypeMod(i) = "~%": PP_ConvertedMod(i) = "C_UIN" 'unsigned integer
        i = i + 1: PP_TypeMod(i) = "~&&": PP_ConvertedMod(i) = "C_UIF" 'unsigned integer64
        i = i + 1: PP_TypeMod(i) = "~&": PP_ConvertedMod(i) = "C_ULO" 'unsigned long
        i = i + 1: PP_TypeMod(i) = "`": PP_ConvertedMod(i) = "C_BI" 'bit
        i = i + 1: PP_TypeMod(i) = "%%": PP_ConvertedMod(i) = "C_BY" 'byte
        i = i + 1: PP_TypeMod(i) = "%&": PP_ConvertedMod(i) = "C_OF" 'offset
        i = i + 1: PP_TypeMod(i) = "%": PP_ConvertedMod(i) = "C_IN" 'integer
        i = i + 1: PP_TypeMod(i) = "&&": PP_ConvertedMod(i) = "C_IF" 'integer64
        i = i + 1: PP_TypeMod(i) = "&": PP_ConvertedMod(i) = "C_LO" 'long
        i = i + 1: PP_TypeMod(i) = "!": PP_ConvertedMod(i) = "C_SI" 'single
        i = i + 1: PP_TypeMod(i) = "##": PP_ConvertedMod(i) = "C_FL" 'float
        i = i + 1: PP_TypeMod(i) = "#": PP_ConvertedMod(i) = "C_DO" 'double
        i = i + 1: PP_TypeMod(i) = "_RGB32": PP_ConvertedMod(i) = "C_RG" 'rgb32
        i = i + 1: PP_TypeMod(i) = "_RGBA32": PP_ConvertedMod(i) = "C_RA" 'rgba32
        i = i + 1: PP_TypeMod(i) = "_RED32": PP_ConvertedMod(i) = "C_RX" 'red32
        i = i + 1: PP_TypeMod(i) = "_GREEN32": PP_ConvertedMod(i) = "C_GR" 'green32
        i = i + 1: PP_TypeMod(i) = "_BLUE32": PP_ConvertedMod(i) = "C_BL" 'blue32
        i = i + 1: PP_TypeMod(i) = "_ALPHA32": PP_ConvertedMod(i) = "C_AL" 'alpha32
        REDIM _PRESERVE PP_TypeMod(i) AS STRING, PP_ConvertedMod(i) AS STRING 'And then resized to just contain the necessary space in memory
    END IF
    t$ = e$
 
    'First strip all spaces
    t$ = ""
    FOR i = 1 TO LEN(e$)
        IF MID$(e$, i, 1) <> " " THEN t$ = t$ + MID$(e$, i, 1)
    NEXT
 
    t$ = UCASE$(t$)
    IF t$ = "" THEN e$ = "ERROR -- NULL string; nothing to evaluate": EXIT SUB
 
    'ERROR CHECK by counting our brackets
    l = 0
    DO
        l = INSTR(l + 1, t$, "("): IF l THEN c = c + 1
    LOOP UNTIL l = 0
    l = 0
    DO
        l = INSTR(l + 1, t$, ")"): IF l THEN c1 = c1 + 1
    LOOP UNTIL l = 0
    IF c <> c1 THEN e$ = "ERROR -- Bad Parenthesis:" + STR$(c) + "( vs" + STR$(c1) + ")": EXIT SUB
 
    'Modify so that NOT will process properly
    l = 0
    DO
        l = INSTR(l + 1, t$, "NOT")
        IF l THEN
            'We need to work magic on the statement so it looks pretty.
            ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
            'Look for something not proper
            l1 = INSTR(l + 1, t$, "AND")
            IF l1 = 0 OR (INSTR(l + 1, t$, "OR") > 0 AND INSTR(l + 1, t$, "OR") < l1) THEN l1 = INSTR(l + 1, t$, "OR")
            IF l1 = 0 OR (INSTR(l + 1, t$, "XOR") > 0 AND INSTR(l + 1, t$, "XOR") < l1) THEN l1 = INSTR(l + 1, t$, "XOR")
            IF l1 = 0 OR (INSTR(l + 1, t$, "EQV") > 0 AND INSTR(l + 1, t$, "EQV") < l1) THEN l1 = INSTR(l + 1, t$, "EQV")
            IF l1 = 0 OR (INSTR(l + 1, t$, "IMP") > 0 AND INSTR(l + 1, t$, "IMP") < l1) THEN l1 = INSTR(l + 1, t$, "IMP")
            IF l1 = 0 THEN l1 = LEN(t$) + 1
            t$ = LEFT$(t$, l - 1) + "(" + MID$(t$, l, l1 - l) + ")" + MID$(t$, l + l1 - l)
            l = l + 3
            'PRINT t$
        END IF
    LOOP UNTIL l = 0
 
    FOR j = 1 TO UBOUND(PP_TypeMod)
        l = 0
        DO
            l = INSTR(l + 1, t$, PP_TypeMod(j))
            IF l = 0 THEN EXIT DO
            i = 0: l1 = 0: l2 = 0: lo = LEN(PP_TypeMod(j))
            DO
                IF PL(i) > 10 THEN
                    l2 = _INSTRREV(l, t$, OName$(i))
                    IF l2 > 0 AND l2 > l1 THEN l1 = l2
                END IF
                i = i + lo
            LOOP UNTIL i > UBOUND(PL)
            'PRINT "L1:"; l1; "L"; l
            l$ = LEFT$(t$, l1)
            m$ = MID$(t$, l1 + 1, l - l1 - 1)
            r$ = PP_ConvertedMod(j) + MID$(t$, l + lo)
            'PRINT "Y$: "; TypeMod(j)
            'PRINT "L$: "; l$
            'PRINT "M$: "; m$
            'PRINT "R$: "; r$
            IF j > 15 THEN
                t$ = l$ + m$ + r$ 'replacement routine for commands which might get confused with others, like _RGB and _RGB32
            ELSE
                'the first 15 commands need to properly place the parenthesis around the value we want to convert.
                t$ = l$ + "(" + m$ + ")" + r$
            END IF
            'PRINT "T$: "; t$
            l = l + 2 + LEN(PP_TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and  ")"
        LOOP
    NEXT
    '    PRINT "HERE: "; t$
 
 
 
    'Check for bad operators before a ( bracket
    l = 0
    DO
        l = INSTR(l + 1, t$, "(")
        IF l AND l > 2 THEN 'Don't check the starting bracket; there's nothing before it.
            good = 0
            'PRINT "BEFORE: "; t$; l
            FOR i = 1 TO UBOUND(OName)
                m$ = MID$(t$, l - LEN(OName(i)), LEN(OName(i)))
                'IF OName(i) = "C_SI" THEN PRINT "CONVERT TO SINGLE", m$
                IF m$ = OName(i) THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
            NEXT
            'PRINT t$; l
            IF NOT good THEN e$ = "ERROR - Improper operations before (.": EXIT SUB
            l = l + 1
        END IF
    LOOP UNTIL l = 0
 
    'Check for bad operators after a ) bracket
    l = 0
    DO
        l = INSTR(l + 1, t$, ")")
        IF l AND l < LEN(t$) THEN
            good = 0
            FOR i = 1 TO UBOUND(oname)
                m$ = MID$(t$, l + 1, LEN(OName(i)))
                IF m$ = OName(i) THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI
            NEXT
            IF MID$(t$, l + 1, 1) = ")" THEN good = -1
            IF NOT good THEN e$ = "ERROR - Improper operations after ).": EXIT SUB
            l = l + 1
        END IF
    LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket
 
    'Turn all &H (hex) numbers into decimal values for the program to process properly
    l = 0
    DO
        l = INSTR(t$, "&H")
        IF l THEN
            E = l + 1: finished = 0
            DO
                E = E + 1
                comp$ = MID$(t$, E, 1)
                SELECT CASE comp$
                    CASE "0" TO "9", "A" TO "F" 'All is good, our next digit is a number, continue to add to the hex$
                    CASE ELSE
                        good = 0
                        FOR i = 1 TO UBOUND(oname)
                            IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
                        NEXT
                        IF NOT good THEN e$ = "ERROR - Improper &H value. (" + comp$ + ")": EXIT SUB
                        E = E - 1
                        finished = -1
                END SELECT
            LOOP UNTIL finished OR E = LEN(t$)
            t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(VAL(MID$(t$, l, E - l + 1))))) + MID$(t$, E + 1)
        END IF
    LOOP UNTIL l = 0
 
    'Turn all &B (binary) numbers into decimal values for the program to process properly
    l = 0
    DO
        l = INSTR(t$, "&B")
        IF l THEN
            E = l + 1: finished = 0
            DO
                E = E + 1
                comp$ = MID$(t$, E, 1)
                SELECT CASE comp$
                    CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
                    CASE ELSE
                        good = 0
                        FOR i = 1 TO UBOUND(oname)
                            IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
                        NEXT
                        IF NOT good THEN e$ = "ERROR - Improper &B value. (" + comp$ + ")": EXIT SUB
                        E = E - 1
                        finished = -1
                END SELECT
            LOOP UNTIL finished OR E = LEN(t$)
            bin$ = MID$(t$, l + 2, E - l - 1)
            FOR i = 1 TO LEN(bin$)
                IF MID$(bin$, i, 1) = "1" THEN f = f + 2 ^ (LEN(bin$) - i)
            NEXT
            t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(f))) + MID$(t$, E + 1)
        END IF
    LOOP UNTIL l = 0
 
    'PRINT "ALMOST:"; t$
 
    t$ = N2S(t$)
    'PRINT "ALMOST2:"; t$
    VerifyString t$
    'PRINT "Out of PreParse: "; e$
    e$ = t$
END SUB
 
 
 
SUB VerifyString (t$)
    'ERROR CHECK for unrecognized operations
    j = 1
    DO
        comp$ = MID$(t$, j, 1)
        SELECT CASE comp$
            CASE "0" TO "9", ".", "(", ")", ",": j = j + 1
            CASE ELSE
                good = 0
                FOR i = 1 TO UBOUND(OName)
                    IF MID$(t$, j, LEN(OName(i))) = OName(i) THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
                NEXT
                IF NOT good THEN t$ = "ERROR - Bad Operational value. (" + comp$ + ")": EXIT SUB
                j = j + LEN(OName(i))
        END SELECT
    LOOP UNTIL j > LEN(t$)
END SUB
 
FUNCTION N2S$ (EXP$) 'scientific Notation to String
 
    'PRINT "Before notation:"; exp$
 
    t$ = LTRIM$(RTRIM$(EXP$))
    IF LEFT$(t$, 1) = "-" OR LEFT$(t$, 1) = "N" THEN sign$ = "-": t$ = MID$(t$, 2)
 
    dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
    ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
    check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
    IF check1 < 1 OR check1 > 1 THEN N2S = EXP$: EXIT SUB 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
 
    SELECT CASE l 'l now tells us where the SN starts at.
        CASE IS < dp: l = dp
        CASE IS < dm: l = dm
        CASE IS < ep: l = ep
        CASE IS < em: l = em
    END SELECT
 
    l$ = LEFT$(t$, l - 1) 'The left of the SN
    r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
 
 
    IF INSTR(l$, ".") THEN 'Location of the decimal, if any
        IF r&& > 0 THEN
            r&& = r&& - LEN(l$) + 2
        ELSE
            r&& = r&& + 1
        END IF
        l$ = LEFT$(l$, 1) + MID$(l$, 3)
    END IF
 
    SELECT CASE r&&
        CASE 0 'what the heck? We solved it already?
            'l$ = l$
        CASE IS < 0
            FOR i = 1 TO -r&&
                l$ = "0" + l$
            NEXT
            l$ = "0." + l$
        CASE ELSE
            FOR i = 1 TO r&&
                l$ = l$ + "0"
            NEXT
    END SELECT
 
    N2S$ = sign$ + l$
    'PRINT "After notation:"; N2S$
END SUB
 

Now, I know there's generally easier and shorter ways to write a calculator than this one, but this is making use of some pretty complex libraries of mine, such as the math evaluator. A better way to think of this program would be:

Code: QB64: [Select]

'$INCLUDE:'Math.BI'
'$INCLUDE:'Virtual Keyboard.BI'
 
SCREEN _NEWIMAGE(640, 480, 32)
_CONTROLCHR OFF
 
DIM My_Keyboard(4) AS STRING
My_Keyboard(0) = "^/*-"
My_Keyboard(1) = "789+"
My_Keyboard(2) = "456" + CHR$(0) + "27,End" + CHR$(0)
My_Keyboard(3) = "123" + CHR$(0) + "8,Del" + CHR$(0)
My_Keyboard(4) = "0." + CHR$(0) + "13,Enter" + CHR$(0)
 
 
Numpad = Create_KB(My_Keyboard(), 16, 30, 30)
 
ypos = 1
DO
    Display_KB Numpad, 250, 150, 1
    WHILE _MOUSEINPUT: WEND 'must update mouse buffer before reading virtual keyboard
    k = check_KB(Numpad)
 
    SELECT CASE k
        CASE 8
            out$ = LEFT$(out$, LEN(out$) - 1)
            _DELAY .2
        CASE 13
            LOCATE ypos, 1: PRINT out$; " = "; Evaluate_Expression(out$)
            out$ = ""
            ypos = ypos + 1
            _DELAY .2
        CASE 27
            SYSTEM
        CASE IS <> 0
            out$ = out$ + CHR$(k)
            _DELAY .2
    END SELECT
    LOCATE ypos, 1: PRINT out$; " "; answer$
    answer$ = ""
 
    _DISPLAY
    _LIMIT 30
LOOP UNTIL _KEYHIT
SYSTEM
 
'$INCLUDE:'Virtual Keyboard.BM'
'$INCLUDE:'Math.BM'

Now looking at it like that, it suddenly became a whole lot less complicated, as the majority of our code is actually from the libraries which we'd make use of.

Not terribly shabby, if I do say so myself!

SMcNeill · « **Reply #2 on:** February 05, 2021, 01:40:26 am »

And a few images, for the folks who are curious, but too lazy to test things out themselves:

SMcNeill · « **Reply #3 on:** February 05, 2021, 11:58:41 am »

And here's my on-screen keyboard jazzed up a bit with the new button routine which I shared in a different post.

Code: QB64: [Select]

TYPE Keyboard_Internal_Type
    AS LONG In_Use, Is_Hidden, Handle, Hardware_Handle, Xoffset, Yoffset, Xsize, Ysize
END TYPE
DIM SHARED Virtual_KB(0 TO 10) AS Keyboard_Internal_Type
DIM SHARED Keyboard_Values(0 TO 10, 0 TO 10, 0 TO 255) AS LONG '11 keyboards of up to 11 rows of 256 keys
 
SCREEN _NEWIMAGE(800, 600, 32)
_CONTROLCHR OFF
 
DIM My_Keyboard(5) AS STRING
My_Keyboard(0) = CHR$(0) + "27,ESC" + STRING$(2,0) + "15104,F1" + STRING$(2,0) + "15360,F2" + _
    STRING$(2,0) + "15616,F3" + STRING$(2,0) + "15872,F4" + STRING$(2,0) + "16128,F5" + _
    STRING$(2,0) + "16384,F6" + STRING$(2,0) + "16640,F7" + STRING$(2,0) + "16896,F8" + _
    STRING$(2,0) + "17152,F9" + STRING$(2,0) + "17408,F10" + STRING$(2,0) + "34048,F11" + _
    STRING$(2,0) + "34304,F12" + CHR$(0)
My_Keyboard(1) = "`1234567890-=" + CHR$(0) + "19200,BKSP" + CHR$(0)
My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "QWERTYUIOP[]\"
My_Keyboard(3) = CHR$(0) + "100301,KB2" + CHR$(0) + "ASDFGHJKL;'" + CHR$(0) + "13,ENTER" + CHR$(0)
My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "ZXCVBNM,./" + CHR$(0) + "100303,SHIFT" + CHR$(0)
My_Keyboard(5) = CHR$(0) + "100306,CTRL" + STRING$(2,0) + "0,WIN" + STRING$(2,0) + "100308,ALT" + _
    STRING$(2,0) + "32,SPACE" + STRING$(2,0) + "100307,ALT" + STRING$(2,0) + "0,WIN" + STRING$(2,0) + "0,MENU" + _
    STRING$(2,0) + "100305,CTRL" +  CHR$(0)
 
font = _LOADFONT("Courbd.ttf", 14, "monospace")
FullsizeKB1 = Create_KB(My_Keyboard(), font, 55, 35)
 
 
 
My_Keyboard(1) = "~!@#$%^&*()_+" + CHR$(0) + "19200,BKSP" + CHR$(0)
My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "qwertyuiop{}|"
My_Keyboard(3) = CHR$(0) + "100301,KB1" + CHR$(0) + "asdfghjkl:" + CHR$(34) + CHR$(0) + "13,ENTER" + CHR$(0)
My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "zxcvbnm<>?" + CHR$(0) + "100303,SHIFT" + CHR$(0)
FullsizeKB2 = Create_KB(My_Keyboard(), font, 55, 35)
 
 
Keyboard_In_Use = FullsizeKB1
DO
    Display_KB Keyboard_In_Use, 10, 100, 1
    WHILE _MOUSEINPUT: WEND 'must update mouse buffer before reading virtual keyboard
    k = check_KB(Keyboard_In_Use)
    SELECT CASE k
        CASE 100301 'swap keyboards, rather than having a CAPS LOCK key
            IF Keyboard_In_Use = FullsizeKB1 THEN
                Keyboard_In_Use = FullsizeKB2
            ELSE
                Keyboard_In_Use = FullsizeKB1
            END IF
            _DELAY .2
        CASE IS <> 0
            PRINT k;
            IF k > 0 AND k < 255 THEN PRINT CHR$(k);
            PRINT ,
            _DELAY .2 'delay is so we don't spam clicks from mousedown events
    END SELECT
 
    _DISPLAY
    _LIMIT 30
LOOP UNTIL _KEYHIT
SYSTEM
 
FUNCTION check_KB& (Which)
    STATIC AS INTEGER x, y 'so as to not interfer with any global variables
    x = _MOUSEX - Virtual_KB(Which).Xoffset
    y = _MOUSEY - Virtual_KB(Which).Yoffset
 
    yon = x \ Virtual_KB(Which).Xsize
    xon = y \ Virtual_KB(Which).Ysize
    IF xon >= 0 AND xon <= 10 AND yon >= 0 AND yon <= 255 THEN
        IF _MOUSEBUTTON(1) THEN check_KB& = Keyboard_Values(Which, xon, yon)
    END IF
 
END FUNCTION
 
 
 
SUB Display_KB (Which AS INTEGER, Xwhere AS INTEGER, Ywhere AS INTEGER, style AS INTEGER)
    IF Virtual_KB(Which).In_Use = 0 THEN EXIT SUB
    IF Virtual_KB(Which).Is_Hidden THEN EXIT SUB
    Virtual_KB(Which).Xoffset = Xwhere
    Virtual_KB(Which).Yoffset = Ywhere
    IF style THEN 'we want a hardware image
        _PUTIMAGE (Xwhere, Ywhere), Virtual_KB(Which).Hardware_Handle
    ELSE
        _PUTIMAGE (Xwhere, Ywhere), Virtual_KB(Which).Handle
    END IF
END SUB
 
FUNCTION Create_KB (KB() AS STRING, Font AS LONG, Xsize AS LONG, Ysize AS LONG)
    STATIC AS LONG D, S 'stored as static so as to not interfer with any globals of the same name.
    D = _DEST: S = _SOURCE
 
    FOR i = 0 TO 10
        IF Virtual_KB(i).In_Use = 0 THEN
            Virtual_KB(i).In_Use = -1
            Virtual_KB(i).Xsize = Xsize
            Virtual_KB(i).Ysize = Ysize
 
            Create_KB = i
            EXIT FOR
        END IF
    NEXT
    IF i = 11 THEN
        CLS
        PRINT "Too many keyboards registered in use at the same time!  Can not create a new one."
        END
    END IF
    This_KB = i
 
    keyboard_image = _NEWIMAGE(4096, 4096, 32)
    _DEST keyboard_image: _SOURCE keyboard_image
    _FONT Font
 
    'now build the keyboard
    FOR i = 0 TO UBOUND(KB)
        top = i * Ysize
        count = 0
        FOR j = 1 TO LEN(KB(i))
            left = (count) * Xsize
            count = count + 1
            repeat = 1
            c = ASC(KB(i), j): out$ = ""
            IF c = 0 THEN
                'look for the comma
                comma_position = INSTR(j, KB(i), ",")
                IF comma_position THEN 'we have a value, label
                    value$ = MID$(KB(i), j + 1, comma_position - j - 1)
                    c = VAL(value$)
                    j = comma_position + 1
                ELSE 'cry loud and hard so we can sort it out while programming our keyboard layout
                    scream_and_die:
                    SLEEP
                    CLS
                    PRINT "You have an invalid keyboard layout!"
                    END
                END IF
 
                end_position = INSTR(j, KB(i), CHR$(0))
                IF end_position THEN 'we're extracting the label
                    out$ = MID$(KB(i), j, end_position - j)
                    repeat = ASC(out$, LEN(out$))
                    IF repeat > 0 AND repeat < 9 THEN
                        out$ = LEFT$(out$, LEN(out$) - 1)
                    ELSE
                        repeat = 1
                    END IF
                    j = end_position
                ELSE
                    GOTO scream_and_die
                END IF
            END IF
            '           LINE (left, top)-STEP(Xsize * repeat, Ysize), -1, B
 
            IF left + Xsize * repeat > max_width THEN max_width = left + Xsize * repeat
            IF top + Ysize > max_height THEN max_height = top + Ysize
            IF c < 256 AND out$ = "" THEN out$ = CHR$(c)
            '            _PRINTSTRING (left + (Xsize * repeat - _FONTWIDTH * LEN(out$)) / 2, top + (Ysize - _FONTHEIGHT) / 2), out$
            Button left, top, Xsize * repeat, Ysize, 50, 50, 50, 10, 10, 10, out$
            DO UNTIL repeat = 1
                Keyboard_Values(This_KB, i, count - 1) = c
                count = count + 1
                repeat = repeat - 1
            LOOP
            Keyboard_Values(This_KB, i, count - 1) = c
        NEXT
    NEXT
 
    'resize to proper size to put upon the screen
    Virtual_KB(This_KB).Handle = _NEWIMAGE(max_width + 1, max_height + 1, 32)
    _PUTIMAGE (0, 0)-(max_width, max_height), keyboard_image, Virtual_KB(This_KB).Handle, (0, 0)-(max_width, max_height)
    Virtual_KB(This_KB).Hardware_Handle = _COPYIMAGE(Virtual_KB(This_KB).Handle, 33)
    _FREEIMAGE keyboard_image
 
    clean_exit:
    _SOURCE S: _DEST D
END FUNCTION
 
SUB Button (x, y, wide, tall, r, g, b, rc, gc, bc, caption$)
    DIM AS _UNSIGNED LONG k, d, bg
    d = _DEFAULTCOLOR
    bg = _BACKGROUNDCOLOR
    FOR i = 0 TO 10
        rm = rm + rc
        gm = gm + gc
        bm = bm + bc
        k = _RGB32(r + rm, g + gm, b + bm)
        LINE (x + i, y + i)-(x + wide - i, y + tall - i), k, B
    NEXT
    PAINT (x + i, y + i), k
    COLOR _RGB32(r, g, b), 0
    COLOR -1, 0
    _PRINTSTRING (x + (wide - _PRINTWIDTH(caption$)) / 2, y + (tall - _FONTHEIGHT) / 2 + 2), caption$
 
    COLOR d, bg
END SUB
 

SpriggsySpriggs · « **Reply #4 on:** February 05, 2021, 12:11:52 pm »

OOOOH I like how that looks.

STxAxTIC · « **Reply #5 on:** February 05, 2021, 12:15:15 pm »

Agreed. Getting better. Keep going for realism!

Dav · « **Reply #6 on:** February 05, 2021, 12:31:50 pm »

Looking good!

- Dav

SMcNeill · « **Reply #7 on:** February 05, 2021, 12:33:28 pm »

Might need a slightly smaller font, or a slightly larger set of keys. The "MENU" button is wider than the center of its button now that the shading is taking up a good bit of real estate.

(Or perhaps smaller levels of shading between keys, in this specific case? It may be the button routine which gets a little more tweaking here.)

SMcNeill · « **Reply #8 on:** February 06, 2021, 02:13:56 am »

Okies guys, if you love me at all, check this out! This has to be one of my proudest little accomplishments to date, I think. I *REALLY* love the way this is looking and performing on my machine for me!

Code: QB64: [Select]

TYPE Keyboard_Internal_Type
    AS LONG In_Use, Is_Hidden, Handle, Hardware_Handle, Xoffset, Yoffset, Xsize, Ysize, Font
END TYPE
TYPE Keyboard_Value_Type
    AS LONG Value, State
    AS STRING Caption
END TYPE
DIM SHARED Virtual_KB(0 TO 10) AS Keyboard_Internal_Type
DIM SHARED Keyboard_Values(0 TO 10, 0 TO 10, 0 TO 255) AS Keyboard_Value_Type '11 keyboards of up to 11 rows of 256 keys
TYPE Button_Report
    Time AS _FLOAT
    Value AS LONG
    caption AS STRING
END TYPE
DIM SHARED Buttons(10) AS Button_Report
CONST Repeat_Speed = 0.1
 
 
SCREEN _NEWIMAGE(800, 600, 32)
_CONTROLCHR OFF
 
DIM My_Keyboard(5) AS STRING
My_Keyboard(0) = CHR$(0) + "27,ESC" + STRING$(2,0) + "15104,F1" + STRING$(2,0) + "15360,F2" + _
    STRING$(2,0) + "15616,F3" + STRING$(2,0) + "15872,F4" + STRING$(2,0) + "16128,F5" + _
    STRING$(2,0) + "16384,F6" + STRING$(2,0) + "16640,F7" + STRING$(2,0) + "16896,F8" + _
    STRING$(2,0) + "17152,F9" + STRING$(2,0) + "17408,F10" + STRING$(2,0) + "34048,F11" + _
    STRING$(2,0) + "34304,F12" + CHR$(0)
My_Keyboard(1) = "`1234567890-=" + CHR$(0) + "19200,BKSP" + CHR$(0)
My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "QWERTYUIOP[]\"
My_Keyboard(3) = CHR$(0) + "100301,KB2" + CHR$(0) + "ASDFGHJKL;'" + CHR$(0) + "13,ENTER" + CHR$(0)
My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "ZXCVBNM,./" + CHR$(0) + "100303,SHIFT" + CHR$(0)
My_Keyboard(5) = CHR$(0) + "100306,CTRL" + STRING$(2,0) + "0,WIN" + STRING$(2,0) + "100308,ALT" + _
    STRING$(2,0) + "32,SPACE" + STRING$(2,0) + "100307,ALT" + STRING$(2,0) + "0,WIN" + STRING$(2,0) + "0,MENU" + _
    STRING$(2,0) + "100305,CTRL" +  CHR$(0)
 
font = _LOADFONT("Courbd.ttf", 14, "monospace")
FullsizeKB1 = Create_KB(My_Keyboard(), font, 55, 35)
 
My_Keyboard(1) = "~!@#$%^&*()_+" + CHR$(0) + "19200,BKSP" + CHR$(0)
My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "qwertyuiop{}|"
My_Keyboard(3) = CHR$(0) + "100301,KB1" + CHR$(0) + "asdfghjkl:" + CHR$(34) + CHR$(0) + "13,ENTER" + CHR$(0)
My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "zxcvbnm<>?" + CHR$(0) + "100303,SHIFT" + CHR$(0)
FullsizeKB2 = Create_KB(My_Keyboard(), font, 55, 35)
 
 
Keyboard_In_Use = FullsizeKB1
DO
    Display_KB Keyboard_In_Use, 10, 100, 0
    WHILE _MOUSEINPUT: WEND 'must update mouse buffer before reading virtual keyboard
    k = check_KB(Keyboard_In_Use)
    SELECT CASE k
        CASE 100301 'swap keyboards, rather than having a CAPS LOCK key
            IF Keyboard_In_Use = FullsizeKB1 THEN
                Keyboard_In_Use = FullsizeKB2
            ELSE
                Keyboard_In_Use = FullsizeKB1
            END IF
        CASE IS <> 0
            PRINT k;
            IF k > 0 AND k < 255 THEN PRINT CHR$(k);
            PRINT ,
    END SELECT
 
    _DISPLAY
    _LIMIT 30
LOOP UNTIL _KEYHIT
SYSTEM
 
FUNCTION check_KB& (Which)
    STATIC AS INTEGER x, y 'so as to not interfer with any global variables
 
 
    x = _MOUSEX - Virtual_KB(Which).Xoffset
    y = _MOUSEY - Virtual_KB(Which).Yoffset
 
    xsize = Virtual_KB(Which).Xsize
    ysize = Virtual_KB(Which).Ysize
    yon = x \ Virtual_KB(Which).Xsize
    xon = y \ Virtual_KB(Which).Ysize
    first_zero = 0
    IF xon >= 0 AND xon <= 10 AND yon >= 0 AND yon <= 255 THEN
        IF _MOUSEBUTTON(1) THEN
            IF Keyboard_Values(Which, xon, yon).Value THEN
                FOR i = 0 TO 10
                    IF Buttons(i).Value = Keyboard_Values(Which, xon, yon).Value THEN GOTO safe_exit:
                    IF Buttons(i).Value = 0 AND first_zero = 0 THEN first_zero = i
                NEXT
                IF first_zero = 0 THEN GOTO safe_exit:
                Buttons(first_zero).Value = Keyboard_Values(Which, xon, yon).Value
                Buttons(first_zero).Time = ExtendedTimer + Repeat_Speed
                Buttons(first_zero).caption = Keyboard_Values(Which, xon, yon).Caption
 
                check_KB& = Keyboard_Values(Which, xon, yon).Value
                firston = 0
                out$ = Keyboard_Values(Which, xon, yon).Caption
                FOR z = 0 TO 255
                    IF Keyboard_Values(Which, xon, z).Caption = out$ THEN
                        Keyboard_Values(Which, xon, z).State = -1 'down
                        IF firston = 0 THEN firston = z
                        Repeat = ASC(out$, LEN(out$))
                        IF Repeat < 1 OR Repeat > 9 THEN Repeat = 1
                    END IF
                NEXT
                IF firston THEN
                    d = _DEST
                    _DEST Virtual_KB(Which).Handle
                    IF Repeat > 1 THEN out$ = LEFT$(out$, LEN(out$) - 1)
                    Button firston * xsize, xon * ysize, xsize * Repeat, ysize, 150, 150, 150, -5, -5, -5, out$
                    Virtual_KB(Which).Hardware_Handle = _COPYIMAGE(Virtual_KB(Which).Handle, 33)
                    _DEST d
                END IF
 
            END IF
        END IF
    END IF
    safe_exit:
    FOR i = 0 TO 10
        IF Buttons(i).Value <> 0 AND Buttons(i).Time <> 0 AND Buttons(i).caption <> "" THEN
            IF ExtendedTimer > Buttons(i).Time THEN
                'Refresh_KB = -1
                out$ = Buttons(i).caption
                firston = 0
                FOR j = 0 TO 10
                    FOR z = 0 TO 255
                        IF Keyboard_Values(Which, j, z).Value = Buttons(i).Value OR Keyboard_Values(Which, j, z).Caption = out$ THEN
                            Keyboard_Values(Which, j, z).State = 0 'up
                            IF firston = 0 THEN firston = z
                            Repeat = ASC(out$, LEN(out$))
                            IF Repeat < 1 OR Repeat > 9 THEN Repeat = 1
                        END IF
                    NEXT
                NEXT
                Buttons(i).Value = 0
                Buttons(i).Time = 0
                Buttons(i).caption = ""
 
                IF firston THEN
                    d = _DEST
                    _DEST Virtual_KB(Which).Handle
                    IF Repeat > 1 THEN out$ = LEFT$(out$, LEN(out$) - 1)
                    Button firston * xsize, xon * ysize, xsize * Repeat, ysize, 50, 50, 50, 10, 10, 10, out$
                    Virtual_KB(Which).Hardware_Handle = _COPYIMAGE(Virtual_KB(Which).Handle, 33)
                    _DEST d
                END IF
            END IF
        END IF
    NEXT
 
END FUNCTION
 
 
 
SUB Display_KB (Which AS INTEGER, Xwhere AS INTEGER, Ywhere AS INTEGER, style AS INTEGER)
    IF Virtual_KB(Which).In_Use = 0 THEN EXIT SUB
    IF Virtual_KB(Which).Is_Hidden THEN EXIT SUB
    Virtual_KB(Which).Xoffset = Xwhere
    Virtual_KB(Which).Yoffset = Ywhere
    IF style THEN 'we want a hardware image
        _PUTIMAGE (Xwhere, Ywhere), Virtual_KB(Which).Hardware_Handle
    ELSE
        _PUTIMAGE (Xwhere, Ywhere), Virtual_KB(Which).Handle
    END IF
END SUB
 
FUNCTION Create_KB (KB() AS STRING, Font AS LONG, Xsize AS LONG, Ysize AS LONG)
    STATIC AS LONG D, S 'stored as static so as to not interfer with any globals of the same name.
    D = _DEST: S = _SOURCE
 
    FOR i = 0 TO 10
        IF Virtual_KB(i).In_Use = 0 THEN
            Virtual_KB(i).In_Use = -1
            Virtual_KB(i).Xsize = Xsize
            Virtual_KB(i).Ysize = Ysize
            Virtual_KB(i).Font = Font
            Create_KB = i
            EXIT FOR
        END IF
    NEXT
    IF i = 11 THEN
        CLS
        PRINT "Too many keyboards registered in use at the same time!  Can not create a new one."
        END
    END IF
    This_KB = i
 
    keyboard_image = _NEWIMAGE(4096, 4096, 32)
    _DEST keyboard_image: _SOURCE keyboard_image
    _FONT Font
 
    'now build the keyboard
    FOR i = 0 TO UBOUND(KB)
        top = i * Ysize
        count = 0
        FOR j = 1 TO LEN(KB(i))
            left = (count) * Xsize
            count = count + 1
            repeat = 1
            c = ASC(KB(i), j): out$ = ""
            IF c = 0 THEN
                'look for the comma
                comma_position = INSTR(j, KB(i), ",")
                IF comma_position THEN 'we have a value, label
                    value$ = MID$(KB(i), j + 1, comma_position - j - 1)
                    c = VAL(value$)
 
                    j = comma_position + 1
                ELSE 'cry loud and hard so we can sort it out while programming our keyboard layout
                    scream_and_die:
                    SLEEP
                    CLS
                    PRINT "You have an invalid keyboard layout!"
                    END
                END IF
 
                end_position = INSTR(j, KB(i), CHR$(0))
                IF end_position THEN 'we're extracting the label
                    out$ = MID$(KB(i), j, end_position - j)
                    repeat = ASC(out$, LEN(out$))
                    IF repeat > 0 AND repeat < 9 THEN
                        r$ = CHR$(repeat)
                        out$ = LEFT$(out$, LEN(out$) - 1)
                    ELSE
                        repeat = 1
                    END IF
                    Keyboard_Values(This_KB, i, count - 1).Caption = out$ + r$
                    j = end_position
                ELSE
                    GOTO scream_and_die
                END IF
            END IF
 
 
            IF left + Xsize * repeat > max_width THEN max_width = left + Xsize * repeat
            IF top + Ysize > max_height THEN max_height = top + Ysize
            IF c < 256 AND out$ = "" THEN out$ = CHR$(c)
 
            Keyboard_Values(This_KB, i, count - 1).Caption = out$ + "r"
            Button left, top, Xsize * repeat, Ysize, 50, 50, 50, 10, 10, 10, out$
            DO UNTIL repeat = 1
                Keyboard_Values(This_KB, i, count - 1).Value = c
                Keyboard_Values(This_KB, i, count - 1).Caption = out$ + r$
                count = count + 1
                repeat = repeat - 1
            LOOP
            Keyboard_Values(This_KB, i, count - 1).Value = c
            Keyboard_Values(This_KB, i, count - 1).Caption = out$ + r$
            r$ = ""
        NEXT
    NEXT
 
    'resize to proper size to put upon the screen
    Virtual_KB(This_KB).Handle = _NEWIMAGE(max_width + 1, max_height + 1, 32)
    _PUTIMAGE (0, 0)-(max_width, max_height), keyboard_image, Virtual_KB(This_KB).Handle, (0, 0)-(max_width, max_height)
    Virtual_KB(This_KB).Hardware_Handle = _COPYIMAGE(Virtual_KB(This_KB).Handle, 33)
    _FREEIMAGE keyboard_image
 
    clean_exit:
    _SOURCE S: _DEST D
END FUNCTION
 
SUB Button (x, y, wide, tall, r, g, b, rc, gc, bc, caption$)
    DIM AS _UNSIGNED LONG k, d, bg
    d = _DEFAULTCOLOR
    bg = _BACKGROUNDCOLOR
 
    FOR i = 0 TO 8
        rm = rm + rc
        gm = gm + gc
        bm = bm + bc
        k = _RGB32(r + rm, g + gm, b + bm)
        LINE (x + i * .75, y + i)-(x + wide - i * .75, y + tall - i), k, B
    NEXT
    PAINT (x + i, y + i), k
    COLOR _RGB32(r, g, b), 0
    COLOR -1, 0
    _PRINTSTRING (x + (wide - _PRINTWIDTH(caption$)) / 2, y + (tall - _FONTHEIGHT) / 2 + 2), caption$
 
    COLOR d, bg
END SUB
 
FUNCTION ExtendedTimer##
    d$ = DATE$
    l = INSTR(d$, "-")
    l1 = INSTR(l + 1, d$, "-")
    m = VAL(LEFT$(d$, l))
    d = VAL(MID$(d$, l + 1))
    y = VAL(MID$(d$, l1 + 1)) - 1970
    FOR i = 1 TO m
        SELECT CASE i 'Add the number of days for each previous month passed
            CASE 1: d = d 'January doestn't have any carry over days.
            CASE 2, 4, 6, 8, 9, 11: d = d + 31
            CASE 3: d = d + 28
            CASE 5, 7, 10, 12: d = d + 30
        END SELECT
    NEXT
    FOR i = 1 TO y
        d = d + 365
    NEXT
    FOR i = 2 TO y STEP 4
        IF m > 2 THEN d = d + 1 'add an extra day for leap year every 4 years, starting in 1970
    NEXT
    d = d - 1 'for year 2000
    s~&& = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
    ExtendedTimer## = (s~&& + TIMER)
END FUNCTION
 

Repeat keys are slower on this than on a traditional keyboard (0.5 seconds), but that's on purpose since I figure folks are much slower moving and interacting with a mouse than they are with a physical keyboard.

This is getting close to being what I'd call a completed library. The one thing which I'm still wanting to add here is the ability to HOLD a key down, with a double click event. Usage would be to let someone double-click ALT, have it stay down, and then click T, to produce an ALT-T event with the virtual keyboard.

Test this out. Play around with it. Tell me how responsive (or sluggish) it acts on other systems. I'd love to hear back from you guys, after you've had a chance to give this a test run once. Let me know what you think about it, and if it's a virtual keyboard that you'd enjoy interacting with in the future. (I'm looking at plugging this into my game that I've been making since FOREVER ago, and the end goal is to have it interact with a cursor which you can move with your either a joystick, or a mouse.)

NOVARSEG · « **Reply #9 on:** February 06, 2021, 03:48:15 am »

more contrast on the keys

I get an error on line 2

SMcNeill · « **Reply #10 on:** February 06, 2021, 03:53:36 am »

Quote from: NOVARSEG on February 06, 2021, 03:48:15 am

more contrast on the keys

I get an error on line 2

You need the latest version of QB64 to compile it. We’re pushing for a new version (1.5), and I’m trying to help test things while working on my code.

NOVARSEG · « **Reply #11 on:** February 06, 2021, 04:05:21 am »

Steve

I like the calculator idea!

SMcNeill · « **Reply #12 on:** February 06, 2021, 10:15:19 am »

So this has been turned into a library type system, and I've returned the TYPEs to v1.4 and earlier compatibility.

Program looks like the following:

Code: QB64: [Select]

'$INCLUDE:'Keyboard Library.BI'
'$INCLUDE:'Virtual Keyboard.BI'
Repeat_Speed = 0.1 'Global variable in the Virtual Keyboard library which a user can change for repeat speed
 
 
SCREEN _NEWIMAGE(800, 600, 32)
_CONTROLCHR OFF
 
 
'CREATE YOUR CUSTOM KEYBOARD LAYOUT HERE
DIM My_Keyboard(5) AS STRING
My_Keyboard(0) = CHR$(0) + "27,ESC" + STRING$(2,0) + "15104,F1" + STRING$(2,0) + "15360,F2" + _
    STRING$(2,0) + "15616,F3" + STRING$(2,0) + "15872,F4" + STRING$(2,0) + "16128,F5" + _
    STRING$(2,0) + "16384,F6" + STRING$(2,0) + "16640,F7" + STRING$(2,0) + "16896,F8" + _
    STRING$(2,0) + "17152,F9" + STRING$(2,0) + "17408,F10" + STRING$(2,0) + "34048,F11" + _
    STRING$(2,0) + "34304,F12" + CHR$(0)
My_Keyboard(1) = "`1234567890-=" + CHR$(0) + "19200,BKSP" + CHR$(0)
My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "QWERTYUIOP[]\"
My_Keyboard(3) = CHR$(0) + "100301,KB2" + CHR$(0) + "ASDFGHJKL;'" + CHR$(0) + "13,ENTER" + CHR$(0)
My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "ZXCVBNM,./" + CHR$(0) + "100303,SHIFT" + CHR$(0)
My_Keyboard(5) = CHR$(0) + "100306,CTRL" + STRING$(2,0) + "100311,WIN" + STRING$(2,0) + "100308,ALT" + _
    STRING$(2,0) + "32,SPACE" + STRING$(2,0) + "100307,ALT" + STRING$(2,0) + "100312,WIN" + STRING$(2,0) + "100319,MENU" + _
    STRING$(2,0) + "100305,CTRL" +  CHR$(0)
 
font = _LOADFONT("Courbd.ttf", 14, "monospace") 'IF USED ON A KEYBOARD, DON'T FREE THIS FONT
'                                                IT GETS REUSED WHEN DRAWING KEYS UP/DOWN STATE
 
'     Honestly, I like the look with the standard font 16 here better, but I wanted to load a custom font
'     just so folks could see how to make use of it.
FullsizeKB1 = Create_KB(My_Keyboard(), font, 55, 35)
 
'     And here's where I'm redefining my keys to toggle for my second keyboard
My_Keyboard(1) = "~!@#$%^&*()_+" + CHR$(0) + "19200,BKSP" + CHR$(0)
My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "qwertyuiop{}|"
My_Keyboard(3) = CHR$(0) + "100301,KB1" + CHR$(0) + "asdfghjkl:" + CHR$(34) + CHR$(0) + "13,ENTER" + CHR$(0)
My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "zxcvbnm<>?" + CHR$(0) + "100303,SHIFT" + CHR$(0)
FullsizeKB2 = Create_KB(My_Keyboard(), font, 55, 35)
 
 
Keyboard_In_Use = FullsizeKB1 'Set the keyboard I'm currently using
DO
    Display_KB Keyboard_In_Use, 10, 100, 0
    WHILE _MOUSEINPUT: WEND 'must update mouse buffer before reading virtual keyboard
    k = KeyHit 'The library version which reads all the keys for us, not the qb64 _KEYHIT version
    '(ONLY FOR WINDOWS. LINUX/MAC USERS STILL GET THE SAME OLE BUGGY _KEYHIT FOR NOW.  SORRY.)
    IF k = 0 THEN k = check_KB(Keyboard_In_Use) 'this checks the virtual keyboard
    SELECT CASE k
        CASE 100301 'swap keyboards, rather than having a CAPS LOCK key
            IF Keyboard_In_Use = FullsizeKB1 THEN
                Keyboard_In_Use = FullsizeKB2
            ELSE
                Keyboard_In_Use = FullsizeKB1
            END IF
        CASE 1 TO 900000 '900001 are mouse buttons, which I don't want to print to the screen and add to any
            '             confusion.
            PRINT k;
            IF k > 0 AND k < 255 THEN PRINT CHR$(k);
            PRINT ,
    END SELECT
    _DISPLAY
    _LIMIT 30
LOOP UNTIL k = 27
SYSTEM
 
 
'$INCLUDE:'Keyboard Library.BM'
'$INCLUDE:'Virtual Keyboard.BM'
 

Library Files are below.

SMcNeill · « **Reply #13 on:** February 07, 2021, 07:15:58 am »

And now I think I can finally say that I have the core of this library worked out nicely for me.

Included in the 7z archive is now the compiled EXE for folks on windows to use, who may not be up to the latest moment with the development build and get compile errors.

We can now click on keys and get the codes back for those keys with VK_Keyhit. (Jazzy hard name to remember right? We want to get Keyhiy codes from our Virtual Keyboard... VK_Keyhit! Don't I have amazingly spectacular naming sense?)

If you hold a key down, it'll now repeat itself over and over for you. (Wish my dang phone would do that so I wouldn't have to tappy tap tappy tap on double letters and all!)

If you double click on a button, it'll now hold that button down forever more for you! (It won't spam you with VK_KeyHit codes, though. I took inspiration from how SHIFT and ALT act with _KEYHIT -- they only report the down and up event, but not the hold time.) If you want to check to see if a button is held down, or not, just use the VK_KeyDown command!!

We have both virtual keuhit events and virtual keydown events, so make use of both of them, if you're going to use the library. ;)

There's still a few things I want to play around with and tweak later, but the root of this library is now about done. I want to go in and tweak so we can highlight buttons, or give letters a little backlighting (like a LED backlit keyboard), as well as tweak the shadowing and such to make it more customizable -- but that's all cosmetic stuff. Unless unforeseen glitches pop up, the main part of this library is now up and functional -- and it plays quite nicely with the Extended Keyboard library of mine, so folks can custom map their own keyboards to whatever input they want in Windows. (Everywhere else, we just wrap around back to a standard _KEYHIT instead of the modified Keyhit. :P )

SMcNeill · « **Reply #14 on:** February 08, 2021, 02:59:39 am »

As far as I can tell, I'd call this done -- at least until other folks try it out and report any sort of errors or user requests with it. It's to the point now, that I'm willing to stick a 1.0 version label on the library, as everything appears to be working as intended with the tests I've been doing with it during development.

Here's a screenshot of two full-sized keyboards which we make with just a few quick lines of code:

Code: QB64: [Select]

'$INCLUDE:'Keyboard Library.BI'
'$INCLUDE:'Virtual Keyboard.BI'
Repeat_Speed = 0.2 'Global variable in the Virtual Keyboard library which a user can change for repeat speed
 
SCREEN _NEWIMAGE(800, 600, 32)
_CONTROLCHR OFF
 
'CREATE YOUR CUSTOM KEYBOARD LAYOUT HERE
DIM My_Keyboard(5) AS STRING
My_Keyboard(0) = CHR$(0) + "27,ESC" + STRING$(2,0) + "15104,F1" + STRING$(2,0) + "15360,F2" + _
    STRING$(2,0) + "15616,F3" + STRING$(2,0) + "15872,F4" + STRING$(2,0) + "16128,F5" + _
    STRING$(2,0) + "16384,F6" + STRING$(2,0) + "16640,F7" + STRING$(2,0) + "16896,F8" + _
    STRING$(2,0) + "17152,F9" + STRING$(2,0) + "17408,F10" + STRING$(2,0) + "34048,F11" + _
    STRING$(2,0) + "34304,F12" + CHR$(0)
My_Keyboard(1) = "`1234567890-=" + CHR$(0) + "19200,BKSP" + CHR$(0)
My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "QWERTYUIOP[]\"
My_Keyboard(3) = CHR$(0) + "100301,KB2" + CHR$(0) + "ASDFGHJKL;'" + CHR$(0) + "13,ENTER" + CHR$(0)
My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "ZXCVBNM,./" + CHR$(0) + "100303,SHIFT" + CHR$(0)
My_Keyboard(5) = CHR$(0) + "100306,CTRL" + STRING$(2,0) + "100311,WIN" + STRING$(2,0) + "100308,ALT" + _
    STRING$(2,0) + "32,SPACE" + STRING$(2,0) + "100307,ALT" + STRING$(2,0) + "100312,WIN" + STRING$(2,0) + "100319,MENU" + _
    STRING$(2,0) + "100305,CTRL" +  CHR$(0)
 
font = _LOADFONT("Courbd.ttf", 14, "monospace") 'IF USED ON BUTTONS, DON'T FREE THIS FONT AS IT GETS REUSED
 
'     Honestly, I like the look with the standard font 16 here better, but I wanted to load a custom font
'     just so folks could see how to make use of it.
 
'DEFINING MY BUTTON STYLES FOR SHADING AND EFFECT
Button_Style_Up = Register_Button(50, 50, 50, 150, 150, 150, 8, font, &HFFFFFF00, 0)
Button_Style_Down = Register_Button(150, 150, 150, 110, 110, 110, 8, font, &HFFFFFF00, 0)
FullsizeKB1 = Create_KB(My_Keyboard(), 55, 35, Button_Style_Up, Button_Style_Down)
 
Button_Style_Up = Register_Button(50, 50, 150, 150, 150, 250, 8, 16, &HFFFFFF00, 0)
Button_Style_Down = Register_Button(150, 150, 250, 110, 110, 210, 8, 16, &HFFFFFF00, 0)
My_Keyboard(3) = CHR$(0) + "100301,KB3" + CHR$(0) + "ASDFGHJKL;'" + CHR$(0) + "13,ENTER" + CHR$(0)
FullsizeKB2 = Create_KB(My_Keyboard(), 55, 35, Button_Style_Up, Button_Style_Down)
 
'     And here's where I'm redefining my keys to toggle for my second keyboard
My_Keyboard(1) = "~!@#$%^&*()_+" + CHR$(0) + "19200,BKSP" + CHR$(0)
My_Keyboard(2) = CHR$(0) + "9,TAB" + CHR$(0) + "qwertyuiop{}|"
My_Keyboard(3) = CHR$(0) + "100301,KB4" + CHR$(0) + "asdfghjkl:" + CHR$(34) + CHR$(0) + "13,ENTER" + CHR$(0)
My_Keyboard(4) = CHR$(0) + "100304,SHIFT" + CHR$(0) + "zxcvbnm<>?" + CHR$(0) + "100303,SHIFT" + CHR$(0)
 
Button_Style_Up = Register_Button(50, 50, 50, 150, 150, 150, 8, font, &HFFFFFF00, 0)
Button_Style_Down = Register_Button(150, 150, 150, 110, 110, 110, 8, font, &HFFFFFF00, 0)
FullsizeKB3 = Create_KB(My_Keyboard(), 55, 35, Button_Style_Up, Button_Style_Down)
 
Button_Style_Up = Register_Button(50, 50, 150, 150, 150, 250, 8, 16, &HFFFFFF00, 0)
Button_Style_Down = Register_Button(150, 150, 250, 110, 110, 210, 8, 16, &HFFFFFF00, 0)
My_Keyboard(3) = CHR$(0) + "100301,KB1" + CHR$(0) + "asdfghjkl:" + CHR$(34) + CHR$(0) + "13,ENTER" + CHR$(0)
FullsizeKB4 = Create_KB(My_Keyboard(), 55, 35, Button_Style_Up, Button_Style_Down)
 
Keyboard_In_Use = FullsizeKB1 'Set the keyboard I'm currently using
VIEW PRINT 1 TO 20
DO
    Display_KB Keyboard_In_Use, 10, 380, -1
    WHILE _MOUSEINPUT: WEND 'must update mouse buffer before reading virtual keyboard
    k = KeyHit 'The library version which reads all the keys for us, not the qb64 _KEYHIT version
    '(ONLY FOR WINDOWS. LINUX/MAC USERS STILL GET THE SAME OLE BUGGY _KEYHIT FOR NOW.  SORRY.)
    IF k = 0 OR k > 900000 THEN k = VK_Keyhit(Keyboard_In_Use) 'this checks the virtual keyboard
    IF VK_Keydown(32) THEN PRINT "Space held"; 'and here we can check for virtual keys being held down.
    SELECT CASE k
        CASE 100301 'swap keyboards, rather than having a CAPS LOCK key
            Keyboard_In_Use = (Keyboard_In_Use + 1) MOD 4
            _DELAY .2 'we need a delay here, as we haven't actually pressed any key on the new keyboard
            'so the keys aren't going to have a down timer to stop repeats.. We'd probably change keyboards
            'multiple times quickly without it, before we lifted our finger up off the mouse button.
        CASE 27
            SYSTEM
        CASE 1 TO 900000 '900001 are mouse buttons, which I don't want to print to the screen and add to any
            '             confusion.
            PRINT k;
            IF k > 0 AND k < 255 THEN PRINT CHR$(k);
            PRINT ,
    END SELECT
    _DISPLAY
    _LIMIT 30
LOOP
'$INCLUDE:'Keyboard Library.BM'
'$INCLUDE:'Virtual Keyboard.BM'

80 lines of code -- and most of those are comments, I think -- and here's what the keyboards look like that we display and interact with:

I haven't went into much description on how to make use of this library yet, but so far, nobody has really seemed that interested in it. If it's only going to be for my personal use, then there's no need for me to spend a lot of time writing up a nice tutorial for everyone else to use. Just a few little crib notes to refresh my own memory when I plug it into my projects should be more than enough for me, personally....

...So if anyone is interested in making use of this library, and can't figure it out even after studying over the demo code (personally, I think the layout, setup, and use is rather simple overall), speak up and ask questions. The more interest there is in this work, the more time I'll spend in making certain that I write up and clarify any common issues that others have utilizing it.

News:

Author Topic: Virtual Keyboard (Read 6440 times)

SMcNeill

Virtual Keyboard

SMcNeill

Re: Virtual Keyboard

SMcNeill

Re: Virtual Keyboard

SMcNeill

Re: Virtual Keyboard

SpriggsySpriggs

Re: Virtual Keyboard

STxAxTIC

Re: Virtual Keyboard

Dav

Re: Virtual Keyboard

SMcNeill

Re: Virtual Keyboard

SMcNeill

Re: Virtual Keyboard

NOVARSEG

Re: Virtual Keyboard

SMcNeill

Re: Virtual Keyboard

NOVARSEG

Re: Virtual Keyboard

SMcNeill

Re: Virtual Keyboard

SMcNeill

Re: Virtual Keyboard

SMcNeill

Re: Virtual Keyboard