Another Keyboard Function

[eoredson]

Hi,

I know keyboard programs have been posted 100 times but here is another one:

The reason why this one is interesting because it uses memory and bios calls to trap
shiftkeys and lockkeys.. Also traps ctrl-break..

Code: (Select All)

Rem checks memory for shiftkey and lockkeys.
Const True = -1: Const False = 0: Const nul = ""
Dim Shared Flag As Integer, Break As Integer
Color 14
Print "Press any key or <esc> to exit:"
Color 15
Var = _Exit
On Timer(1) GoSub Trap
Timer On
Do
  X$ = Inkey2$
  If Len(X$) Then
      If X$ = Chr$(27) Then Exit Do
      If X$ = "shift" Then
        Color 14
        Print "ShiftKey: ";
        Print StoreShift$
      Else
        Color 15
        Print "Key: "; Asc(Right$(X$, 1))
      End If
      Color 14
      Print "Press any key or <esc> to exit:"
      Color 15
  End If
Loop
Timer Off
Color 7
End

Trap:
Var = _Exit
If Var Then
  Break = -1
  Color 12
  Print "break"
End If
Return

Function StoreShift$
  Var$ = ""
  If (Flag And 1) = 1 Then ' right shift.
      Var$ = Var$ + "right "
  End If
  If (Flag And 2) = 2 Then ' left shift.
      Var$ = Var$ + "left "
  End If
  If (Flag And 4) = 4 Then ' either ctrl.
      Var$ = Var$ + "ctrl "
  End If
  If (Flag And 8) = 8 Then ' either alt.
      Var$ = Var$ + "alt"
  End If
  StoreShift$ = Var$
End Function

' returns -1 if shiftkey pressed.
Function GetShiftState
  ' get shift state.
  Def Seg = &H40
  ShiftFlag = Peek(&H17)
  Def Seg

  ' store shift state.
  LeftShift = ShiftFlag And 1 ' left shift.
  RightShift = ShiftFlag And 2 ' right shift.
  CtrlShift = ShiftFlag And 4 ' either ctrl.
  AltShift = ShiftFlag And 8 ' either alt.

  ' return shiftkey pressed.
  If LeftShift Or RightShift Or CtrlShift Or AltShift Then
      GetShiftState = ShiftFlag
  Else
      GetShiftState = False
  End If
End Function

' reset shiftkey state.
Function SetShiftState
  Def Seg = &H40
  Poke &H17, 0
  Def Seg
  SetShiftState = True
End Function

' custom inkey$ function with shiftkey.
Function Inkey2$
  Do
      x = GetLockState
      _Limit 50
      x$ = InKey$
      If Len(x$) Then
        Inkey2$ = x$
        Exit Function
      End If

      x = GetShiftState
      If x Then
        Flag = x
        x = SetShiftState
        Inkey2$ = "shift"
        Exit Function
      End If
  Loop
End Function

Function GetLockState
  X = CsrLin: Y = Pos(0)
  Locate 25, 1, 1
  Def Seg = 0 ' BIOS area
  port = Peek(1047)
  If (port And 16) = 16 Then
      Color 10
      Print "SCROLL LOCK ON  ";
  Else
      Color 12
      Print "SCROLL LOCK OFF ";
  End If
  If (port And 32) = 32 Then
      Color 10
      Print "NUMBER LOCK ON  ";
  Else
      Color 12
      Print "NUMBER LOCK OFF ";
  End If
  If (port And 64) = 64 Then
      Color 10
      Print "CAPS LOCK ON  ";
  Else
      Color 12
      Print "CAPS LOCK OFF ";
  End If
  If (port And 128) = 128 Then
      Color 10
      Print "INSERT MODE ON  ";
  Else
      Color 12
      Print "INSERT MODE OFF ";
  End If
  Def Seg
  Locate X, Y, 1
  GetLockState = -1
End Function