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