VB 鼠标钩子实例

此程序演示了在VB中怎么使用鼠标钩子。程序会把按钮覆盖到“开始 ”按钮上，当你按这个按钮的时候会显示一个快捷菜单，并且这个菜单可以响应事件。

frmMain.fm

Option Explicit
Private Declare Function ShowWindow Lib “user32” (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetParent Lib “user32” (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function FindWindow Lib “user32” Alias “FindWindowA” (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function MoveWindow Lib “user32” (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function ClientToScreen Lib “user32” (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function FindWindowEx Lib “user32” Alias “FindWindowExA” (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClientRect Lib “user32” (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function MessageBox Lib “user32” Alias “MessageBoxA” (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdLeave_Click()
    Dim lngStart As Long, lngStartButton As Long, objPoint As POINTAPI, objRect As RECT
    Me.Hide
    lngStart = FindWindow(“Shell_TrayWnd”, vbNullString)
    SetParent lngCmdhWnd, lngStart
    lngStartButton = FindWindowEx(lngStart, 0, “button”, vbNullString)
    ‘ClientToScreen lngStartButton, objPoint
    GetClientRect lngStartButton, objRect
    MoveWindow lngCmdhWnd, 0, 0, objRect.Right – objRect.Left, objRect.Bottom – objRect.Top, 1
End Sub

Public Sub cmdSend_Click()
‘    MessageBox Me.hwnd, “我能响应事件！！”, “哈哈！！”, vbInformation
‘    ShowWindow Me.hwnd, 5
‘    SetParent lngCmdhWnd, Me.hwnd
‘    cmdSend.Move 1800, 2880, cmdExit.Width, cmdExit.Height
    PopupMenu Me.mnuOpen
End Sub

Private Sub cmdSend_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 27 Then
        SetParent lngCmdhWnd, Me.hwnd
        cmdSend.Move 1800, 2880, cmdExit.Width, cmdExit.Height
        Me.Show
    End If
End Sub

Private Sub Form_Load()
    lngCmdhWnd = Me.cmdSend.hwnd
    hHook = SetWindowsHookEx(WH_MOUSE_DLL, AddressOf MouseProc, App.hInstance, 0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnhookWindowsHookEx hHook
End Sub

Private Sub mnuCalc_Click()
    Shell “calc”, vbNormalFocus
End Sub

Private Sub mnuNote_Click()
    Shell “Notepad.exe”, vbNormalFocus
End Sub

modMouse.bas

Option Explicit

Public Const WH_MOUSE = 7
Public Const WH_MOUSE_DLL = 14
Private Declare Function CallNextHookEx Lib “user32” (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
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
Declare Function UnhookWindowsHookEx Lib “user32” (ByVal hHook As Long) As Long
Private Declare Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib “user32” (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetClassName Lib “user32” Alias “GetClassNameA” (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function IsWindowEnabled Lib “user32” (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib “user32” (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function EnableWindow Lib “user32” (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Private Declare Function EnumChildWindows Lib “user32” (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetParent Lib “user32” (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib “user32” Alias “GetWindowTextA” (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib “user32” Alias “GetWindowTextLengthA” (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib “user32” Alias “SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_FINDSTRING = &H18F

Private Type POINTAPI
        X As Long
        Y As Long
End Type
Private Type MOUSEHOOKSTRUCT
        pt As POINTAPI
        hwnd As Long
        wHitTestCode As Long
        dwExtraInfo As Long
End Type
Private Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” (Destination As Any, Source As Any, ByVal Length As Long)
Public hHook As Long
Private objMOUSEMSG As MOUSEHOOKSTRUCT
Public lngCmdhWnd As Long

Public Function MouseProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim p As POINTAPI, strClassName As String * 260, lnghWnd As Long, lngRet As Long
    If idHook < 0 Then
        MouseProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    Else
        If wParam = 514 Then
            CopyMemory objMOUSEMSG, ByVal lParam, Len(objMOUSEMSG)
            lnghWnd = WindowFromPoint(objMOUSEMSG.pt.X, objMOUSEMSG.pt.Y)
            lngRet = GetClassName(lnghWnd, strClassName, 260)
            If (Left(strClassName, lngRet) = “ThunderCommandButton” Or Left(strClassName, lngRet) = “ThunderRT6CommandButton”) Then
                If lnghWnd = lngCmdhWnd Then
                    If GetParent(lnghWnd) <> frmMain.hwnd Then frmMain.cmdSend_Click
                End If
            End If
        End If
        MouseProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    End If
End Function