发布网友 发布时间:2022-04-23 18:48
共1个回答
热心网友 时间:2023-10-13 15:23
新出炉的底层鼠标钩子(Low
Level
Mouse
Hook)
'==================窗体代码=================
Private
Sub
Form_Load()
hHook
=
SetWindowsHookEx(WH_MOUSE_LL,
AddressOf
MouseHookProc,
App.hInstance,
0)
If
hHook
<>
0
Then
MsgBox
"已钩住鼠标事件,请按本窗体右上方的X按钮关闭窗体,不要使用VB调试工具栏的“结束”按钮,以免VB崩溃"
End
If
End
Sub
Private
Sub
Form_Unload(Cancel
As
Integer)
UnhookWindowsHookEx
hHook
End
Sub
'=============模块代码==================
Public
Const
WH_MOUSE
=
7
'本地钩子
Public
Const
WH_MOUSE_LL
=
14
'全局钩子
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
CallNextHookEx
Lib
"user32"
(ByVal
hHook
As
Long,
ByVal
nCode
As
Long,
ByVal
wParam
As
Long,
lParam
As
Any)
As
Long
Public
Declare
Function
UnhookWindowsHookEx
Lib
"user32"
(ByVal
hHook
As
Long)
As
Long
Public
Declare
Sub
CopyMemory
Lib
"kernel32"
Alias
"RtlMoveMemory"
(Destination
As
Any,
Source
As
Any,
ByVal
Length
As
Long)
Public
Const
WM_LBUTTONDOWN
=
&H201
'窗口中按下鼠标左键
Public
Const
WM_LBUTTONUP
=
&H202
'窗口中松开鼠标左键
Public
Const
WM_MOUSEMOVE
=
&H200
'窗口中移动鼠标
Public
Const
WM_RBUTTONDOWN
=
&H204
'窗口中按下鼠标右键
Public
Const
WM_RBUTTONUP
=
&H205
'窗口中松开鼠标右键
Public
Const
WM_MOUSEWHEEL
=
&H20A
'鼠标滚轮
Public
Const
WM_NCLBUTTONDOWN
=
&HA1
'窗口标题栏中按下鼠标左键
Public
Const
WM_NCLBUTTONUP
=
&HA2
'窗口标题栏中左开鼠标左键
Public
Const
WM_NCMOUSEMOVE
=
&HA0
'窗口标题栏中移动鼠标
Public
Const
WM_NCRBUTTONDOWN
=
&HA4
'窗口标题栏中按下鼠标右键
Public
Const
WM_NCRBUTTONUP
=
&HA5
'窗口标题栏中松开鼠标右键
Public
hHook
As
Long
Public
Type
POINTAPI
x
As
Long
y
As
Long
End
Type
Type
MSLLHOOKSTRUCT
pt
As
POINTAPI
'相对于屏幕左上角的坐标x,y
mouseData
As
Long
'鼠标数据
flags
As
Long
'标记
time
As
Long
'时间戳
dwExtraInfo
As
Long
'其他信息
End
Type
Type
MOUSEHOOKSTRUCT
pt
As
POINTAPI
'相对于屏幕左上角的坐标x,y
hwnd
As
Long
'鼠标光标下窗口的句柄
wHitTestCode
As
Long
'鼠标光标在窗口中的位置,标题栏、左边框、右边框,下边框。。。
dwExtraInfo
As
Long
'其他信息,通常为0
End
Type
Dim
oMouseHookStruct
As
MSLLHOOKSTRUCT
Public
Function
MouseHookProc(ByVal
idHook
As
Long,
ByVal
wParam
As
Long,
ByVal
lParam
As
Long)
As
Long
CopyMemory
oMouseHookStruct,
ByVal
lParam,
Len(oMouseHookStruct)
Debug.Print
"当前鼠标位置-x:"
&
oMouseHookStruct.pt.x
&
";
y:"
&
oMouseHookStruct.pt.y
Select
Case
wParam
Case
WM_LBUTTONDOWN,
WM_NCLBUTTONDOWN
Debug.Print
"左键按下"
Case
WM_LBUTTONUP,
WM_NCLBUTTONUP
Debug.Print
"左键弹起"
Case
WM_RBUTTONDOWN,
WM_NCRBUTTONDOWN
Debug.Print
"右键按下"
Case
WM_RBUTTONUP,
WM_NCRBUTTONUP
Debug.Print
"右键弹起"
Case
WM_MOUSEMOVE,
WM_NCMOUSEMOVE
Debug.Print
"鼠标移动"
Case
WM_MOUSEWHEEL
Debug.Print
"鼠标滚轮"
End
Select
MouseHookProc
=
CallNextHookEx(hHook,
idHook,
wParam,
ByVal
lParam)
End
Function