VB 获得鼠标滚轮的事件

'窗体代码
Private Sub Form_Load()
HookMouse Me.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer )
UnHookMouse Me.hwnd
End Sub

 

'模块代码
'***********************************************************
'mMouseWheel
'鼠标滚轮的事件检测
'***********************************************************
Option Explicit

Private 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
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" ( ByVal hwnd As Long , ByVal nIndex As Long , ByVal dwNewLong As Long ) As Long

Private Const GWL_WNDPROC = - 4
Private Const WM_MOUSEWHEEL = &H20A

Global lpPrevWndProcA As Long

Public bMouseFlag As Boolean '鼠标事件激活标志

Public Sub HookMouse( ByVal hwnd As Long )
lpPrevWndProcA = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHookMouse( ByVal hwnd As Long )
SetWindowLong hwnd, GWL_WNDPROC, lpPrevWndProcA
End Sub

Private Function WindowProc( ByVal hw As Long , ByVal uMsg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long
Select Case uMsg
Case WM_MOUSEWHEEL '滚动
Dim wzDelta, wKeys As Integer
'wzDelta传递滚轮滚动的快慢，该值小于零表示滚轮向后滚动（朝用户方向），
'大于零表示滚轮向前滚动（朝显示器方向）
wzDelta = HIWORD(wParam)
'wKeys指出是否有CTRL=8、SHIFT=4、鼠标键(左=2、中=16、右=2、附加)按下，允许复合
wKeys = LOWORD(wParam)
'--------------------------------------------------
If wzDelta < 0 Then '朝用户方向
Form1.Cls
Form1.Print "朝用户方向滚"
Else '朝显示器方向
Form1.Cls
Form1.Print "朝显示器方向"
End If
'--------------------------------------------------
Case Else
WindowProc = CallWindowProc(lpPrevWndProcA, hw, uMsg, wParam, lParam)
End Select
End Function

Private Function HIWORD(LongIn As Long ) As Integer
HIWORD = (LongIn And &HFFFF0000 ) \ &H10000 '取出32位值的高16位
End Function
Private Function LOWORD(LongIn As Long ) As Integer
LOWORD = LongIn And &HFFFF & '取出32位值的低16位
End Function