浏览器

开发平台：
Visual Basic

mMainHook.bas：源码内容
							Attribute VB_Name = "mMainHook"
Option Explicit
Public lpPrevWndProc As Long
Public gHW As Long
'当前选中菜单的handle
Public hMenuCurSelect As Long
'=================================================================
'=======================Subs======================================
'=================================================================
    
    
    
 '以下过程为消息循环处理
Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo due
Dim i As Integer
'Dim pSM As ClsSMenu
Dim TempMIS As MEASUREITEMSTRUCT
Dim TempDIS As DRAWITEMSTRUCT
Select Case uMsg
    Case WM_MEASUREITEM '告诉系统绘制的控件大小
        CopyMemory TempMIS, ByVal lParam, Len(TempMIS) '取值
        
        '找到菜单
        Select Case TempMIS.CtlType
            Case ODT_MENU
                gODrawMenu.On_WM_MEASUREITEM lParam
'                For Each pSM In SMenus
'                    If pSM.MeID = TempMIS.itemID Then
'                        pSM.SetSize lParam
'                        Exit For
'                    End If
'                Next pSM
        End Select
        
    Case WM_DRAWITEM '绘制控件
        CopyMemory TempDIS, ByVal lParam, Len(TempDIS) '取值
        '找到菜单
        Select Case TempDIS.CtlType
            Case ODT_MENU
                gODrawMenu.On_WM_DRAWITEM lParam
'                For Each pSM In SMenus
'                    If pSM.MeID = TempDIS.itemID Then
'                        pSM.MeDraw lParam
'                        Exit For
'                    End If
'                Next pSM
        End Select
        
    Case WM_INITMENUPOPUP
        Call gMainForm.SubCls_INITMENUPOPUP(wParam)
        
    'Case WM_MENURBUTTONUP
       ' Call MENURBUTTONUP(hw, wParam, lparam)
    
    Case WM_MENUSELECT
        If lParam <> 0 Then
            hMenuCurSelect = lParam
        End If
        Call gMainForm.SubCls_MENUSELECT(wParam, lParam)
    Case WM_MENUCOMMAND
        Call gMainForm.SubCls_WM_MENUCOMMAND(lParam, wParam)
'    Case WM_COMMAND
'        Call gMainForm.SubCls_COMMAND(wParam)
        
    Case WM_MOVE, WM_SIZE
        Call gMainForm.SubCls_MoveSize
        
    Case WM_SYSCOLORCHANGE
        Call gMainForm.UpdateButtonColor
        
    Case WM_HOTKEY
        Call gMainForm.ShowMe(True)
End Select
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
Exit Function
due:
    ErrorLog.AddLog "mainhook windowproc," & Err.Description
    Resume Next
    
End Function
    
Public Sub mainHook(hMainWin As Long)  '将程序勾入消息环中
 '利用AddressOf取得消息处理函数WindowProc的指针，并将其传给SetWindowLong
 'lpPrevWndProc用来存储原窗口的指针
 lpPrevWndProc = SetWindowLong(hMainWin, GWL_WNDPROC, AddressOf WindowProc)
End Sub
    
Public Sub mainUnhook(hMainWin As Long)
'将程序从消息环退出。用原窗口的指针替换WindowProc函数的指针，即关闭子类、退出消息循环
 Dim temp As Long
 temp = SetWindowLong(hMainWin, GWL_WNDPROC, lpPrevWndProc)
End Sub
'收藏夹菜单上的右键菜单
Public Sub MENURBUTTONUP(ByVal hw As Long, ByVal wParam As Long, ByVal lParam As Long)
Dim rbUpID As Long
Dim tMID&
Dim tHSubMenu&
Dim i&, tSubCanPop As Boolean
Dim tSubInfo As subMenuInfo
Dim tShell As New cShowFilePropertyWindow
Dim curSubIndex As Long
tMID = GetMenuItemID(lParam, wParam)
rbUpID = tMID - MenuIDOffset
If rbUpID >= 1 And rbUpID <= itemMenuCount Then
    Dim tId As Long
    FavoriteURLPopMenu.SetDefault ID_FavUrl_OpenNew
    tId = FavoriteURLPopMenu.Popup2(hw, , , , TPM_Default Or TPM_RECURSE)
    If tId <> 0 Then Call PostMessage(hw, WM_CANCELMODE, 0&, 0)
    Select Case tId
        Case ID_FavUrl_OpenNew
            gMainForm.favConet favoriteInfo(rbUpID).url
            gMainForm.ClickFavorite favoriteInfo(rbUpID).Title, favoriteInfo(rbUpID).url
        Case ID_FavUrl_Open
            gMainForm.favConet favoriteInfo(rbUpID).url, False
            gMainForm.ClickFavorite favoriteInfo(rbUpID).Title, favoriteInfo(rbUpID).url
        Case ID_FavUrl_Property
           tShell.ShowProps favoriteInfo(rbUpID).path, verbShowProperties
        Case ID_FavUrl_OpenIE
            Call gMainForm.NewIE(favoriteInfo(rbUpID).url)
        Case ID_FavUrl_Float
            Call ShowFloatSubFav(lParam)
        Case ID_FavUrl_OpenAll
            Call OpenAllLink(lParam)
        Case ID_FavUrl_Delete
