вот переписал тот код который типо неработает  :Д на это смотрите.. пробуйте
| Код |
'КОД ФОРМЫ
Private Sub Form_Load()
SetHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
RemoveHook
End Sub
'КОД МОДУЛЯ
Option Explicit
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As
Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal
lParam As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)
Private Declare Function GetForegroundWindow& Lib "user32" ()
Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)
Private Declare Function GetKeyboardLayout& Lib "user32" (ByVal dwLayout As Long)
Private Declare Function MapVirtualKeyEx Lib "user32" Alias "MapVirtualKeyExA" (ByVal uCode As Long, ByVal uMapType As Long,
ByVal dwhkl As Long) As Long
Private Const WH_JOURNALRECORD = 0
Type EVENTMSG
wMsg As Long
lParamLow As Long
lParamHigh As Long
msgTime As Long
hWndMsg As Long
End Type
Dim EMSG As EVENTMSG
Dim hHook As Long
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEWHEEL = &H20A
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Char As Long
If nCode < 0 Then
HookProc = CallNextHookEx(hHook, nCode, wParam, lParam)
Exit Function
End If
Dim i%, J%
CopyMemory EMSG, ByVal lParam, Len(EMSG)
Select Case EMSG.wMsg
Case WM_LBUTTONUP
frMMain.Caption = "WM_LBUTTONDBLCLK"
Case WM_KEYUP
If GetAsyncKeyState(vbKeyShift) Then J = 1
If GetAsyncKeyState(vbKeyControl) Then J = 2
If GetAsyncKeyState(vbKeyMenu) Then J = 4
If (EMSG.lParamLow And &HFF) > 31 Then
Char = MapVirtualKeyEx(EMSG.lParamLow And &HFF, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0)))
Else
Char = EMSG.lParamLow And &HFF
End If
frMMain.Text1 = frMMain.Text1 + Chr(Char)
End Select
Call CallNextHookEx(hHook, nCode, wParam, lParam)
End Function
Public Sub SetHook()
hHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf HookProc, 0, 0)
End Sub
Public Sub RemoveHook()
UnhookWindowsHookEx hHook
End Sub
|
|
