'窗体代码
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