keyhit functions

[James D Jarvis]

Just some functions and subs I worked up exploring how to use the _keyhit command. All pretty simple but as I've been an inkey$ user for year it's new to me.  There's a super simple parser for using a comma separated list of options as input selection. The program is dull, the routines much more useful.

Code: (Select All)

'keyhit functions
'by James D. Jarvis
'just playing about with the _keyhit command and sharing
'I found waiting for a key release got results I like more than a keypress
'also has simple parser to break a comma separated list into an entry list for selection
'$dynamic
Dim Shared tlist$(0)
Print "Waiting for any key to be pressed and released"
Do
    _Limit 1000
    kyp = waitup

Loop Until kyp <> 0
kyp = 0
Color 15
Print "Get key pressed (press ESC to move on)"
Do
    _Limit 1000
    kyp = getkey
    If Abs(kyp) > 0 And Abs(kyp) < 256 Then Print Chr$(Abs(kyp))
Loop Until kyp = 27
kyp = 0
Color 15
Print "Waiting for Q to be pressed and released"
Do
    _Limit 1000
    kyp = waitfor("Q")

Loop Until kyp <> 0
kyp = 0
Color 15
Print "Gonna keep counting until esc key is pressed and released"
x = 0
Do
    _Limit 20
    x = x + 1
    Print x;
    kyp = getkeyrelease
Loop Until kyp = -27

Print "Return the character pressed"
Do
    k$ = anykey$
Loop Until k$ <> ""
Print k$
Print "Press X,Y or Z (upper or lower case)"
kk$ = pickkey$("XYZxyz")
Print "you picked "; kk$
Print "Press any key"
Do
    _Limit 1000
    kyp = waitup

Loop Until kyp <> 0
Cls
Print "TAB to selection and press Enter to select"
nlist$ = "1,2,3,4,5,6,7,8,9,10"
build_tablist nlist$
tp1$ = tablistpick$(2, 2)
Locate 1, 15
Print "You selected #"; tp1$
'Cls
Locate 1, 1
Print "TAB to selection and press Enter to select"
nlist$ = "a,bb,ccc,dddd,eee,ff,g"
build_tablist nlist$

tp2$ = tablistpick$(12, 2)
Print "Selected "; tp2$

nlist$ = "I,II,III,IV,V"
build_tablist nlist$

tp3$ = tablistpick$(25, 2)
Print "Selected "; tp3$





Sub build_tablist (text$)
    baselist$ = text$ + ","
    For cc = 1 To Len(baselist$)
        If Mid$(baselist$, cc, 1) = "," Then
            ccount = ccount + 1
        End If
    Next cc
    Dim comma(ccount)
    ReDim tlist$(ccount)
    cid = 0
    For cc = 1 To Len(baselist$)
        If Mid$(baselist$, cc, 1) = "," Then
            cid = cid + 1
            comma(cid) = cc
        End If
    Next cc
    comma(0) = 0
    For c = 1 To ccount
        ' Print Mid$(baselist$, comma(c - 1) + 1, comma(c) - comma(c - 1) - 1)
        tlist$(c) = Mid$(baselist$, comma(c - 1) + 1, comma(c) - comma(c - 1) - 1)
    Next c

End Sub

Function getkey
    x = _KeyHit
    getkey = x
End Function

Function getkeyrelease
    x = _KeyHit
    If x > 0 Then x = 0 'returns 0 unless a key was released
    getkeyrelease = x
End Function


Function anykey$
    x = _KeyHit
    If x < 0 Then x = -x
    If x > 256 Then x = x \ 256

    If x > 0 Then
        anykey$ = Chr$(x)
    Else
        anykey$ = ""
    End If
End Function
Function pickkey$ (list$)
    pickflag = 0
    Do
        x = _KeyHit
        x = -x
        If x > 0 And x < 256 Then
            A$ = Chr$(x)
            If InStr(list$, A$) Then pickflag = 1
            pickkey$ = A$
        End If
    Loop Until pickflag = 1
End Function


Function waitfor (kk$)
    Do
        x = _KeyHit
        x1 = x
        If Abs(x) > 256 Then
            x1 = x1 \ 256
        End If
    Loop Until x < 0 And Abs(x1) = Asc(kk$)
    waitfor = x
End Function


Function waitup
    Do
        x = _KeyHit
    Loop Until x < 0
    waitup = x
End Function

Function tablistpick$ (xx, yy)
    choicelimit = UBound(tlist$)

    choice = 0
    For y = 1 To choicelimit
        Locate yy + y, xx + 1
        Print tlist$(y)
    Next y
    Do
        _Limit 30
        kk = getkeyrelease
        kk = -kk
        If kk = 9 Or kk = 20480 Then
            newchoice = choice + 1
        Else
            newchoice = choice
        End If
        If kk = 18432 Then newchoice = choice - 1
        If newchoice < 1 Then newchoice = choicelimit
        If newchoice > choicelimit Then newchoice = 1
        If kk <> 0 And newchoice <> choice Then
            choice = newchoice
            For y = 1 To choicelimit
                Locate yy + y, xx
                Print " "; tlist$(y); "  "
            Next y
            Locate yy + choice, xx
            Print "["; tlist$(choice); "]"
            kk = 0
        End If
    Loop Until kk = 13
    Locate yy + y + 11, xx + 1
    tablistpick$ = tlist$(choice)
End Function

[SMcNeill]

One thing you might want to watch out for is super-high CPU usage loops.  For example:

Code: (Select All)

Function waitup
    Do
        x = _KeyHit
    Loop Until x < 0
    waitup = x
End Function

Written as the above, that code is going to use as much CPU power as it possibly can, and it's going to make the fans on your PC scream like an airplane engine...

Be user friendly and always remember to add a _LIMIT or a _DELAY to such loops so that your program will play nice with the OS and not try to hog resources which it doesn't need.  Example:

Code: (Select All)

Function waitup
    Do
        x = _KeyHit
        _DELAY .05 '1/20th of a second pause between loops
    Loop Until x < 0
    waitup = x
End Function

It'll keep CPU usage down, and you'll never notice a change in your program's usage at all. 

[James D Jarvis]

I used _limit in the main input loops but I did seem to not use it in many of the loops inside the subs and functions, thanks for the pointer.