1,486
社区成员
发帖
与我相关
我的任务
分享
Option Explicit
Private Sub Form_Load()
MouseHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnMouseHook
End Sub
Private Sub Timer1_Timer()
Dim lp As PointAPI
GetCursorPos lp
Lab.Caption = lp.X & "," & lp.Y
End Sub
Option Explicit
''使用鼠标钩子在Module模块里:
Private 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
Private 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 WH_KEYBOARD_LL = 13
Private Const WH_MOUSE_LL = 14 '消息
Private Const HC_ACTION = 0
Private Const HC_SYSMODALOFF = 5
Private Const HC_SYSMODALON = 4 '鼠标消息
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEACTIVATE = &H21
Private Const WM_MOUSEFIRST = &H200
Private Const WM_MOUSELAST = &H209
Private Const WM_MOUSEWHEEL = &H20A
Public Type PointAPI
X As Long
Y As Long
End Type
Public Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Public lMouseHook As Long
Public Sub MouseHook()
lMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0)
End Sub
'卸钩子
Public Sub UnMouseHook()
UnhookWindowsHookEx lMouseHook
End Sub
'鼠标钩子
Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If code = HC_ACTION Then '下面是鼠标的消息类型,你想怎么做就怎么做...
Select Case wParam
Case WM_MOUSEMOVE
Dim lp As PointAPI
GetCursorPos lp
Form1.Caption = lp.X & "," & lp.Y
Case WM_LBUTTONDOWN
Case WM_LBUTTONUP
Case WM_LBUTTONDBLCLK
Case WM_RBUTTONDOWN
Case WM_RBUTTONUP
Case WM_RBUTTONDBLCLK
Case WM_MBUTTONDBLCLK
Case WM_MBUTTONUP
Case WM_MOUSEACTIVATE
Case WM_MOUSEFIRST
Case WM_MOUSELAST
Case WM_MOUSEWHEEL
End Select
End If
If code <> 0 Then
CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)
End If
End Function
Option Explicit
Private Sub Form_Load()
MouseHook
Timer1.Interval = 100
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnMouseHook
End Sub
Private Sub Timer1_Timer()
Dim lp As PointAPI
GetCursorPos lp
Lab.Caption = lp.X & "," & lp.Y
End Sub