浏览器

开发平台：
Visual Basic

mToolBarHook.bas：源码内容
							Attribute VB_Name = "mToolBarHook"
Option Explicit
Public lpPrevTbrProc As Long
Public gHTbr As Long
'#############################################
'Public Const TBN_FIRST As Long = (-700)
'Public Const TBN_DROPDOWN As Long = (TBN_FIRST - 10)
'
'Public Const WM_NOTIFY As Long = &H4E
'Public Type NMHDR
'    hwndFrom As Long
'    idfrom As Long
'    code As Long
'
'End Type
'
'
'Private Type CTBBUTTON
'    iBitmap As Long
'    idCommand As Long
'    fsState As Byte
'    fsStyle As Byte
'    dwData As Long
'    iString As Long
'End Type
''======== Button Style =====================
'
'Private Const BTNS_AUTOSIZE As Long = TBSTYLE_AUTOSIZE
'Private Const BTNS_BUTTON As Long = TBSTYLE_BUTTON
'Private Const BTNS_CHECK As Long = TBSTYLE_CHECK
'Private Const BTNS_CHECKGROUP As Long = TBSTYLE_CHECKGROUP
'Private Const BTNS_DROPDOWN As Long = TBSTYLE_DROPDOWN
'Private Const BTNS_GROUP As Long = TBSTYLE_GROUP
'Private Const BTNS_NOPREFIX As Long = TBSTYLE_NOPREFIX
'Private Const BTNS_SEP As Long = TBSTYLE_SEP
'Private Const BTNS_SHOWTEXT As Long = &H40
'Private Const BTNS_WHOLEDROPDOWN As Long = &H80
'
'Private Const TB_SETBUTTONINFOA As Long = (WM_USER + 66)
'Private Const TB_SETBUTTONINFOW As Long = (WM_USER + 64)
'Private Const TB_GETBUTTONINFOA As Long = (WM_USER + 65)
'Private Const TB_GETBUTTONINFOW As Long = (WM_USER + 63)
'################################################
    
 '以下过程为消息循环处理
Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim i As Integer
Select Case uMsg
'    Case WM_NOTIFY
'        'Debug.Print "notify"
'        Dim tnh As NMHDR
'        CopyMemory tnh, ByVal lParam, Len(tnh)
'        If tnh.code = TBN_DROPDOWN Then
'            Debug.Print "dd"
'            tnh.code = 0
'            'CopyMemory ByVal lParam, tnh, Len(tnh)
'            FavoriteFolderPopMenu.Popup hw
'        End If
        
    Case WM_INITMENUPOPUP
'        If MDIFrmMain.proxyPop Then
'            For i = 0 To GetMenuItemCount(wParam) - 1
'
'                If i + 1 <> proxySelected Then
'                    CheckMenuItem wParam, i, MF_BYPOSITION Or MF_UNCHECKED
'                  Else
'                    CheckMenuItem wParam, i, MF_BYPOSITION Or MF_CHECKED
'                End If
'            Next i
'            MDIFrmMain.proxyPop = False
'        End If
'
'        If MDIFrmMain.pvnpopPop And loadedBrowserCount > 0 Then
'            For i = 0 To GetMenuItemCount(wParam) - 1
'
'                If i + 1 <> webbState(gActiveWebIndex).webForm.mPvnPop Then
'                    CheckMenuItem wParam, i, MF_BYPOSITION Or MF_UNCHECKED
'                  Else
'                    CheckMenuItem wParam, i, MF_BYPOSITION Or MF_CHECKED
'                End If
'            Next i
'            MDIFrmMain.pvnpopPop = False
'        End If
End Select
        WindowProc = CallWindowProc(lpPrevTbrProc, hw, uMsg, wParam, lParam)
End Function
    
Public Sub tbrHook() '将程序勾入消息环中
 '利用AddressOf取得消息处理函数WindowProc的指针，并将其传给SetWindowLong
 'lpPrevWndProc用来存储原窗口的指针
 lpPrevTbrProc = SetWindowLong(gHTbr, GWL_WNDPROC, AddressOf WindowProc)
End Sub
    
Public Sub tbrUnhook()
'将程序从消息环退出。用原窗口的指针替换WindowProc函数的指针，即关闭子类、退出消息循环
 Dim temp As Long
 temp = SetWindowLong(gHTbr, GWL_WNDPROC, lpPrevTbrProc)
End Sub

						