'            If MsgBox("确实要删除 """ & favoriteInfo(rbUpID).Title & """ ?", vbOKCancel Or vbQuestion, "删除收藏") = vbOK Then
'                Kill favoriteInfo(rbUpID).path
'            End If
    End Select
ElseIf tMID = -1 Then
    tHSubMenu = GetSubMenu(lParam, wParam)
    'Debug.Print tHSubMenu
    tSubCanPop = False
    For i = 1 To subMenuCount
        If tHSubMenu = loadSubInfo(i).hWnd Then
            tSubCanPop = True
            tSubInfo = loadSubInfo(i)
            curSubIndex = i
            Exit For
        End If
    Next i
    If tSubCanPop Then
        FavoriteFolderPopMenu.SetDefault ID_FavFolder_Explorer
        tId = FavoriteFolderPopMenu.Popup2(hw, , , , TPM_Default Or TPM_RECURSE)
        If tId <> 0 Then Call PostMessage(hw, WM_CANCELMODE, 0&, 0)
        Select Case tId
            Case ID_FavFolder_Explorer
                tShell.ShowProps tSubInfo.path, verbShowExplorer
            Case ID_FavFolder_SideFav
                gMainForm.ShowFavorite = IDM_Main_View_SideBand_Favorite
                gMainForm.ExpandNode tSubInfo.hNode, True
            Case ID_FavFolder_OpenAllLink
                If Not tSubInfo.isLoadSub Then
                    'gMainForm.SeedFile tSubInfo.path, tSubInfo.hWnd, , , tSubInfo.hNode
                    gMainForm.SeekFavoriteFolder tSubInfo.path, tSubInfo.hWnd, , , tSubInfo.hNode
                    loadSubInfo(curSubIndex).isLoadSub = True
                End If
                Call OpenAllLink(tSubInfo.hWnd)
'                For i = 1 To itemMenuCount
'                    If favoriteInfo(i).hSubMenu = tSubInfo.hwnd Then
'                        gMainForm.NewWebbrowser favoriteInfo(i).Url
'                    End If
'                Next i
            
''==================================================
'            Case ID_FavFolder_Float
'                If Not tSubInfo.isLoadSub Then
'                    gMainForm.SeedFile tSubInfo.path, tSubInfo.hwnd
'                    loadSubInfo(curSubIndex).isLoadSub = True
'                End If
'                Call ShowFloatSubFav(tSubInfo.hwnd)
''===================================================
        End Select
    End If
End If
End Sub
Public Function drawSmallButton(hw As Long) As Boolean
If Not gFullScreenMode Then
    Dim tTitleBar As PTITLEBARINFO
    Dim bX As Long, bY As Long
    Dim tRc As RECT
    Dim tl As POINTAPI, br As POINTAPI
    
    Dim tdc&
    
    tTitleBar.cbSize = Len(tTitleBar)
    Call GetTitleBarInfo(hw, tTitleBar)
    bX = GetSystemMetrics(SM_CXSIZE) - 2
    bY = GetSystemMetrics(SM_CYSIZE) - 4
    tl.x = tTitleBar.rcTitleBar.Right - 4 * bX - 2 - 2 - 3
    tl.y = tTitleBar.rcTitleBar.Top + 2
    Call ScreenToClient(hw, tl)
    tl.y = 6
    br.x = tl.x + bX + 1
    br.y = tl.y + bY
    SetRect tRc, tl.x, tl.y, br.x, br.y
    
    tdc = GetWindowDC(hw)
    
    Call DrawFrameControl(tdc, tRc, DFC_BUTTON, DFCS_BUTTONPUSH)
    ReleaseDC hw, tdc
'    MoveWindow gMainForm.fraTitleButton.hwnd, tTitleBar.rcTitleBar.Right - 4 * bX - 2 - 2 - 3, tTitleBar.rcTitleBar.Top + 2, bX, bY, 1
'    MoveWindow gMainForm.cmdTray.hwnd, 0, 0, bX, bY, 1
End If
End Function

						