浏览器

开发平台：
Visual Basic

mPMenuMessage.bas：源码内容
							Attribute VB_Name = "mPMenuMessage"
Option Explicit
'Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
'Public Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
'Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Public 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 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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Const WH_MSGFILTER As Long = (-1)
Public Const MSGF_MENU As Long = 2
'Public Type MSG
'    hwnd As Long
'    message As Long
'    wParam As Long
'    lParam As Long
'    time As Long
'    pt As POINTAPI
'
'End Type
Private hhookMsg&
Private mFirstMove As Boolean
Public Sub SetMenuMsgHook()
If hhookMsg = 0 Then
    mFirstMove = True
    hhookMsg = SetWindowsHookEx(WH_MSGFILTER, AddressOf MenuMessageProc, App.hInstance, App.ThreadID)
    
    Debug.Print "hook:"; hhookMsg
End If
End Sub
Public Function MenuMessageProc(ByVal code&, ByVal wParam&, ByVal lParam&) As Long
Dim tMSG As MSG
If code = MSGF_MENU Then
    CopyMemory tMSG, ByVal lParam, Len(tMSG)
    Select Case tMSG.message
        Case WM_MOUSEMOVE
            If mFirstMove Then
                mFirstMove = False
            Else
                gMainForm.DropMenu_MouseMove tMSG.pt.x, tMSG.pt.y
            End If
        Case WM_KEYDOWN
            Select Case tMSG.wParam
                Case VK_LEFT
                    gMainForm.DropMenu_ShowNextMenu False
                Case VK_RIGHT
                    gMainForm.DropMenu_ShowNextMenu True
            End Select
        Case WM_RBUTTONUP
            Call PopupMenuMenu(tMSG.pt.x, tMSG.pt.y)
        Case WM_LBUTTONDBLCLK
            Call DbClickFavMenu(tMSG.pt.x, tMSG.pt.y)
            
    End Select
End If
MenuMessageProc = CallNextHookEx(hhookMsg, code, wParam, lParam)
End Function
Public Sub UnSetMenuMsgHook()
If hhookMsg <> 0 Then
    UnhookWindowsHookEx hhookMsg
End If
'Debug.Print "unsethook:"; hhookMsg
hhookMsg = 0
End Sub
'判断并弹出收藏夹右键菜单
Private Sub PopupMenuMenu(x&, y&)
Dim i&, tPos&
Dim tHwnd&
tHwnd = gMainForm.hwnd
For i = 0 To subMenuCount
    If loadSubInfo(i).isLoadSub Then
        tPos = MenuItemFromPoint(tHwnd, loadSubInfo(i).hwnd, x, y)
        If tPos >= 0 Then
            Call MENURBUTTONUP(tHwnd, tPos, loadSubInfo(i).hwnd)
            Exit For
        End If
    End If
Next i
End Sub
Private Sub DbClickFavMenu(x&, y&)
Dim i&, tPos&
Dim tHwnd&
tHwnd = gMainForm.hwnd
tPos = -1
For i = 0 To subMenuCount
    If loadSubInfo(i).isLoadSub Then
        tPos = MenuItemFromPoint(tHwnd, loadSubInfo(i).hwnd, x, y)
        If tPos >= 0 Then
            Call FindSubmnuAndOpenExplorer(loadSubInfo(i).hwnd, tPos)
            Exit For
        End If
    End If
Next i
End Sub
Private Sub FindSubmnuAndOpenExplorer(vHmnu&, vPos&)
Dim tId&
Dim tHSubMenu&
Dim tShell As cShowFilePropertyWindow
Dim i&
tId = GetMenuItemID(vHmnu, vPos)
If tId = -1 Then
    tHSubMenu = GetSubMenu(vHmnu, vPos)
    For i = 1 To subMenuCount
        If tHSubMenu = loadSubInfo(i).hwnd Then
            Set tShell = New cShowFilePropertyWindow
            PostMessage gMainForm.hwnd, WM_CANCELMODE, 0&, ByVal 0&
            tShell.ShowProps loadSubInfo(i).path, verbShowExplorer
            Exit For
        End If
    Next i
End If
End Sub

						