Страница: 1 2
Вопрос: Как узнать направление скролла мышки вне формы
Добавлено: 09.02.10 22:27
Номер ответа: 16Автор ответа: Just Вопросов: 4Ответов: 330
Профиль | | #16
Добавлено: 10.02.10 23:03
Ты делай лоулевел хук.
AddressOf
Ответить
Номер ответа: 17Автор ответа: Winand Вопросов: 87Ответов: 2795
Web-сайт: winandfx.narod.ru Профиль | | #17
Добавлено: 10.02.10 23:57
И поправлю ведь. WH_MOUSE_LL (вместо WH_JOURNALRECORD) - глобальный хук мыши, а WM_MOUSEWHEEL - это сообщение приходящее в процедуру обработки.
Option Explicit
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long , ByVal wMsg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long
Private Const WM_USER As Long = &H400
Private Const WM_WHEEL As Long = (WM_USER + 1)
Private Const WM_KEYS As Long = (WM_USER + 2)
Private Const WM_REGHOOK As Long = (WM_USER + 3)
Private Const WM_UNREGHOOK As Long = WM_REGHOOK
Private Const WM_RESTART As Long = (WM_USER + 4)
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String , ByVal lpWindowName As String ) As Long
Private Const WINDOW_NAME As String = "Audica_Dummy"
Private Const HOOK_NAME As String = "HookTool_Dummy"
Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As Long , ByVal wMsg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long , ByVal nIndex As Long , ByVal dwNewLong As Long ) As Long
Private Const GWL_WNDPROC As Long = -4
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long , ByVal lpClassName As String , ByVal lpWindowName As String , ByVal dwStyle As Long , ByVal x As Long , ByVal y As Long , ByVal nWidth As Long , ByVal nHeight As Long , ByVal hWndParent As Long , ByVal hmenu As Long , ByVal hInstance As Long , ByRef lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hWnd As Long ) As Long
Private wnd As Long , dummy As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long )
Public 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
Public Declare Function UnhookWindowsHookEx Lib "USER32" (ByVal hHook As Long ) As Long
Private Declare Function CallNextHookEx Lib "USER32" (ByVal hHook As Long , ByVal nCode As Long , ByVal wParam As Long , lParam As Any) As Long
Private Const HC_ACTION = 0
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_SYSKEYUP = &H105
Private Const WH_KEYBOARD_LL = 13
Private Const WM_MOUSEWHEEL = &H20A
Private Const WH_MOUSE_LL As Long = 14
Private Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
Flags As Long
time As Long
dwExtraInfo As Long
End Type
Private p As KBDLLHOOKSTRUCT
Private mou_rotat As Integer
Private kbd_hook_hndl As Long
Private mou_hook_hndl As Long
Public kbd_keys As New Collection
Public Sub hook()
kbd_hook_hndl = _
SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf km_hook_proc, App.hInstance, 0)
mou_hook_hndl = _
SetWindowsHookEx(WH_MOUSE_LL, AddressOf km_hook_proc, App.hInstance, 0)
End Sub
Public Sub unhook()
If kbd_hook_hndl <> 0 Then _
UnhookWindowsHookEx kbd_hook_hndl
kbd_hook_hndl = 0
If mou_hook_hndl <> 0 Then _
UnhookWindowsHookEx mou_hook_hndl
mou_hook_hndl = 0
End Sub
Public Function km_hook_proc(ByVal nCode As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long
If nCode = HC_ACTION Then
Select Case wParam
Case WM_MOUSEWHEEL
CopyMemory mou_rotat, ByVal lParam + 10, 2
PostMessage wnd, WM_WHEEL, App.hInstance, CLng (Sgn(mou_rotat))
Case WM_KEYDOWN, WM_SYSKEYDOWN
CopyMemory p, ByVal lParam, Len(p)
If valByKey(p.vkCode) = -1 Then
kbd_keys.Add p.vkCode, CStr (p.vkCode)
If kbd_keys.Count = 1 Then _
PostMessage wnd, WM_KEYS, App.hInstance, 1
End If
Case WM_KEYUP, WM_SYSKEYUP
CopyMemory p, ByVal lParam, Len(p)
If valByKey(p.vkCode) <> -1 Then _
kbd_keys.Remove CStr (p.vkCode)
If kbd_keys.Count = 0 Then _
PostMessage wnd, WM_KEYS, App.hInstance, -1
End Select
End If
km_hook_proc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function
Private Function valByKey(ByVal key As String ) As Long
On Error GoTo 1:
valByKey = kbd_keys.Item(key)
Exit Function
1: valByKey = -1
End Function
Private Function int_WindowProc(ByVal hWnd As Long , ByVal uMsg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long
If uMsg = WM_UNREGHOOK Then Unload Form1
int_WindowProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function
Public Function findServer() As Boolean
Dim prev As Long
If b(prev, FindWindow(vbNullString, HOOK_NAME)) Then _
PostMessage prev, WM_UNREGHOOK, 0, 0
If b(wnd, FindWindow(vbNullString, WINDOW_NAME)) Then
If dummy = 0 Then
dummy = CreateWindowEx(0, "STATIC" , HOOK_NAME, 0, 0, 0, 0, 0, 0, 0, 0, ByVal 0)
SetWindowLong dummy, GWL_WNDPROC, AddressOf int_WindowProc
End If
PostMessage wnd, WM_REGHOOK, App.hInstance, dummy
findServer = True
End If
End Function
Public Sub destroyDummy()
If dummy Then _
DestroyWindow dummy
End Sub
Private Function b(p1 As Long , p2 As Long ) As Boolean
p1 = p2
b = CBool (p1)
End Function
Ответить
Страница: 1 2
Поиск по форуму
Just
Winand