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