Zjištění pohybu kolečka myši
Postup:
Na formulář přidejte Label, do projektu přidejte modul. Pak vložte do
modulu následující kód:
Option Explicit
'API
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg 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
'Konstanty
Public Const MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
'Proměnné
Private hControl As Long
Private lPrevWndProc As Long
'WindowProc
'zDelta: indikuje směr, kterým bylo otočeno kolečkem. Vrací hodnotu 120, pokud je kolečkem
'dopředu, -120 pokud je otočeno dozadu
Private Function WindowProc(ByVal lWnd As Long, ByVal lMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim fwKeys As Long
Dim zDelta As Long
Dim xPos As Long
Dim yPos As Long
'Test je-li zpráva WM_MOUSEWHEEL
If lMsg = WM_MOUSEWHEEL Then
fwKeys = wParam And 65535
zDelta = wParam / 65536
xPos = lParam And 65535
yPos = lParam / 65536
'Volání proceudry na formuláři Form1 pro zpracování události MouseWheel
Form1.MouseWheel fwKeys, zDelta, xPos, yPos
End If
WindowProc = CallWindowProc(lPrevWndProc, lWnd, lMsg,
wParam, lParam)
End Function
'Hook
Public Sub Hook(ByVal hControl_ As Long)
hControl = hControl_
lPrevWndProc = SetWindowLong(hControl, GWL_WNDPROC, AddressOf WindowProc)
End Sub
'UnHook
Public Sub UnHook()
Call SetWindowLong(hControl, GWL_WNDPROC, lPrevWndProc)
End Sub
Na formulář vložte kód:
Private Sub Form_Load()
Hook Form1.hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHook
End Sub
