'BY:QQ:1633602558
Option Explicit
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 HC_ACTION = 0
Private Const WH_MOUSE = 7 '本地鉤子
Private Const WH_MOUSE_LL = 14 '全局鉤子
'鼠標消息
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 '鼠標移動時發生(與WM_MOUSEMOVE等值),常用於判斷鼠標消息的範圍
Private Const WM_MOUSELAST = &H209 'WM_MBUTTONDBLCLK的別名,通常用於判斷鼠標消息的範圍
Private Const WM_MOUSEWHEEL = &H20A '當鼠標輪子轉動時發送此消息個當前有焦點的控件
Private hHook As Long
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode = HC_ACTION Then
Select Case wParam
Case WM_MOUSEMOVE '移動鼠標
Case WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK '按下鼠標左鍵/釋放鼠標左鍵/雙擊鼠標左鍵
Case WM_RBUTTONDOWN, WM_RBUTTONUP, WM_RBUTTONDBLCLK '按下鼠標右鍵/釋放鼠標右鍵 /雙擊鼠標右鍵
HookProc = 1: Exit Function '示例:吃掉鼠標右鍵消息
Case WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MBUTTONDBLCLK '按下鼠標中鍵'釋放鼠標中鍵'雙擊鼠標中鍵
Case WM_MOUSEACTIVATE '當光標在某個非激活的窗口中而用戶正按著鼠標的某個鍵發送此消息給當前窗口
Case WM_MOUSEFIRST '鼠標移動時發生(與WM_MOUSEMOVE等值),常用於判斷鼠標消息的範圍
Case WM_MOUSELAST 'WM_MBUTTONDBLCLK的別名,通常用於判斷鼠標消息的範圍
Case WM_MOUSEWHEEL '當鼠標輪子轉動時發送此消息個當前有焦點的控件
Case Else:
End Select
End If
HookProc = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function
Public Sub SetMouseHook(Optional ByVal sTest As Boolean) '設置鼠標按鍵鉤子
If hHook <> 0 Then Call UnhookWindowsHookEx(hHook)
If sTest = True Then
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookProc, App.hInstance, 0) '全局勾子
Else
hHook = SetWindowsHookEx(WH_MOUSE, AddressOf HookProc, 0, App.ThreadID) '本地勾子
End If
End Sub
Public Sub DelMouseHook() '卸載鼠標按鍵鉤子
If hHook <> 0 Then
Call UnhookWindowsHookEx(hHook)
hHook = 0
End If
End Sub
'窗體代碼
'Private Sub Form_Load()
' Call SetMouseHook(True) '設置鼠標鉤子全局=True,線程=False
'End Sub
'Private Sub Form_Unload(Cancel As Integer)
' Call DelMouseHook '卸載鼠標按鍵鉤子
'End Sub
'祥細代碼發妳了,如果還有不懂,可加我QQ問,最近寫過類似程序,正好用到這個