浏览器

开发平台：

Visual Basic

MDIFrmMain.frm：源码内容

' If tmpNode.Tag <> "Root" Then
' tvwFavorite.ToolTipText = tmpNode.Tag
' Else
' tvwFavorite.ToolTipText = ""
' End If
' Else
' tvwFavorite.ToolTipText = ""
'End If
'End Sub
'
'Private Sub tvwFavorite_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'If Button = vbRightButton Then
' Dim tmpNode As Node
' Set tmpNode = tvwFavorite.HitTest(x, y)
' If Not (tmpNode Is Nothing) Then
'
' tvwPopItemKey = tmpNode.Key
' If tmpNode.Tag = "Root" Then
' mnuPopOpenInNewWindow.Visible = False
' mnuPopDeleteFavorite.Enabled = False
' Else
' mnuPopOpenInNewWindow.Visible = True
' mnuPopDeleteFavorite.Enabled = True
' End If
' Me.PopupMenu mnuPopFavorite
' End If
' Button = 0
'End If
'End Sub
'
'Private Sub tvwFavorite_NodeClick(ByVal Node As MSComctlLib.Node)
''If Node.Tag = "Root" Then
'' If Not loadSubInfo(Node.index).isLoadSub Then
'' Call seedFile(Node.Key, loadSubInfo(Node.index).hwnd)
'' loadSubInfo(Node.index).isLoadSub = True
'' Node.Expanded = True
'' End If
'' Else
'' If Not tlbOther.Buttons("locknew").Value Then webbState(gActiveWebIndex).isFirst = 1
'' wbbMe(gActiveWebIndex).Navigate Node.Tag
''End If
'
'End Sub
Public Sub UnloadBrowser(ByVal index As Long)
Dim ulUrl As String, ulTitle As String
On Error GoTo due
'If loaded > 1 Then
'If webbState(index).isLoaded Then
If Not webbState(index) Is Nothing Then
'webbState(index).isLoaded = False
ulUrl = webbState(index).webForm.GetWebUrl
ulTitle = webbState(index).webForm.GetWebTitle
isUnloadByFunction = True
Dim tmpIndex As Integer
Dim i As Integer
Dim tmpLeft As Single, tmpWidth As Single, tOrder As Integer
If index = gActiveWebIndex Then
gActiveWebIndex = 0
'lstOrder.RemoveItem (0)
'gActiveWebIndex = lstOrder.List(0)
Else
' For i = 0 To lstOrder.ListCount - 1
' If lstOrder.List(i) = LTrim$(Str(index)) Then
' lstOrder.RemoveItem (i)
' Exit For
' End If
' Next i
End If
If loadedBrowserCount > 1 Then
isTabClick = False
'Call SwitchTabs(Val(lstOrder.List(0)), index)
'webbState(Val(lstOrder.List(0))).webForm.ZOrder
Else
gActiveWebIndex = 0
End If
If webbState(index).TabBtn.Selected Then selectedTabsCount = selectedTabsCount - 1
'Debug.Print "unloadbrowser:"; webbState(index).TabBtn.TagL, webbState(index).TabBtn.index
TabBar.RemoveByIndex webbState(index).TabBtn.index
Set webbState(index).TabBtn = Nothing
Unload webbState(index).webForm
Set webbState(index).webForm = Nothing
Set webbState(index) = Nothing
' webbState(index).isFirst = 0
'================= controls no use ======================
' tOrder = webbState(index).tabOrder
' tmpWidth = webbState(index).webTab.pWidth
'
' For i = 1 To browserCount
' If webbState(i).isLoaded Then
' If webbState(i).tabOrder > tOrder Then
' webbState(i).webTab.pLeft = webbState(i).webTab.pLeft - tmpWidth
' webbState(i).tabOrder = webbState(i).tabOrder - 1
' End If
' End If
' Next
'
' If webbState(index).webTab.Selected Then selectedTabsCount = selectedTabsCount - 1
' Unload cochkButton(index)
'
'
' Set webbState(index).webTab = Nothing
'=========================================================
loadedBrowserCount = loadedBrowserCount - 1
fraHoldOpt.width = loadedBrowserCount * tabLength
If tabsPos > loadedBrowserCount Then tabsPos = loadedBrowserCount
Call refreshTab
ClosedPages.Add ulTitle, ulUrl
'Call load_close_menu(ulUrl, ulTitle)
Call EnableButtons
End If
Exit Sub
due:
ErrorLog.AddLog Err.Description & Str(Err.Number) & Chr(9) & "Unload Function"
Resume Next
End Sub
Private Function GetFoldName(newPath As String) As String
Dim tmpPos As Integer
tmpPos = InStr(1, newPath, "")
If tmpPos = 0 Then
GetFoldName = newPath
Exit Function
End If
'递归调用
GetFoldName = GetFoldName(Right$(newPath, Len(newPath) - tmpPos))
End Function
'---------------------------------------------------------------------------------------
' Procedure : SeekFavoriteFolder
' DateTime : 2005-5-13 22:53
' Author : Lingll
' Purpose : 调用 SeekFold ,SeekFile
'---------------------------------------------------------------------------------------
Public Sub SeekFavoriteFolder( _
ByVal newFold As String, hMainMnu As Long, Optional extPos As Integer = 0, _
Optional NotRoot As Boolean = True, Optional hParent&)
Call SeekFolder(newFold, hMainMnu, extPos, NotRoot, hParent)
Call SeekFile(newFold, hMainMnu, extPos, NotRoot, hParent)
End Sub
Private Sub SeekFolder(ByVal newFold As String, hMainMnu As Long, Optional extPos As Integer = 0, _
Optional NotRoot As Boolean = True, Optional hParent&)
Dim i As Integer
Dim hSubMnu As Long
Dim tmpStr As String
'Dim tmpNode As Node
Dim hNode&
Dim tFolders() As String
Dim tFldCnt As Long
If Right(newFold, 1) <> "" Then
newFold = newFold & ""
End If
Call FindFilesAPI(newFold, "*", tFldCnt, tFolders, False, gFavoriteShowHidden = 1)
SortString tFolders, 1, tFldCnt, True
For i = 1 To tFldCnt
tmpStr = tFolders(i)
hSubMnu = CreatePopupMenu
SetMenuParam hSubMnu, MenuData_FavoriteMenu
If Not m_cTvwFav Is Nothing Then
If NotRoot Then
hNode = m_cTvwFav.AddItem(tmpStr, hParent, , 4, 4, 1, subMenuCount + 1)
Else
hNode = m_cTvwFav.AddItem(tmpStr, , , 4, 4, 1, subMenuCount + 1)
End If
End If
Call AppendMenu(hMainMnu, MF_POPUP Or MF_STRING, hSubMnu, Mid2(tmpStr, , MaxMenuCharLength, "..."))
Call gODrawMenu.RstMenu(hMainMnu, i + extPos - 1, , ImgIx_Icon_Folder, ImgIx_Icon_Folder_Open, , , "fav")
subMenuCount = subMenuCount + 1
If subMenuCount > Max_subMenuCount Then
Max_subMenuCount = Max_subMenuCount + 10
ReDim Preserve loadSubInfo(0 To Max_subMenuCount)
End If
With loadSubInfo(subMenuCount)
.Title = tmpStr
.hWnd = hSubMnu
.path = newFold & tFolders(i)
.isLoadSub = False
.hNode = hNode
End With
'递归调用
'Call SeekFold(newFold & tFolders(i), hSubMnu, , , hNode)
Next
AppendMenu hMainMnu, MF_SEPARATOR, 0&, ""
AppendMenu hMainMnu, MF_STRING, 9998, "打开本层链接"
AppendMenu hMainMnu, MF_STRING, 9999, "分离本层链接"
'Dim i As Integer ', j As Integer
'Dim hSubMnu As Long
''Dim mIf As MENUITEMINFO
'Dim tmpStr As String
''Dim tmpNode As Node
'
'Dim hNode&
'
'Dir1.path = newFold
'
'For i = 0 To Dir1.ListCount - 1
' Dir1.path = newFold
' tmpStr = GetFoldName(Dir1.List(i))
' hSubMnu = CreatePopupMenu
'
' If Not m_cTvwFav Is Nothing Then
' If NotRoot Then
' hNode = m_cTvwFav.AddItem(tmpStr, hParent, , 4, 4, 1, subMenuCount + 1)
' Else
' hNode = m_cTvwFav.AddItem(tmpStr, , , 4, 4, 1, subMenuCount + 1)
' End If
' End If
'
'' If NotRoot Then
'' Set tmpNode = tvwFavorite.Nodes.Add(Dir1.List(-1), tvwChild, Dir1.List(i), tmpStr, ImgK_Icon_Folder) ' "folder")
'' Else
'' Set tmpNode = tvwFavorite.Nodes.Add(, , Dir1.List(i), tmpStr, ImgK_Icon_Folder) ' "folder" )
'' End If
'' tmpNode.Tag = "Root"
'
' Call AppendMenu(hMainMnu, MF_POPUP Or MF_STRING, hSubMnu, Mid2(tmpStr, , MaxMenuCharLength, "..."))
' Call gODrawMenu.RstMenu(hMainMnu, i + extPos, , ImgIx_Icon_Folder, ImgIx_Icon_Folder_Open, , , "fav")
'
'
' subMenuCount = subMenuCount + 1
' If subMenuCount > Max_subMenuCount Then
' Max_subMenuCount = Max_subMenuCount + 10
' ReDim Preserve loadSubInfo(0 To Max_subMenuCount)
' End If
'
'
' With loadSubInfo(subMenuCount)
' .Title = tmpStr
' .hwnd = hSubMnu
' .path = Dir1.List(i)
' .isLoadSub = False
' .hNode = hNode
' End With
'
' '递归调用
' 'Call SeekFold(Dir1.List(i), hSubMnu)
' Call SeekFold(Dir1.List(i), hSubMnu, , , hNode)
'Next
'AppendMenu hMainMnu, MF_SEPARATOR, 0&, ""
'AppendMenu hMainMnu, MF_STRING, 9998, "打开本层链接"
'AppendMenu hMainMnu, MF_STRING, 9999, "分离本层链接"
'
End Sub
Public Sub favConet(newUrl As String, Optional newWindow As Boolean = True)
If newWindow Or loadedBrowserCount < 1 Then
Call NewWebbrowser(newUrl)
Else
webbState(gActiveWebIndex).webForm.Navigate newUrl, False
End If
End Sub
Public Sub SeekFile(ByVal newFold As String, hMainMnu As Long, Optional extPos As Integer = 0, _
Optional NotRoot As Boolean = True, Optional hParent&)
On Error Resume Next
Dim tmpName As String, j&
Dim tIniFile As cINIFile
Dim tMenuCnt As Long
Dim tFiles() As String
Dim tFleCnt As Long
Set tIniFile = New cINIFile
If Right$(newFold, 1) <> "" Then
newFold = newFold & ""
End If
Call FindFilesAPI(newFold, "*.url", tFleCnt, tFiles, True, gFavoriteShowHidden = 1)
SortString tFiles, 1, tFleCnt, True
For j = 1 To tFleCnt
itemMenuCount = itemMenuCount + 1
If itemMenuCount > Max_itemMenuCount Then
Max_itemMenuCount = Max_itemMenuCount + 50
ReDim Preserve favoriteInfo(0 To Max_itemMenuCount)
End If
tmpName = Left$(tFiles(j), Len(tFiles(j)) - 4)
With favoriteInfo(itemMenuCount)
.path = newFold & tFiles(j)
.Title = tmpName
.hSubMenu = hMainMnu
End With
Call InsertMenu(hMainMnu, extPos + j - 1, MF_BYPOSITION Or MF_STRING, itemMenuCount + MenuIDOffset, Mid2(tmpName, , MaxMenuCharLength, "..."))
Call gODrawMenu.RstMenu(hMainMnu, CLng(extPos + j - 1), , ImgIx_Icon_Url, , , , "fav")
favoriteInfo(itemMenuCount).url = tIniFile.ReadKey("InternetShortcut", "URL", "", newFold & tFiles(j))
If Not m_cTvwFav Is Nothing Then
If NotRoot Then
m_cTvwFav.AddItem tmpName, hParent, , 6, 6, 0, itemMenuCount
Else
m_cTvwFav.AddItem tmpName, , , 6, 6, 0, itemMenuCount
End If
End If
' If NotRoot Then
' Set tmpNode = tvwFavorite.Nodes.Add(newFold, tvwChild, tmpNewFold + File1.List(j), tmpName, "url")
' Else
' Set tmpNode = tvwFavorite.Nodes.Add(, , tmpNewFold + File1.List(j), tmpName, ImgK_Icon_Url) ' "url")
' End If
' tmpNode.Tag = favoriteInfo(itemMenuCount).Url
Next
tMenuCnt = GetMenuItemCount(hMainMnu)
If (tMenuCnt <= 3) And NotRoot Then
Call InsertMenu(hMainMnu, 0, MF_BYPOSITION Or MF_STRING, 0, "(空)")
For j = 0 To tMenuCnt
Call EnableMenuItem(hMainMnu, j, MF_BYPOSITION Or MF_GRAYED)
Next j
End If
If gFavoriteSinglLineMenu = 0 Then
Call BreakMenu(hMainMnu)
End If
'Dim tmpName As String, j As Integer ', n As Integer
'Dim tmpNewFold As String
''Dim tmpNode As Node
'Dim tIniFile As cINIFile
'Set tIniFile = New cINIFile
'
'File1.path = newFold
'File1.Refresh
'For j = 0 To File1.ListCount - 1
' itemMenuCount = itemMenuCount + 1
' If itemMenuCount > Max_itemMenuCount Then
' Max_itemMenuCount = Max_itemMenuCount + 50
' ReDim Preserve favoriteInfo(0 To Max_itemMenuCount)
' End If
'
'
' tmpName = File1.List(j)
' With favoriteInfo(itemMenuCount)
' .path = tmpName
' tmpName = Mid(tmpName, 1, Len(tmpName) - 4)
' .Title = tmpName
' .hSubMenu = hMainMnu
' End With
'
' Call InsertMenu(hMainMnu, extPos + j, MF_BYPOSITION Or MF_STRING, itemMenuCount + MenuIDOffset, Mid2(tmpName, , MaxMenuCharLength, "..."))
'
' Call gODrawMenu.RstMenu(hMainMnu, CLng(extPos + j), , ImgIx_Icon_Url, , , , "fav")
'
' favoriteInfo(itemMenuCount).Url = tIniFile.ReadKey("InternetShortcut", "URL", "", File1.path + "" + File1.List(j))
'
'
'
' If Right(newFold, 1) <> "" Then tmpNewFold = newFold + "" Else tmpNewFold = newFold
' favoriteInfo(itemMenuCount).path = tmpNewFold & File1.List(j)
'
' If Not m_cTvwFav Is Nothing Then
' If NotRoot Then
' m_cTvwFav.AddItem tmpName, hParent, , 6, 6, 0, itemMenuCount
' Else
' m_cTvwFav.AddItem tmpName, , , 6, 6, 0, itemMenuCount
' End If
' End If
'
'' If NotRoot Then
'' Set tmpNode = tvwFavorite.Nodes.Add(newFold, tvwChild, tmpNewFold + File1.List(j), tmpName, "url")
'' Else
'' Set tmpNode = tvwFavorite.Nodes.Add(, , tmpNewFold + File1.List(j), tmpName, ImgK_Icon_Url) ' "url")
'' End If
'' tmpNode.Tag = favoriteInfo(itemMenuCount).Url
'
'Next
'
'Dim tmpCount As Long
'If GetMenuItemCount(hMainMnu) < 1 And NotRoot Then
' Call AppendMenu(hMainMnu, MF_BYPOSITION, 0, "(空)")
' Call EnableMenuItem(hMainMnu, 0, MF_BYPOSITION + MF_GRAYED)
'
'End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : BreakMenu
' DateTime : 2005-4-19 22:54
' Author : Lingll
' Purpose :
'---------------------------------------------------------------------------------------
Private Sub BreakMenu(vHMenu&)
Dim tMH&
Dim tScH&, tMaxItem&
Dim tForCnt&
Dim tMenuCnt&
Dim i&
tMenuCnt = GetMenuItemCount(vHMenu)
tMH = GetMenuItemHeight
tScH = GetSystemMetrics(SM_CYSCREEN) - 50
tMaxItem = Int(tScH / tMH)
For i = tMaxItem - 1 To tMenuCnt - 1 Step tMaxItem
SetMenuType vHMenu, i, 1, MFT_MENUBARBREAK, MFT_MENUBARBREAK
Next i
End Sub
Public Function NewWebbrowser( _
Optional ByVal newUrl As String = "", _
Optional nForm As frmBrowser = Nothing, _
Optional nNewWinodwInBack As Boolean = False, _
Optional nEnableNewInBack As Boolean = False, _
Optional nTabIndex& = -1, _
Optional noNavigate As Boolean = False _
) As Long
On Error GoTo due:
Dim i As Long, j As Long
'判断是否用newurl做连接
Dim useUrl As Boolean
Dim newB As frmBrowser
If nEnableNewInBack Then
Else
nNewWinodwInBack = (isLockPresentWeb = 1) Or vkPress(VK_CONTROL)
End If
If loadedBrowserCount >= browserCount Then
MsgBox "max limit"
Exit Function
End If
useUrl = (nForm Is Nothing)
If nForm Is Nothing Then
newUrl = Trim$(newUrl)
If newUrl = "" Then newUrl = "about:blank"
Set newB = New frmBrowser
Load newB
'Call newB.Navigate(newUrl, False)
' If newB.Navigate2(newUrl) Then
' Else
' Unload newB
' Exit Function
' End If
Else
Set newB = nForm
End If
For i = 1 To browserCount
'If Not webbState(i).isLoaded Then
If webbState(i) Is Nothing Then
'webbState(i).isLoaded = True
Set webbState(i) = New cLBrowser
webbState(i).IniMe TabBar, newB
'webbState(i).tabOrder = loadedBrowserCount + 1
' If nForm Is Nothing Then
' Set newB = New frmBrowser
' Else
' Set newB = nForm
' End If
'newB.CanNotShow = False
' === controls no use ==========
' Load cochkButton(i) '提前加载，避免 frmBrowser.FormActive() 出错
' =====================================
Set webbState(i).TabBtn = TabBar.Add("", cbtsCheck, i, , nTabIndex)
newB.tagIndex = i
Dim tPreState&
If loadedBrowserCount <= 0 Then
ShowWindow newB.hWnd, SW_SHOWMAXIMIZED
Else
'If isLockPresentWeb = 1 Or vkPress(VK_CONTROL) Then
tPreState = webbState(gActiveWebIndex).webForm.WindowState
nNewWinodwInBack = nNewWinodwInBack And (tPreState <> vbMinimized)
If nNewWinodwInBack Then
Dim preHwnd As Long
preHwnd = webbState(gActiveWebIndex).webForm.hWnd
If Not newB.HaveSetRect Then
If tPreState = vbNormal Then
ShowWindow newB.hWnd, SW_SHOWNOACTIVATE
Else
NOExeActive = True
'newB.NoActive = True
SendMessageLng hMDIClient, WM_SETREDRAW, 0&, ByVal 0&
ShowWindow newB.hWnd, SW_MAXIMIZE
End If
'SetWindowPos newB.hwnd, preHwnd, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE
BringWindowToTop preHwnd
SendMessageLng hMDIClient, WM_SETREDRAW, 1&, ByVal 0&
NOExeActive = False
Else
SetWindowPos newB.hWnd, preHwnd, 0, 0, newB.GetSetWinWidth, newB.GetSetWinHeight, SWP_NOMOVE Or SWP_SHOWWINDOW Or SWP_NOACTIVATE
End If
Else
If Not newB.HaveSetRect Then
If tPreState = vbNormal Then
ShowWindow newB.hWnd, SW_SHOWNORMAL
Else
ShowWindow newB.hWnd, SW_SHOWMAXIMIZED
End If
BringWindowToTop newB.hWnd
Else
SetWindowPos newB.hWnd, HWND_TOP, 0, 0, newB.GetSetWinWidth, newB.GetSetWinHeight, SWP_NOMOVE Or SWP_SHOWWINDOW
End If
End If
End If
Set webbState(i).webForm = newB
' webbState(i).isFirst = 1
'webbState(i).fontSize = 2
' ======== controls no use ==================
' Dim tmpOptLeft As Single
' Dim tmpOptIndex As Single
' tmpOptLeft = -cochkButton(tmpOptIndex).pWidth
'
' For j = 1 To browserCount
' If webbState(j).isLoaded And j <> i Then
' If tmpOptLeft < cochkButton(j).pLeft Then
' tmpOptLeft = cochkButton(j).pLeft
' tmpOptIndex = j
' End If
' End If
' Next
'
'
'
' cochkButton(i).pVisible = False
' cochkButton(i).CreateFace
' 'Set cochkButton(i).PictureIN = ProgressIcon(0)
' With cochkButton(i)
' .pLeft = tmpOptLeft + cochkButton(tmpOptIndex).pWidth
' '.pVisible = True
' End With
' ======================================================
'If isLockPresentWeb = 0 And Not vkPress(VK_CONTROL) Then
If Not nNewWinodwInBack Then
'If loadedBrowserCount > 0 Then cochkButton(gActiveWebIndex).Checked = False
'lstOrder.AddItem i, 0
gActiveWebIndex = i
' cochkButton(i).Checked = True
Else
If loadedBrowserCount > 0 Then
'cochkButton(gActiveWebIndex).Checked = True
'lstOrder.AddItem i, 1
'cochkButton(i).Checked = False
Else
'lstOrder.AddItem i
'cochkButton(i).Checked = True
gActiveWebIndex = i
End If
End If
'======= control no use ============
'Set webbState(i).webTab = cochkButton(i)
'===================================
Exit For
End If
Next i
If useUrl And (Not noNavigate) Then
'newB.webMe.Navigate2 newUrl
Call newB.Navigate(newUrl, False)
End If
'If useUrl Then
' newUrl = Trim$(newUrl)
' If newUrl = "" Then newUrl = "about:blank"
' newB.Navigate newUrl
'End If
'On Error Resume Next
'wbbMe(i).ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(2)
loadedBrowserCount = loadedBrowserCount + 1
fraHoldOpt.width = tabLength * loadedBrowserCount
Call refreshTab
Call EnableButtons
isTabClick = True
NewWebbrowser = i
Exit Function
due:
ErrorLog.AddLog "new window" & Chr(9) & Err.Description & Str(Err.Number)
Resume Next
End Function
Private Sub resizeFramFravorite()
On Error Resume Next
'Dim tRight&
With pctHoldFavorite
.Left = 0
.Top = 0
.width = pctSideBar.width - fraMove.width
.height = pctSideBar.height
End With
fraMove.Left = pctHoldFavorite.width
fraMove.height = pctSideBar.height
fraMove.Top = 0 ' -fraFavorite.Height
End Sub
'---------------------------------------------------------------------------------------
' Procedure : RefreshFavorite
' DateTime : 2005-4-19 18:27
' Author : Lingll
' Purpose : 刷新收藏夹
' vLevel=0,不更新根路径,1,全面刷新
'---------------------------------------------------------------------------------------
Public Sub RefreshFavorite(Optional vLevel As Long = 1)
Dim i As Long, menu_Count As Long
Dim tPath As String * MAX_PATH
Max_itemMenuCount = 500
Max_subMenuCount = 100
If vLevel = 1 Then
If gFavoriteUseDefaultPath Then
Call SHGetSpecialFolderPathW(0&, tPath, CSIDL_FAVORITES, 0)
favoritePath = SysAllocString(StrPtr(tPath))
Else
favoritePath = gFavoriteCustomPath
End If
End If
If m_cTvwFav Is Nothing Then
Call IniFavoriteTree
Else
m_cTvwFav.Clear
End If
'tvwFavorite.Nodes.Clear
gODrawMenu.RemoveMulODMenu "fav"
menu_Count = GetMenuItemCount(hMnuFavorite)
For i = menu_Count - 1 To FavoriteMenuPosOffset Step -1
DeleteMenu hMnuFavorite, i, MF_BYPOSITION
Next
ReDim loadSubInfo(0 To Max_subMenuCount)
ReDim favoriteInfo(0 To Max_itemMenuCount)
subMenuCount = 0
itemMenuCount = 0
loadSubInfo(0).isLoadSub = False
loadSubInfo(0).hWnd = hMnuFavorite
loadSubInfo(0).path = favoritePath
loadSubInfo(0).Title = "收藏"
'Call SeekFold(favoritePath, hMnuFavorite, FavoriteMenuPosOffset, False)
'Call SeekFavoriteFolder(favoritePath, hMnuFavorite, FavoriteMenuPosOffset, False)
'Call mnuFavorite_Click
End Sub
Private Sub SaveProxy()
Dim i&
Dim tStg As cStorage
Set tStg = New cStorage
If tStg.OpenFile(AppPath & File_Config, StgName_Proxy) Then
tStg.PutInteger proxyDataCount
For i = 1 To proxyDataCount
tStg.WriteString proxyData(i).proxyName, 2
tStg.WriteString proxyData(i).address, 2
tStg.WriteString proxyData(i).port, 1
tStg.PutInteger proxyData(i).isByPass, 1
tStg.WriteString proxyData(i).bypass
Next i
tStg.CloseFile
End If
End Sub
'========================================================
'Private Sub SaveProxy()
'Dim i&
'Dim tFile As cBinaryFile
'Set tFile = New cBinaryFile
'
'
'Dim hFile As Long
'On Error GoTo drr
'
'Name AppPath & "proxy.dat" As AppPath & "proxy.bak"
'hFile = FreeFile
'With tFile
' .OpenFile AppPath & "proxy.dat"
' .PutLng proxyDataCount
' For i = 1 To proxyDataCount
' .WriteStringInt proxyData(i).proxyName
' .WriteStringInt proxyData(i).address
' .WriteStringByt proxyData(i).port
' .PutByte proxyData(i).isByPass
' .WriteStringLng proxyData(i).bypass
'
' Next i
' .CloseFile
'End With
''Open fullpath + "proxy.dat" For Binary As hFile 'Len = Len(proxyData(0))
'' Put hFile, , proxyDataCount
'' If proxyDataCount > 0 Then
'' Dim i As Integer
'' For i = 1 To proxyDataCount
''
'' Put hFile, , proxyData(i)
'' Next
'' End If
''Close hFile
'
'Exit Sub
'
'drr:
'If Err.Number = 58 Then
' Kill AppPath & "proxy.bak"
' Resume
' ElseIf Err.Number = 53 Then
' Resume Next
'End If
'End Sub
Private Sub refreshTab()
If fraHoldOpt.width > pctTabs.width Then
If tabsPos > 1 Then
'myButtonGoLeft.pVisible = True
pctTabGoLeft.Visible = True
'myButtonGoLeft.TipText = "左面还有" & LTrim(Str(tabsPos - 1)) & "个页面"
TabGoLeftBar.Buttons(1).tiptext = "左面还有" & LTrim(Str(tabsPos - 1)) & "个页面"
fraHoldOpt.Left = -tabLength * (tabsPos - 1) + mTabGoLRWidth * 15 ' myButtonGoLeft.pWidth
Else
timerMoveTab.Enabled = False
'myButtonGoLeft.pVisible = False
pctTabGoLeft.Visible = False
fraHoldOpt.Left = 0
End If
If fraHoldOpt.width + fraHoldOpt.Left > pctTabs.width Then
'With myButtonGoRight
'.pVisible = True
pctTabGoRight.Visible = True
Dim rTabCount As Long
rTabCount = (fraHoldOpt.width + fraHoldOpt.Left - pctTabs.width) / tabLength
TabGoRightBar.Buttons(1).tiptext = "右面还有" & LTrim(Str(rTabCount)) & "个页面"
'.pLeft = pctTabs.width - .pWidth
pctTabGoRight.Left = pctTabs.width - mTabGoLRWidth * 15
'End With
Else
'myButtonGoRight.pVisible = False
pctTabGoRight.Visible = False
timerMoveTab.Enabled = False
End If
Else
' myButtonGoLeft.pVisible = False
' myButtonGoRight.pVisible = False
pctTabGoLeft.Visible = False
pctTabGoRight.Visible = False
timerMoveTab.Enabled = False
fraHoldOpt.Left = 0
tabsPos = 1
End If
End Sub
'关闭被选择的页面
Private Sub CloseMulTab(Optional isInvert As Boolean = False)
Dim i As Long
Dim canCall As Boolean
For i = 1 To browserCount
'If webbState(i).isLoaded Then
If Not webbState(i) Is Nothing Then
' canCall = (webbState(i).webTab.Selected Or i = gActiveWebIndex) Xor isInvert
'canCall = webbState(i).webTab.Selected Xor isInvert
canCall = webbState(i).TabBtn.Selected Xor isInvert
If canCall Then
Call UnloadBrowser(i)
End If
End If
Next i
End Sub
Public Sub popMenuLockToolBar()
'Me.PopupMenu mnuToolBar ' mnuCbrPopMenu
pMnu_ViewToolbar.Popup2 Me.hWnd, , , , TPM_LEFTALIGN
End Sub
'Private Function load_close_menu(Url As String, Title As String) As Boolean
''If LCase(Url) = "about:blank" Or Url = "" Then Exit Function
''Dim canAdd As Boolean
''Dim repeatIndex As Integer
''Dim i As Integer
''If Trim(Title) = "" Then Title = Url
''Title = CutString(Title, 30, " ...")
''repeatIndex = 0
''For i = 1 To re_closepage_count
'' If Url = mnuRecent_ClosePage(i).Tag And Title = mnuRecent_ClosePage(i).Caption Then
'' repeatIndex = i
'' Exit For
'' End If
''Next
''
''
''
''If repeatIndex = 0 Then
'' re_closepage_count = re_closepage_count + 1
'' If re_closepage_count > max_re_closepage Then re_closepage_count = max_re_closepage
'' repeatIndex = re_closepage_count
''End If
''
''For i = repeatIndex To 2 Step -1
'' mnuRecent_ClosePage(i).Tag = mnuRecent_ClosePage(i - 1).Tag
'' mnuRecent_ClosePage(i).Caption = mnuRecent_ClosePage(i - 1).Caption
'' mnuRecent_ClosePage(i).Visible = True
''Next i
''
''mnuRecent_ClosePage(1).Visible = True
''mnuRecent_ClosePage(1).Tag = Url
''mnuRecent_ClosePage(1).Caption = Title
''mnuRecent_ClosePage(1).Visible = True
''If re_closepage_count > 0 Then mnuRecent_ClosePage(0).Visible = False
''
'''Dim tButton As MSComctlLib.Button, tButtonMenu As MSComctlLib.ButtonMenu
'''Set tButton = tlbMe.Buttons(TbrK_Main_RecentClose)
'''tButton.ButtonMenus.Clear
'''pMnu_Reopen.ClearItems
''
'''For i = 0 To re_closepage_count
''' If mnuRecent_ClosePage(i).Visible Then
''' pMnu_Reopen.Add mnuRecent_ClosePage(i).Caption
'''
''' 'Set tButtonMenu = tButton.ButtonMenus.Add(, , mnuRecent_ClosePage(i).Caption)
''' 'tButtonMenu.Tag = mnuRecent_ClosePage(i).Tag
''' End If
'''Next i
''
'''If re_closepage_count > 0 Then
''' tButton.Image = "RecentCloseFull"
''' MoveWindow myRebar.hWnd, 0, 0, 100, 100, True
'''Else
''' tButton.Image = "RecentCloseEmpty"
'''End If
'End Function
Public Sub NextLastTab(ByVal movenext As Boolean)
Dim t_int As Integer, i As Integer
If movenext Then
't_int = webbState(gActiveWebIndex).tabOrder + 1
t_int = webbState(gActiveWebIndex).TabBtn.index + 1
If t_int > loadedBrowserCount Then t_int = 1
Else
't_int = webbState(gActiveWebIndex).tabOrder - 1
t_int = webbState(gActiveWebIndex).TabBtn.index - 1
If t_int < 1 Then t_int = loadedBrowserCount
End If
For i = 1 To browserCount
'If webbState(i).isLoaded Then
If Not webbState(i) Is Nothing Then
'If webbState(i).tabOrder = t_int Then
If webbState(i).TabBtn.index = t_int Then
' webbState(i).webForm.ZOrder
Call SwitchTabs(i)
End If
End If
Next i
End Sub
Private Sub UnloadBrowsers(ByVal orderBegin As Integer, ByVal orderEnd As Integer)
On Error GoTo due:
If orderBegin > orderEnd Then Exit Sub
Dim i As Integer
Dim tLen As Integer
Dim tLstI As Integer
tLen = orderEnd - orderBegin + 1
For i = 1 To browserCount
If Not webbState(i) Is Nothing Then
If Not webbState(i).Hided Then
If webbState(i).TabBtn.index >= orderBegin And webbState(i).TabBtn.index <= orderEnd Then
ClosedPages.Add webbState(i).webForm.GetWebTitle, webbState(i).webForm.GetWebUrl
isUnloadByFunction = True
Unload webbState(i).webForm
Set webbState(i).webForm = Nothing
webbState(i).Tag = "ul"
End If
End If
End If
Next i
For i = 1 To browserCount
If Not webbState(i) Is Nothing Then
If webbState(i).Tag = "ul" Then
TabBar.RemoveByIndex webbState(i).TabBtn.index
Set webbState(i) = Nothing
End If
End If
Next i
loadedBrowserCount = loadedBrowserCount - tLen
'For i = loadedBrowserCount - 1 To 0 Step -1
' tLstI = CInt(lstOrder.List(i))
' 'If webbState(tLstI).tabOrder >= orderBegin And webbState(tLstI).tabOrder <= orderEnd Then
' 'If webbState(tLstI).tabOrder = 0 Then
' 'If Not webbState(tLstI).isLoaded Then
' If Not webbState(tLstI) Is Nothing Then
' If webbState(tLstI).Tag = "1" Then
' Debug.Print "tlsti:"; tLstI
' TabBar.RemoveByIndex webbState(tLstI).TabBtn.index
' 'TabBar.RemoveByButtonObj webbState(tLstI).TabBtn
' Set webbState(tLstI).TabBtn = Nothing
'
' lstOrder.RemoveItem i
'
' Set webbState(tLstI) = Nothing
' End If
' End If
'Next i
'loadedBrowserCount = loadedBrowserCount - tLen
fraHoldOpt.width = tabLength * loadedBrowserCount
'gActiveWebIndex = lstOrder.List(0)
'Debug.Print "lstOrder.ListCount:"; lstOrder.ListCount
'webbState(CInt(lstOrder.List(0))).webForm.ZOrder
Call refreshTab
Call EnableButtons
Exit Sub
due:
ErrorLog.AddLog "unloadBrowsers" & Chr(9) & Err.Description & Str(Err.Number)
Resume Next
End Sub
'Private Function CutString(nStr As String, nBits As Long, Add As String) As String
'Dim tstr As String
'tstr = StrConv(nStr, vbFromUnicode)
'If LenB(tstr) > nBits Then
' CutString = StrConv(LeftB(tstr, nBits), vbUnicode) & Add
'Else
' CutString = nStr
'End If
'
'End Function
Private Sub SavePagez() 'Optional nFile As String = "")
Dim i As Long
Dim turl As String
Dim n As Long
Dim tIni As cINIFile
Set tIni = New cINIFile
With tIni
.IniFile = AppPath & MainIniName
.DeleteSection "PageGroupTmp"
.WriteKey "PageGroupTmp", "Count", Str$(loadedBrowserCount)
n = 0
For i = 1 To browserCount
'If webbState(i).isLoaded Then
If Not webbState(i) Is Nothing Then
n = n + 1
turl = webbState(i).webForm.GetWebUrl
.WriteKey "PageGroupTmp", "URL" & LTrim$(Str(n)), turl
End If
Next i
End With
End Sub
Private Sub LoadPagez() 'Optional nFile As String = "")
'Dim fn As Long
Dim i As Long
'Dim tLen As Long
Dim turl As String
Dim pageCnt&
'If nFile = "" Then
' nFile = App.Path & "pages.dat"
'End If
'fn = FreeFile
'Open nFile For Binary As fn
' Get fn, , pageCnt
' For i = 1 To pageCnt
' Get fn, , tLen
' tUrl = StrConv(InputB(tLen, fn), vbUnicode)
' Call NewWebbrowser(tUrl)
' Next i
'Close fn
'
Dim tIni As cINIFile
Set tIni = New cINIFile
With tIni
.IniFile = AppPath & MainIniName
pageCnt = Val(LTrim(.ReadKey("PageGroupTmp", "Count", "0")))
Debug.Print pageCnt
For i = 1 To pageCnt
turl = .ReadKey("PageGroupTmp", "URL" & LTrim(Str(i)), "about:blank")
Call NewWebbrowser(turl)
Next i
End With
End Sub
'========= begin ======== 最近访问的收藏 ==============
Public Sub ClickFavorite(nTitle As String, ByVal nUrl As String)
Const iniMark& = 20
'Const addMark& = 3
'Const addMark2& = 2
'Const addMarkTop& = 1
Const subMark& = 1
Const addRuleCnt& = 4
Dim addMark(0 To addRuleCnt - 1) As Long
Dim addMarkPos(0 To addRuleCnt - 1) As Long
addMark(0) = 4
addMark(1) = 3
addMark(2) = 2
addMark(3) = 1
addMarkPos(0) = 0
addMarkPos(1) = 30
addMarkPos(2) = 50
addMarkPos(3) = 60
Dim i&, j&, index&, ti&, clickUrlIndex&
Dim isNewUrl As Boolean, firstBiger As Boolean
isNewUrl = True
nUrl = Trim(nUrl)
For i = 1 To moreFavCount
If moreFavorite(moreFavOrder(i)).mark > -1 Then
If nUrl = moreFavorite(moreFavOrder(i)).url Then
isNewUrl = False
index = i
Exit For
End If
End If
Next i
If isNewUrl Then
moreFavCount = moreFavCount + 1
ReDim Preserve moreFavorite(0 To moreFavCount)
ReDim Preserve moreFavOrder(0 To moreFavCount)
With moreFavorite(moreFavCount)
.mark = iniMark
.Title = nTitle
.url = nUrl
End With
moreFavOrder(moreFavCount) = moreFavCount
firstBiger = True
For i = moreFavCount - 1 To 1 Step -1
ti = moreFavOrder(i)
If moreFavorite(ti).mark > -1 Then
moreFavorite(ti).mark = moreFavorite(ti).mark - subMark
If moreFavorite(ti).mark <= iniMark And moreFavorite(ti).mark > -1 Then
moreFavOrder(i + 1) = ti
moreFavOrder(i) = moreFavCount
ElseIf moreFavorite(ti).mark > iniMark And firstBiger Then
moreFavOrder(i + 1) = moreFavCount
firstBiger = False
End If
End If
If moreFavorite(ti).mark < 0 And firstBiger Then
moreFavOrder(i + 1) = ti
moreFavOrder(i) = moreFavCount
End If
Next i
Else
'If index > 1 Then
clickUrlIndex = moreFavOrder(index)
For i = moreFavCount To 1 Step -1
ti = moreFavOrder(i)
If i <> index Then
If moreFavorite(ti).mark > -1 Then
moreFavorite(ti).mark = moreFavorite(ti).mark - subMark
End If
Else
For j = addRuleCnt - 1 To 0 Step -1
If moreFavorite(ti).mark >= addMarkPos(j) Then
moreFavorite(ti).mark = moreFavorite(ti).mark + addMark(j)
Exit For
End If
Next j
' If index > 2 Then
' moreFavorite(Ti).mark = moreFavorite(Ti).mark + addMark
' ElseIf index > 1 Then
' moreFavorite(Ti).mark = moreFavorite(Ti).mark + addMark2
' Else
' moreFavorite(Ti).mark = moreFavorite(Ti).mark + addMarkTop
' End If
End If
If i < index Then
If moreFavorite(ti).mark < moreFavorite(clickUrlIndex).mark Then
moreFavOrder(i + 1) = ti
moreFavOrder(i) = clickUrlIndex
End If
End If
Next i
'End If
End If
Call RefreshMoreFavMenu
End Sub
Private Sub RefreshMoreFavMenu()
On Error GoTo due
Dim i&, ti&, tcnt&
'tcnt = SMenus.Count
'For i = tcnt To 1 Step -1
' If SMenus(i).Tag = "mfa" Then
' SMenus.Remove i
' End If
'Next i
gODrawMenu.RemoveMulODMenu "mfa"
'mnuRecent_MoreFav(0).Visible = True
'For i = 1 To moreFavMenuCount
' 'Unload mnuRecent_MoreFav(i)
' SMenus.Remove "fav" & Str(i)
'Next i
moreFavMenuCount = 0
pMnu_MoreFavorite.ClearItems
If moreFavCount > 0 Then
For i = 1 To moreFavCount
ti = moreFavOrder(i)
If moreFavorite(ti).mark > -1 Then
moreFavMenuCount = moreFavMenuCount + 1
pMnu_MoreFavorite.Add Mid2(moreFavorite(ti).Title, , 30, " ..."), , ti + IdOffset_MoreFavorite
' Load mnuRecent_MoreFav(moreFavMenuCount)
' With mnuRecent_MoreFav(moreFavMenuCount)
' .Enabled = True
' .Visible = True
' .Caption = Mid2(moreFavorite(ti).Title, , 30, " ...") '& Str(moreFavorite(Ti).mark)
' .Tag = moreFavorite(ti).Url
' End With
gODrawMenu.RstMenu hMnuMoreFav, moreFavMenuCount - 1, "", ImgIx_Icon_Url, , , , "mfa"
End If
Next i
Else
pMnu_MoreFavorite.Add "空", pmsString Or pmsDisabled
End If
pMnu_MoreFavorite.Add "", pmsSeparator
pMnu_MoreFavorite.Add "清空", , IDM_Main_Favorite_MoreFavs_Clear
'If moreFavMenuCount > 0 Then
' mnuRecent_MoreFav(0).Visible = False
' mnuFavorite_MoreFavs_Clear.Visible = True
' mnuFavorite_MoreFavs_none1.Visible = True
'Else
' mnuRecent_MoreFav(0).Visible = True
' mnuFavorite_MoreFavs_Clear.Visible = False
' mnuFavorite_MoreFavs_none1.Visible = False
'End If
'If moreFavCount > 0 Then
' For i = 1 To moreFavCount
' ti = moreFavOrder(i)
' If moreFavorite(ti).mark > -1 Then
' moreFavMenuCount = moreFavMenuCount + 1
' Load mnuRecent_MoreFav(moreFavMenuCount)
' With mnuRecent_MoreFav(moreFavMenuCount)
' .Enabled = True
' .Visible = True
' .Caption = Mid2(moreFavorite(ti).Title, , 30, " ...") '& Str(moreFavorite(Ti).mark)
' .Tag = moreFavorite(ti).Url
' End With
' 'RstMenu hMnuMoreFav, i, "fav" & Str(i), ImgK_Icon_Url
' End If
' Next i
'End If
'If moreFavMenuCount > 0 Then
' mnuRecent_MoreFav(0).Visible = False
' mnuFavorite_MoreFavs_Clear.Visible = True
' mnuFavorite_MoreFavs_none1.Visible = True
'Else
' mnuRecent_MoreFav(0).Visible = True
' mnuFavorite_MoreFavs_Clear.Visible = False
' mnuFavorite_MoreFavs_none1.Visible = False
'End If
Exit Sub
due:
ErrorLog.AddLog "RefreshMoreFavMenu" & Chr(9) & Err.Description & Chr(9) & Err.Number
Resume Next
End Sub
Private Sub SaveMoreFavInfo()
Dim tStg As cStorage
Dim i&, ti&
Dim tMenuCnt&
tMenuCnt = 0
Set tStg = New cStorage
If tStg.OpenFile(AppPath & File_Config, StgName_MoreFav) Then
tStg.PutInteger tMenuCnt
For i = 1 To moreFavCount
ti = moreFavOrder(i)
If moreFavorite(ti).mark > -1 Then
tMenuCnt = tMenuCnt + 1
tStg.PutInteger moreFavorite(ti).mark
tStg.WriteString moreFavorite(ti).Title
tStg.WriteString moreFavorite(ti).url
End If
Next i
tStg.SeekTo 0
tStg.PutInteger tMenuCnt
End If
End Sub
Private Sub LoadMoreFavInfo()
Dim tStg As cStorage
Dim i&
Set tStg = New cStorage
If tStg.OpenFile(AppPath & File_Config, StgName_MoreFav) Then
moreFavCount = tStg.GetInteger()
ReDim moreFavorite(0 To moreFavCount)
ReDim moreFavOrder(0 To moreFavCount)
For i = 1 To moreFavCount
moreFavOrder(i) = i
With moreFavorite(i)
.mark = tStg.GetInteger()
.Title = tStg.GetString()
.url = tStg.GetString()
End With
Next i
tStg.CloseFile
Else
moreFavCount = 0
ReDim moreFavorite(0 To moreFavCount)
ReDim moreFavOrder(0 To moreFavCount)
End If
Call RefreshMoreFavMenu
End Sub
'=========== 最近访问的收藏 =========== End ===============
'=========== begin =========== 搜索列表 ==============
Private Sub LoadSearchurlFromINI()
Dim i&, tIniFile As cINIFile
'Dim IniFile As String
Set tIniFile = New cINIFile
With tIniFile
.IniFile = AppPath & MainIniName
FirstLoadSearchurl = Val(.ReadKey("Search Url", "FirstLoad", "1"))
If FirstLoadSearchurl = 1 Then
SearchurlCount = defSearchCount
ReDim searchUrl(0 To SearchurlCount)
For i = 1 To SearchurlCount
searchUrl(i) = def_searchurl(i)
Next i
FirstLoadSearchurl = 0
Else
SearchurlCount = Val(.ReadKey("Search Url", "Count", "0"))
ReDim searchUrl(0 To SearchurlCount)
For i = 1 To SearchurlCount
searchUrl(i).Title = .ReadKey("Search Url", "Title" & LTrim(Str(i)), "0")
searchUrl(i).url = .ReadKey("Search Url", "URL" & LTrim(Str(i)), "0")
Next i
End If
End With
End Sub
Private Sub SaveSearchurlToINI()
Dim i&, tIniFile As cINIFile
Set tIniFile = New cINIFile
With tIniFile
.IniFile = AppPath & MainIniName
Call .DeleteSection("Search Url")
Call .WriteKey("Search Url", "FirstLoad", Str$(FirstLoadSearchurl))
Call .WriteKey("Search Url", "Count", Str$(SearchurlCount))
'SearchurlCount = Val(.ReadKey("Search Url", "Count", "0"))
For i = 1 To SearchurlCount
Call .WriteKey("Search Url", "Title" & LTrim$(Str(i)), searchUrl(i).Title)
Call .WriteKey("Search Url", "URL" & LTrim$(Str(i)), searchUrl(i).url)
Next i
End With
End Sub
Public Sub LoadSearchurlMenu()
Dim i&
Dim asKey$
For i = 1 To SearchurlCount
If i < 11 Then
asKey = "&" & LTrim$(Str(i Mod 10)) & " "
Else
asKey = " "
End If
mPopmnuTurnTo.Add asKey & searchUrl(i).Title, , i + mOffset_Turnto
' Load mnuTurnTo_Search(i)
'
' mnuTurnTo_Search(i).Caption = asKey & searchUrl(i).Title
Next i
End Sub
Public Sub RemoveSearchurlMenu()
'Dim i&
Call mPopmnuTurnTo.RemoveItems(4, mPopmnuTurnTo.GetItemCount - 1)
'For i = 1 To SearchurlCount
' Unload mnuTurnTo_Search(i)
'Next i
End Sub
'=========== 搜索列表 ============== END ==============
'保存地址栏键盘
Private Sub SaveAddbarKey()
Dim tIniFile As cINIFile
Set tIniFile = New cINIFile
With tIniFile
.IniFile = AppPath & MainIniName
Call .WriteKey("Addbar Key", "Enter", Str(AddBarShortKey_Enter))
Call .WriteKey("Addbar Key", "Shift", Str(AddBarShortKey_Shift))
Call .WriteKey("Addbar Key", "Ctrl", Str(AddBarShortKey_Ctrl))
Call .WriteKey("Addbar Key", "Alt", Str(AddBarShortKey_Alt))
Call .WriteKey("Addbar Key", "CtrlShift", Str(AddBarShortKey_CtrlShift))
Call .WriteKey("Addbar Key", "AltShift", Str(AddBarShortKey_AltShift))
End With
End Sub
'读取地址栏键盘
Private Sub LoadAddbarKey()
Dim tIniFile As cINIFile
Set tIniFile = New cINIFile
With tIniFile
.IniFile = AppPath & MainIniName
AddBarShortKey_Enter = .ReadKey("Addbar Key", "Enter", "-3")
AddBarShortKey_Shift = .ReadKey("Addbar Key", "Shift", "-2")
AddBarShortKey_Ctrl = .ReadKey("Addbar Key", "Ctrl", "0")
AddBarShortKey_Alt = .ReadKey("Addbar Key", "Alt", "0")
AddBarShortKey_CtrlShift = .ReadKey("Addbar Key", "CtrlShift", "0")
AddBarShortKey_AltShift = .ReadKey("Addbar Key", "AltShift", "0")
End With
End Sub
Public Property Get ShowFavorite() As Long ' MSComctlLib.ValueConstants
ShowFavorite = m_ShowFavorite
End Property
'是否显示边栏,显示哪个,
'0,不显示
'>0,显示id(菜单)对应的边栏
'<0,显示
Public Property Let ShowFavorite(ByVal vNewValue As Long) ' MSComctlLib.ValueConstants)
On Error Resume Next
m_ShowFavorite = vNewValue
'm_cTbrMain.CheckButton TbrID_Main_Favorites, m_ShowFavorite = 1
Select Case vNewValue
Case Is <> 0
If vNewValue > 0 Then
m_ShowFavorite = vNewValue
Else
m_ShowFavorite = Abs(m_ShowFavorite)
End If
Call ShowSideband(m_ShowFavorite)
If vNewValue = IDM_Main_View_SideBand_Favorite Then
If Not loadSubInfo(0).isLoadSub Then
Call SeekFavoriteFolder(favoritePath, loadSubInfo(0).hWnd, FavoriteMenuPosOffset, False)
loadSubInfo(0).isLoadSub = True
End If
End If
If FloatFavorite = 1 Then
pctSideBar.Visible = True
Call resizeFramFravorite
Else
frmFloatFavorite.Show , Me
End If
Case 0
m_ShowFavorite = -Abs(m_ShowFavorite)
If FloatFavorite = 1 Then
pctSideBar.Visible = False
Else
frmFloatFavorite.Hide
End If
pMnu_ViewSideBand.UnCheckAll
m_cTbrMain.CheckButton TbrID_Main_Favorites, False
End Select
End Property
'---------------------------------------------------------------------------------------
' Procedure : ShowSideband
' DateTime : 2005-5-31 16:09
' Author : Lingll
' Purpose :
'---------------------------------------------------------------------------------------
Private Sub ShowSideband(id&)
Dim tIndex&, i&
Debug.Print "side band"
tIndex = id - IdOffset_ViewSideBand
For i = 1 To gPluginSBCnt
gPluginsSideBand(i).ShowBand False
Next i
pMnu_ViewSideBand.UnCheckAll
If id = IDM_Main_View_SideBand_Favorite Then
m_cTvwFav.Visible = True
lblSideBand.Caption = "收藏夹"
pMnu_ViewSideBand.CheckItem IDM_Main_View_SideBand_Favorite, True
m_cTbrMain.CheckButton TbrID_Main_Favorites, True
Else
If tIndex > 0 And tIndex <= gPluginSBCnt Then
m_cTvwFav.Visible = False
Call gPluginsSideBand(tIndex).ShowBand(True)
lblSideBand.Caption = gPluginsSideBand(tIndex).Title
pMnu_ViewSideBand.CheckItem id, True
End If
Call m_cTbrMain.CheckButton(TbrID_Main_Favorites, False)
End If
End Sub
Private Sub LoadProxy()
Dim i&
Dim tStg As cStorage
ReDim proxyData(0 To 0)
Set tStg = New cStorage
If tStg.OpenFile(AppPath & File_Config, StgName_Proxy) Then
proxyDataCount = tStg.GetInteger()
ReDim proxyData(0 To proxyDataCount)
For i = 1 To proxyDataCount
proxyData(i).proxyName = tStg.GetString(2)
proxyData(i).address = tStg.GetString(2)
proxyData(i).port = tStg.GetString(1)
proxyData(i).isByPass = tStg.GetInteger(1)
proxyData(i).bypass = tStg.GetString()
Next i
Else
ReDim proxyData(0 To 0)
proxyDataCount = 0
End If
End Sub
'===============================================================
'Private Sub LoadProxy()
'
''ReDim proxyData(0 To 0)
''Dim hFile As Long
''Dim tproxyDataCount As Integer
''hFile = FreeFile
''Open AppPath & "proxy.dat" For Binary As hFile 'Len = Len(proxyData(0))
'' Get hFile, , tproxyDataCount
'' proxyDataCount = tproxyDataCount
'' If proxyDataCount > 0 Then
'' ReDim proxyData(0 To proxyDataCount)
'' Dim i As Integer
'' For i = 1 To proxyDataCount
'' Get hFile, , proxyData(i)
'' With proxyData(i)
'' .proxyName = Replace(.proxyName, vbNullChar, Chr$(32))
'' .address = Replace(.address, vbNullChar, Chr$(32))
'' .bypass = Replace(.bypass, vbNullChar, Chr$(32))
'' .port = Replace(.port, vbNullChar, Chr$(32))
'' End With
'' Next
'' End If
''Close hFile
'
'On Error GoTo due
'
'ReDim proxyData(0 To 0)
''Dim hFile As Long
''hFile = FreeFile
'Dim i&
'Dim tFile As cBinaryFile
'
'Set tFile = New cBinaryFile
'With tFile
' .OpenFile AppPath & "proxy.dat"
' proxyDataCount = .GetLng
' ReDim proxyData(0 To proxyDataCount)
' For i = 1 To proxyDataCount
' .ReadStringInt proxyData(i).proxyName
' .ReadStringInt proxyData(i).address
' .ReadStringLngByt proxyData(i).port
' proxyData(i).isByPass = .GetByte
' .ReadStringLng proxyData(i).bypass
' Next i
'End With
''Open AppPath & "proxy.dat" For Binary As hFile 'Len = Len(proxyData(0))
'' Get hFile, , tproxyDataCount
'' proxyDataCount = tproxyDataCount
'' If proxyDataCount > 0 Then
'' ReDim proxyData(0 To proxyDataCount)
'' Dim i As Integer
'' For i = 1 To proxyDataCount
'' Get hFile, , proxyData(i)
'' With proxyData(i)
'' .proxyName = Replace(.proxyName, vbNullChar, Chr$(32))
'' .address = Replace(.address, vbNullChar, Chr$(32))
'' .bypass = Replace(.bypass, vbNullChar, Chr$(32))
'' .port = Replace(.port, vbNullChar, Chr$(32))
'' End With
'' Next
'' End If
''Close hFile
'Exit Sub
'
'due:
' ReDim proxyData(0 To 0)
' proxyDataCount = 0
'End Sub
Public Sub LoadSettingsFromIni()
'Dim i&, tmpVal&
Dim tIniFile As cINIFile
Set tIniFile = New cINIFile
With tIniFile
.IniFile = AppPath & MainIniName
IsUseProxy = .ReadKey("Proxy", "UseProxy", "1")
ProxySelected = .ReadKey("Proxy", "UseIndex", "0")
isLockPresentWeb = .ReadKey("Other", "LockPresentWeb", "0")
PreventPopWindow = .ReadKey("Other", "PreventPopWindow", "2")
'gOffline = .ReadKey("Other", "Offline", "0")
DragDropSaveImageFolder = .ReadKey("Other", "DragDropSaveImageFolder", "")
DragDropSaveTextFolder = .ReadKey("Other", "DragDropSaveTextFolder", "")
EnableUrlFilter = .ReadKey("Other", "EnableUrlFilter", "1")
gEnablePageRule = .ReadKey("Other", "EnablePageRule", "1")
'收藏夹
gFavoriteUseDefaultPath = .ReadInt("Favorite", "UseDefaultPath", 1)
gFavoriteCustomPath = .ReadKey("Favorite", "CustomPath")
gFavoriteSinglLineMenu = .ReadInt("Favorite", "SinglLineMenu", 1)
gFavoriteShowHidden = .ReadInt("Favorite", "ShowHiddenFile", 0)
ScrollRate = .ReadKey("MouseEvent", "ScrollRate", "2")
ScrollRate2 = .ReadKey("MouseEvent", "ScrollRate2", "4")
RollInvert = .ReadKey("MouseEvent", "RollInvert", "0")
Rollmode = .ReadKey("MouseEvent", "Rollmode", "0")
EnableDragLink = .ReadKey("MouseEvent", "EnableDragLink", "1")
' For i = 0 To mouseEventCount - 1
' mouse_event_prc(i).InsideIndex = CLng(.ReadKey("MouseEvent", "Event" & LTrim$(Str(i)), Str(def_mouse_event(i))))
' Next i
mouse_event_leftright.InsideIndex = CLng(.ReadKey("MouseEvent", "Event_LeftRight", Str(def_mouse_event_leftright)))
mouse_event_rightleft.InsideIndex = CLng(.ReadKey("MouseEvent", "Event_RightLeft", Str(def_mouse_event_rightleft)))
SaveWhenExit = .ReadKey("Other", "SaveWhenExit", "1")
End With
preSaveWhenExit = SaveWhenExit
If proxyDataCount < 0 Then
IsUseProxy = 0
ProxySelected = 0
End If
If ProxySelected > proxyDataCount Then ProxySelected = proxyDataCount
Call LoadSearchurlFromINI
Call LoadDragDropSetting
Call LoadAddbarKey
Call LoadPlugin
End Sub
Public Sub SaveSettingsToIni(Optional nExit As Boolean = True)
Dim tIniFile As cINIFile
If SaveWhenExit = 1 Or (Not nExit) Then
Set tIniFile = New cINIFile
'If mnuNoProxy.Checked Then IsUseProxy = 0 Else IsUseProxy = 1
With tIniFile
.IniFile = AppPath & MainIniName
Call .WriteKey("Proxy", "UseProxy", Str$(IsUseProxy))
Call .WriteKey("Proxy", "UseIndex", Str$(ProxySelected))
Call .WriteKey("Other", "LockPresentWeb", Str$(isLockPresentWeb))
Call .WriteKey("Other", "PreventPopWindow", Str$(PreventPopWindow))
' Call .WriteKey("Other", "Offline", Str$(gOffline))
Call .WriteKey("Other", "DragDropSaveImageFolder", DragDropSaveImageFolder)
Call .WriteKey("Other", "DragDropSaveTextFolder", DragDropSaveTextFolder)
Call .WriteKey("Other", "EnableUrlFilter", Str$(EnableUrlFilter))
Call .WriteKey("Other", "EnablePageRule", Str$(gEnablePageRule))
Call .WriteKey("Favorite", "UseDefaultPath", Str$(gFavoriteUseDefaultPath))
Call .WriteKey("Favorite", "CustomPath", gFavoriteCustomPath)
Call .WriteKey("Favorite", "SinglLineMenu", Str$(gFavoriteSinglLineMenu))
Call .WriteKey("Favorite", "ShowHiddenFile", Str$(gFavoriteShowHidden))
Call .WriteKey("MouseEvent", "ScrollRate", Str$(ScrollRate))
Call .WriteKey("MouseEvent", "ScrollRate2", Str$(ScrollRate2))
Call .WriteKey("MouseEvent", "RollInvert", Str$(RollInvert))
Call .WriteKey("MouseEvent", "Rollmode", Str$(Rollmode))
Call .WriteKey("MouseEvent", "EnableDragLink", Str$(EnableDragLink))
' For i = 0 To mouseEventCount - 1
' Call .WriteKey("MouseEvent", "Event" & LTrim$(Str(i)), Str$(mouse_event_prc(i).InsideIndex))
' Next i
Call .WriteKey("MouseEvent", "Event_LeftRight", Str$(mouse_event_leftright.InsideIndex))
Call .WriteKey("MouseEvent", "Event_RightLeft", Str$(mouse_event_rightleft.InsideIndex))
End With
Call MouseHand.Save(AppPath & MainIniName)
Call SaveDragDropSetting
Call SaveSearchurlToINI
Call SaveAddbarKey
' Call SaveExTools
Call SaveDownloadControl
Call SaveToolbarButtonPos
Call SaveSearchEgn
Call SaveMulSearchEgn
Call SavePlugin
Call SaveDownManager
End If
If preSaveWhenExit <> SaveWhenExit Then
Call tIniFile.WriteKey("Other", "SaveWhenExit", Str$(SaveWhenExit))
End If
Call SaveMoreFavInfo
Call SaveUrlFilter
Call SavePageRule
End Sub
'---------------------------------------------------------------------------------------
' Procedure : SaveToolbarButtonPos
' DateTime : 2005-8-9 22:57
' Author : Lingll
' Purpose : 保存工具栏按钮
'---------------------------------------------------------------------------------------
Private Sub SaveToolbarButtonPos()
Dim tArr() As cButtonPosInfo
tArr = m_cTbrMain.p_colBff("desarr")
Call SaveTbrButtonPos("main", tArr)
tArr = m_cTbrSmall.p_colBff("desarr")
Call SaveTbrButtonPos("small", tArr)
End Sub
Public Sub SwitchTabs(ByVal index As Long, Optional ByVal oldIndex As Long = 0)
On Error GoTo due
'Dim prehwd As Long
Dim newhwd As Long
'Dim preIndex As Long
Dim newIndex As Long
If oldIndex = 0 Then oldIndex = gActiveWebIndex
If oldIndex = 0 Then Exit Sub
Debug.Print "switchtab", index, oldIndex
If webbState(oldIndex).webForm.WindowState = 2 Then
'preIndex = oldIndex
newIndex = index
'prehwd = webbState(oldIndex).webForm.hwnd
newhwd = webbState(index).webForm.hWnd
SendMessageLng hMDIClient, WM_SETREDRAW, 0&, ByVal 0&
BringWindowToTop (newhwd)
SendMessageLng hMDIClient, WM_SETREDRAW, 1&, ByVal 0&
RedrawWindow newhwd, ByVal 0&, 0&, _
RDW_ALLCHILDREN Or RDW_UPDATENOW Or RDW_INVALIDATE Or RDW_FRAME
Else
'webbState(index).webForm.SetFocus
BringWindowToTop webbState(index).webForm.hWnd
End If
Exit Sub
due:
ErrorLog.AddLog "switch " & vbTab & Err.Description
Resume Next
End Sub
Public Sub ChangeStatusText(nText As String, Optional ByVal index As Long = 0)
'SendMessage stabMe.Hwnd, SB_SETTEXTA, index, ByVal nText
If Not m_cSsbar Is Nothing Then
m_cSsbar.SetText index, nText
End If
End Sub
''获取关闭页面信息
'Public Sub GetClosePages(nUrls() As String, nTitles() As String, nCount As Long)
'Dim i&
'nCount = re_closepage_count
'ReDim nUrls(0 To re_closepage_count)
'ReDim nTitles(0 To re_closepage_count)
'For i = 1 To re_closepage_count
' nUrls(i) = mnuRecent_ClosePage(i).Tag
' nTitles(i) = mnuRecent_ClosePage(i).Caption
'Next i
'End Sub
Private Sub EnableButtons()
Dim nEnabled As Boolean
nEnabled = (loadedBrowserCount > 0)
If Not m_cTbrMain Is Nothing Then
With m_cTbrMain
If Not nEnabled Then
Call .EnableButton(TbrID_Main_Back, nEnabled)
Call .EnableButton(TbrID_Main_Forward, nEnabled)
Call .CheckButton(TbrID_Main_AutoPreventPop, False)
End If
Call .EnableButton(TbrID_Main_Refresh, nEnabled)
Call .EnableButton(TbrID_Main_Stop, nEnabled)
Call .EnableButton(TbrID_Main_FontSize, nEnabled)
Call .EnableButton(TbrID_Main_AutoPreventPop, nEnabled)
Call .EnableButton(TbrID_Main_DLCtrl, nEnabled)
End With
End If
'With tlbMe
' If Not nEnabled Then
' .Buttons(TbrK_Main_Back).Enabled = nEnabled
' .Buttons(TbrK_Main_Forward).Enabled = nEnabled
' .Buttons(TbrK_Main_AutoPreventPop).Value = tbrUnpressed
' Call m_cTbrSmall.CheckButton(TbrID_Small_LockNew, False)
' 'tlbOther.Buttons(TbrK_Small_LockNew).Value = tbrUnpressed
' End If
' .Buttons(TbrK_Main_Refresh).Enabled = nEnabled
' .Buttons(TbrK_Main_Stop).Enabled = nEnabled
' .Buttons(TbrK_Main_FontSize).Enabled = nEnabled
' .Buttons(TbrK_Main_AutoPreventPop).Enabled = nEnabled
' .Buttons(TbrK_Main_BlockElement).Enabled = nEnabled
'End With
If Not m_cTbrSmall Is Nothing Then
With m_cTbrSmall
If Not nEnabled Then
Call .CheckButton(TbrID_Small_LockNew, False)
End If
Call .EnableButton(TbrID_Small_LockNew, nEnabled)
Call .EnableButton(TbrID_Small_NextTab, nEnabled)
Call .EnableButton(TbrID_Small_LastTab, nEnabled)
Call .EnableButton(TbrID_Small_Max, nEnabled)
Call .EnableButton(TbrID_Small_Min, nEnabled)
Call .EnableButton(TbrID_Small_NextTab, nEnabled)
Call .EnableButton(TbrID_Small_Close, nEnabled)
End With
End If
'With tlbOther
' .Buttons(TbrK_Small_LockNew).Enabled = nEnabled
' .Buttons(TbrK_Small_NextTab).Enabled = nEnabled
' .Buttons(TbrK_Small_LastTab).Enabled = nEnabled
' .Buttons(TbrK_Small_Max).Enabled = nEnabled
' .Buttons(TbrK_Small_Min).Enabled = nEnabled
' .Buttons(TbrK_Small_NextTab).Enabled = nEnabled
' .Buttons(TbrK_Small_Close).Enabled = nEnabled
'End With
With mcTbrSearch
If nEnabled Then
.SetButtonState TbrID_Search_Find, TBSTATE_ENABLED
.SetButtonState TbrID_Search_HeightLight, TBSTATE_ENABLED
Else
.SetButtonState TbrID_Search_Find, 0
.SetButtonState TbrID_Search_HeightLight, 0
End If
End With
'With tbrSearch
' .Buttons(TbrK_Search_Find).Enabled = nEnabled
' .Buttons(TbrK_Search_HeightLight).Enabled = nEnabled
'End With
If loadedBrowserCount <= 0 Then
Call ChangeCaption
End If
End Sub
'设置搜索栏button
Public Sub SetSearchbarButtons()
With mcTbrSearch
If gSearchEgnCount > 0 Then
.SetButtonCaption TbrID_Search_Search, gSearchEgn(gDefaultEgn).Title
.SetButtonState TbrID_Search_Search, TBSTATE_ENABLED
Else
.SetButtonCaption TbrID_Search_Search, ""
.SetButtonState TbrID_Search_Search, 0
End If
If gMulSearchCount > 0 Then
.SetButtonCaption TbrID_Search_MulSearch, gMulSearch(gDefaultMulEgn).Title
.SetButtonState TbrID_Search_MulSearch, TBSTATE_ENABLED
Else
.SetButtonCaption TbrID_Search_MulSearch, ""
.SetButtonState TbrID_Search_MulSearch, 0
End If
End With
Call ResizeTbrSearch
End Sub
'Public Property Get hMenu() As Long
'hMenu = mHMenu
'End Property
Private Sub LoadFavoriteMenu()
'Dim favPath As String
'favPath = favoritePath
hMnuFavorite = GetSubMenu(mHMenu, 2)
hMnuMoreFav = GetSubMenu(hMnuFavorite, 2)
hMnuReopen = GetSubMenu(hMnuFavorite, 3)
'loadSubInfo(0).hwnd = hMnuFavorite
'loadSubInfo(0).path = favPath
'loadSubInfo(0).Title = "收藏"
'
'
'Call SeekFold(favPath, hMnuFavorite, FavoriteMenuPosOffset, False)
End Sub
'Public Property Get MainMenuItemCount() As Long
'MainMenuItemCount = mMainMenuItemCount
'End Property
'
'Public Function GetCurrentMenuItemCount() As Long
'GetCurrentMenuItemCount = GetMenuItemCount(mHMenu)
'End Function
Public Property Let LocationURLText(ByVal vNewValue As String)
If Not addbarGetFocus Then
Call SetWindowText(cmbAdd.hWnd, vNewValue)
End If
End Property
Public Sub NewIE(Optional url As String = "")
Dim tIE As New SHDocVw.InternetExplorer
If url = "" Then
tIE.Navigate "about:blank"
Else
tIE.Navigate url
End If
tIE.Visible = True
End Sub
Public Sub ExpandNode(hItem&, nExpanded As Boolean)
'mvTvwFavorite.ExpandNode tvwFavorite.Nodes(nKey), nExpanded
mvTvwFavorite.ExpandNode hItem, nExpanded
End Sub
Public Sub ShowMe(nShow As Boolean)
Debug.Print "fratitlebutton.Visible ", fraTitleButton.Visible
If nShow Then
Me.Show
Me.WindowState = mWindowState
fraTitleButton.Visible = True
mySysTray.InTray = False
Call UnregisterHotKey(Me.hWnd, 1)
Else
mWindowState = Me.WindowState
Me.WindowState = vbMinimized
Me.Hide
fraTitleButton.Visible = False
mySysTray.InTray = True
Call RegisterHotKey(Me.hWnd, 1, MOD_CONTROL, VK_F8)
End If
Debug.Print "fratitlebutton.Visible2 ", fraTitleButton.Visible
End Sub
''加载"外部工具"菜单
'Public Sub LoadExToolsMenu()
'Dim i&, ub&, tstr$
'
'With pMnu_OuterTools
' .ClearItems
'
' If ExToolsCount > 0 Then
' For i = 1 To ExToolsCount
' If i < 10 Then
' tstr = "&" & LTrim(Str(i)) & " "
' Else
' tstr = Space(3)
' End If
' .Add tstr & ExTools(i).Caption, , i + IdOffset_OuterTools
' Next i
' Else
' .Add "(空)", pmsString Or pmsDisabled
' End If
'
' .Add "", pmsSeparator
' .Add "下载批量文件(flashget)...", , IDM_Main_OuterTools_FlashgetDownload
'
'End With
'ub = mnuOutToolsItems.UBound
'mnuOutToolsItems(0).Visible = True
'For i = 1 To ub
' Unload mnuOutToolsItems(i)
'Next i
'For i = 1 To ExToolsCount
' Load mnuOutToolsItems(i)
' If i < 10 Then
' tstr = "&" & LTrim(Str(i)) & " "
' Else
' tstr = Space(3)
' End If
' mnuOutToolsItems(i).Caption = tstr & ExTools(i).Caption
' mnuOutToolsItems(i).Enabled = True
' mnuOutToolsItems(i).Visible = True
'Next i
'If ExToolsCount > 0 Then
' mnuOutToolsItems(0).Visible = False
'End If
'End Sub
Private Sub OpenClipboardUrl()
Dim tstr$
tstr = Trim(Clipboard.GetText)
tstr = Replace(tstr, " ", "")
tstr = Replace(tstr, Chr(10) & Chr(13), "")
Call NewWebbrowser(tstr)
End Sub
'初始化ImageList
Private Sub IniImglst()
Dim tImg As cImgEx
'Dim tDskDc&
Set tImg = New cImgEx
'tDskDc = GetDC(0)
''ImageList_AddMasked ImageList_tblMe.hImageList, LoadImageEx(IDB_MainBar, "gif").handle, RGB(255, 0, 255)
'tImg.Create 260, 20, tDskDc
'tImg.CopyByBmp LoadImageEx(IDB_MainBar, "gif").handle
'With ImageList_tblMe.ListImages
' .Add , ImgK_Main_New, tImg.ExtractImg2(20, 20, 0)
' .Add , ImgK_Main_Back, tImg.ExtractImg2(20, 20, 1)
' .Add , ImgK_Main_Forward, tImg.ExtractImg2(20, 20, 2)
' .Add , ImgK_Main_Stop, tImg.ExtractImg2(20, 20, 3)
' .Add , ImgK_Main_Refresh, tImg.ExtractImg2(20, 20, 4)
' .Add , ImgK_Main_Favorites, tImg.ExtractImg2(20, 20, 5)
' .Add , ImgK_Main_Proxy, tImg.ExtractImg2(20, 20, 6)
' .Add , ImgK_Main_FontSize, tImg.ExtractImg2(20, 20, 7)
' .Add , ImgK_Main_AutoPreventPop, tImg.ExtractImg2(20, 20, 8)
'
' .Add , ImgK_Main_RecentClose, tImg.ExtractImg2(20, 20, 9)
' .Add , ImgK_Main_BlockElement, tImg.ExtractImg2(20, 20, 10)
' .Add , ImgK_Main_Option, tImg.ExtractImg2(20, 20, 11)
' .Add , ImgK_Main_FullScreen, tImg.ExtractImg2(20, 20, 12)
'
'End With
'
'
'
'tImg.Create 260, 20, tDskDc
'tImg.CopyByBmp LoadImageEx(IDB_MainBar_Gray, "gif").handle
'With ImageList_tblMe_gray.ListImages
' .Add , ImgK_Main_New, tImg.ExtractImg2(20, 20, 0)
' .Add , ImgK_Main_Back, tImg.ExtractImg2(20, 20, 1)
' .Add , ImgK_Main_Forward, tImg.ExtractImg2(20, 20, 2)
' .Add , ImgK_Main_Stop, tImg.ExtractImg2(20, 20, 3)
' .Add , ImgK_Main_Refresh, tImg.ExtractImg2(20, 20, 4)
' .Add , ImgK_Main_Favorites, tImg.ExtractImg2(20, 20, 5)
' .Add , ImgK_Main_Proxy, tImg.ExtractImg2(20, 20, 6)
' .Add , ImgK_Main_FontSize, tImg.ExtractImg2(20, 20, 7)
' .Add , ImgK_Main_AutoPreventPop, tImg.ExtractImg2(20, 20, 8)
' .Add , ImgK_Main_RecentClose, tImg.ExtractImg2(20, 20, 9)
' .Add , ImgK_Main_BlockElement, tImg.ExtractImg2(20, 20, 10)
' .Add , ImgK_Main_Option, tImg.ExtractImg2(20, 20, 11)
' .Add , ImgK_Main_FullScreen, tImg.ExtractImg2(20, 20, 12)
'End With
'Set IcoImgList = ImageList_Menu
'Set gODrawMenu.IcoImgList = ImageList_Menu
gODrawMenu.IniImageList LoadImageEx(IDB_MenuIcon, "gif").handle, 16, 16
gODrawMenu.IniImageList LoadImageEx(IDB_PluginIcon, "gif").handle, 16, 16, "plugin"
'With ImageList_Menu.ListImages
' .Add , ImgK_Icon_Folder, LoadResPicture(IDI_Folder, vbResBitmap)
' .Add , ImgK_Icon_Url, LoadResPicture(IDI_Url, vbResBitmap)
' '.Add , ImgK_Icon_Reopen, LoadResPicture(IDI_Fav_Reopen, vbResBitmap)
' '.Add , ImgK_Icon_AddFav, LoadResPicture(IDI_Fav_Add, vbResBitmap)
' '.Add , ImgK_Icon_FavFav, LoadResPicture(IDI_Fav_Fav, vbResBitmap)
' .Add , ImgK_Icon_Folder_Open, LoadResPicture(IDI_Folder_Open, vbResBitmap)
' '.Add , ImgK_Icon_AddFav_Gray, LoadResPicture(IDI_Fav_Add_Gray, vbResBitmap)
'End With
'tImg.Create 91, 13, tDskDc
'tImg.CopyByBmp LoadImageEx(IDB_OtherBar, "gif").handle
'With ImageList_tlbOther.ListImages
' .Add , ImgK_Small_LastTab, tImg.ExtractImg(0, 0, 13, 13)
' .Add , ImgK_Small_NextTab, tImg.ExtractImg(13, 0, 13, 13)
' .Add , ImgK_Small_Min, tImg.ExtractImg(26, 0, 13, 13)
' .Add , ImgK_Small_Max, tImg.ExtractImg(39, 0, 13, 13)
' .Add , ImgK_Small_Close, tImg.ExtractImg(52, 0, 13, 13)
' .Add , ImgK_Small_LockPresent, tImg.ExtractImg(65, 0, 13, 13)
' .Add , ImgK_Small_LockNew, tImg.ExtractImg(78, 0, 13, 13)
'End With
'tImg.Create 48, 16, tDskDc
'tImg.CopyByBmp LoadImageEx(IDB_SearchBar, "gif").handle
'With ImageList_Search.ListImages
' .Add , ImgK_Search_Search, tImg.ExtractImg(0, 0, 16, 16)
' .Add , ImgK_Search_HeightLight, tImg.ExtractImg(16, 0, 16, 16)
' .Add , ImgK_Search_Find, tImg.ExtractImg(32, 0, 16, 16)
'
'' .Add , ImgK_Search_Search, LoadResPicture(IDB_Search_Search, vbResBitmap)
'' .Add , ImgK_Search_HeightLight, LoadResPicture(IDB_Search_HeightLight, vbResBitmap)
'' .Add , ImgK_Search_Find, LoadResPicture(IDB_Search_Find, vbResBitmap)
'End With
'Call ReleaseDC(0, tDskDc)
End Sub
'初始化主工具栏
Private Sub IniToolbar()
Dim i& ', tBtn As MSComctlLib.Button
Dim tcnt&
Call LoadMainMenu
Set mcTbrMainMenu = CreateCmmCtrl(strCLSID_cToolBar) ' New cToolBar
With mcTbrMainMenu
.CreateToolbar 0, False, False, 0, 15, TBSTYLE_Default Xor TBSTYLE_TOOLTIPS, 0
.SetPadding 5, 4
tcnt = GetMenuItemCount(gHMainMenu)
For i = 0 To tcnt - 1
.AddButton i + 100, GetMenuTextVb(gHMainMenu, i), , BTNS_AUTOSIZE Or BTNS_DROPDOWN
Next i
End With
'mHwndTbrMain = FindWindowEx(tlbMe.hwnd, 0&, "msvb_lib_toolbar", vbNullString)
'With tlbMe
' .ImageList = ImageList_tblMe
' .DisabledImageList = ImageList_tblMe_gray
'
' Set tBtn = .Buttons.Add(, TbrK_Main_New, , tbrDropdown, ImgK_Main_New)
' tBtn.ToolTipText = "新建"
' tBtn.Description = "新建"
' tBtn.ButtonMenus.Add , "newblankpage", "空白页"
' tBtn.ButtonMenus.Add , "newpresentpage", "当前页"
' tBtn.ButtonMenus.Add , "newclipboard", "剪贴板"
' tBtn.ButtonMenus.Add , , "-"
' tBtn.ButtonMenus.Add , "newIEblank", "IE(空白)"
' tBtn.ButtonMenus.Add , "newIEpresent", "IE(当前)"
'
' 'For i = 2 To 6
' ' .Buttons.Add , ImageList_tblMe.ListImages(i).Key, , , i
' 'Next
'
' Set tBtn = .Buttons.Add(, TbrK_Main_Back, , tbrDropdown, ImgK_Main_Back)
' tBtn.ToolTipText = "后退"
' tBtn.Description = "后退"
'
' Set tBtn = .Buttons.Add(, TbrK_Main_Forward, , tbrDropdown, ImgK_Main_Forward)
' 'tBtn.Style = tbrDropdown
' tBtn.ToolTipText = "前进"
' tBtn.Description = "前进"
'
' Set tBtn = .Buttons.Add(, TbrK_Main_Stop, , , ImgK_Main_Stop) ' .Buttons("stop")
' tBtn.ToolTipText = "停止"
' tBtn.Description = "停止"
'
' Set tBtn = .Buttons.Add(, TbrK_Main_Refresh, , , ImgK_Main_Refresh) '.Buttons("refresh")
' tBtn.ToolTipText = "刷新"
' tBtn.Description = "刷新"
'
' Set tBtn = .Buttons.Add(, TbrK_Main_Favorites, , tbrDropdown, ImgK_Main_Favorites) ' .Buttons("favorites")
' 'tBtn.Style = tbrDropdown
' tBtn.ToolTipText = "收藏"
' tBtn.Description = "收藏"
'
' Set tBtn = .Buttons.Add(, TbrK_Main_Proxy, , tbrDropdown, ImgK_Main_Proxy)
' tBtn.ToolTipText = "代理"
' tBtn.Description = "代理"
'
' Set tBtn = .Buttons.Add(, TbrK_Main_FontSize, , , ImgK_Main_FontSize)
' tBtn.ToolTipText = "文字大小"
' tBtn.Description = "文字大小"
'
' Set tBtn = .Buttons.Add(, TbrK_Main_AutoPreventPop, , tbrDropdown, ImgK_Main_AutoPreventPop)
' tBtn.ToolTipText = "自动过滤(当前窗口)"
' tBtn.Description = "自动过滤(当前窗口)"
'
'
' Set tBtn = .Buttons.Add(, TbrK_Main_RecentClose, , tbrDropdown, ImgK_Main_RecentClose)
' 'tBtn.ButtonMenus.Add , , "(空)"
' 'tBtn.ButtonMenus(1).Enabled = False
' tBtn.ToolTipText = "最近关闭的页面"
' tBtn.Description = "最近关闭的页面"
'
'
' Set tBtn = .Buttons.Add(, TbrK_Main_BlockElement, , tbrDropdown, ImgK_Main_BlockElement)
' tBtn.ToolTipText = "下载控制(当前窗口)"
' tBtn.Description = "下载控制(当前窗口)"
'
' Set tBtn = .Buttons.Add(, TbrK_Main_Option, , tbrDropdown, ImgK_Main_Option)
' tBtn.ToolTipText = "选项"
' tBtn.Description = "选项"
'
' Set tBtn = .Buttons.Add(, TbrK_Main_FullScreen, , , ImgK_Main_FullScreen)
' tBtn.ToolTipText = "全屏"
' tBtn.Description = "全屏"
'
' For i = 0 To gTbrMainBtnCnt - 1
' .Buttons(i + 1).Visible = (gTbrMainBtnShow(i) = 1)
' Next i
'End With
'mTbrOtherHwnd = FindWindowEx(tlbOther.hwnd, 0&, "msvb_lib_toolbar", vbNullString)
'With tlbOther
' .ImageList = ImageList_tlbOther
'' For i = 1 To 5
'' .Buttons.Add , ImageList_tlbOther.ListImages(i).Key, , , i
'' Next
'
' Set tBtn = .Buttons.Add(, TbrK_Small_LastTab, , , ImgK_Small_LastTab) ' .Buttons("lasttab")
' tBtn.ToolTipText = "上一窗口"
' tBtn.Description = "上一窗口"
'
' Set tBtn = .Buttons.Add(, TbrK_Small_NextTab, , , ImgK_Small_NextTab) '.Buttons("nexttab")
' tBtn.ToolTipText = "下一窗口"
' tBtn.Description = "下一窗口"
'
' Set tBtn = .Buttons.Add(, TbrK_Small_Min, , , ImgK_Small_Min)
' tBtn.ToolTipText = "最小化|还原"
' tBtn.Description = "最小化|还原"
'
' Set tBtn = .Buttons.Add(, TbrK_Small_Max, , tbrDropdown, ImgK_Small_Max)
' tBtn.ToolTipText = "最大化|还原"
' tBtn.Description = "最大化|还原"
' tBtn.ButtonMenus.Add , "restoreall", "还原所有(&R)"
' tBtn.ButtonMenus.Add , "maxall", "最大化所有(&X)"
'
'
' Set tBtn = .Buttons.Add(, TbrK_Small_Close, , tbrDropdown, ImgK_Small_Close) ' .Buttons("close")
' 'tBtn.Style = tbrDropdown
' tBtn.ToolTipText = "关闭当前页"
' tBtn.Description = "关闭当前页"
' tBtn.ButtonMenus.Add , "closeother", "反向"
' tBtn.ButtonMenus.Add , "closelike", "类似"
' 'tBtn.ButtonMenus("closelike").Enabled = False
' tBtn.ButtonMenus.Add , "closeall", "所有"
' tBtn.ButtonMenus.Add , , "-"
' tBtn.ButtonMenus.Add , "close", "当前"
'
'
'
' Set tBtn = .Buttons.Add(, , , tbrSeparator)
' tBtn.Description = "分隔符"
'
' Set tBtn = .Buttons.Add(, TbrK_Small_LockPresent, , tbrCheck, ImgK_Small_LockPresent) ' .Buttons("lockpresent")
' 'tBtn.Style = tbrCheck
' tBtn.Value = isLockPresentWeb
' tBtn.ToolTipText = "不激活新窗口"
' tBtn.Description = "不激活新窗口"
'
'
' Set tBtn = .Buttons.Add(, TbrK_Small_LockNew, , tbrCheck, ImgK_Small_LockNew) ' .Buttons("locknew")
' 'tBtn.Style = tbrCheck
' tBtn.ToolTipText = "总在新窗口打开"
' tBtn.Description = "总在新窗口打开"
'
'
' For i = 0 To gTbrSmallBtnCnt - 1
' .Buttons(i + 1).Visible = (gTbrSmallBtnShow(i) = 1)
' Next i
'
'' .Left = 30
'' .Top = 0
'End With
'搜索栏
'mTbrSearchHwnd = FindWindowEx(tbrSearch.hwnd, 0&, "msvb_lib_toolbar", vbNullString)
'With tbrSearch
' .ImageList = ImageList_Search
' Set tBtn = .Buttons.Add(, TbrK_Search_Search, , tbrDropdown, ImgK_Search_Search)
' 'tBtn.Caption = "gh"
' tBtn.ToolTipText = "多引擎搜索"
'
' Set tBtn = .Buttons.Add(, TbrK_Search_HeightLight, , , ImgK_Search_HeightLight)
' tBtn.ToolTipText = "高亮关键字"
'
' Set tBtn = .Buttons.Add(, TbrK_Search_Find, , , ImgK_Search_Find)
' tBtn.ToolTipText = "页面中查找(F3)"
'
'
'' SendMessage mTbrSearchHwnd, TB_SETSTYLE, 0, _
'' ByVal (SendMessage(mTbrSearchHwnd, TB_GETSTYLE, 0, 0) Or TBSTYLE_LIST)
'' SendMessage mTbrSearchHwnd, TB_SETEXTENDEDSTYLE, 0&, _
'' ByVal (SendMessage(mTbrSearchHwnd, TB_GETEXTENDEDSTYLE, 0, 0) Or TBSTYLE_EX_MIXEDBUTTONS)
''
'' ChangeTbrbtnCaption mTbrSearchHwnd, 101, "高亮关键字", False
'' ChangeTbrbtnCaption mTbrSearchHwnd, 102, "页面中查找(F3)", False
'
'
' .Width = GetTbrWidth(tbrSearch) * 15
'End With
Set mcTbrSearch = CreateCmmCtrl(strCLSID_cToolBar) ' New cToolBar
With mcTbrSearch
.CreateToolbar pctReBar.hWnd, True, True, 16, 16, , TBSTYLE_EX_Default Or TBSTYLE_EX_MIXEDBUTTONS
.AddImages LoadImageEx(IDB_SearchBar, "gif").handle, RGB(255, 0, 255)
.AddButton TbrID_Search_Combo, "", 30, BTNS_SEP
.AddButton TbrID_Search_Search, "", 0, BTNS_DROPDOWN Or BTNS_AUTOSIZE Or BTNS_SHOWTEXT
' If gSearchEgnCount > 0 Then
' .SetButtonCaption TbrID_Search_Search, gSearchEgn(gDefaultEgn).Title
' Else
' .SetButtonState TbrID_Search_Search, 0
' End If
.AddButton TbrID_Search_MulSearch, "", 1, BTNS_DROPDOWN Or BTNS_AUTOSIZE Or BTNS_SHOWTEXT
' If gMulSearchCount > 0 Then
' .SetButtonCaption TbrID_Search_MulSearch, gMulSearch(gDefaultMulEgn).Title
' Else
' .SetButtonState TbrID_Search_MulSearch, 0
' End If
.AddButton TbrID_Search_HeightLight, "高亮关键字", 2
.AddButton TbrID_Search_Find, "页面中查找(F3)", 3
SetParent cmbSearch.hWnd, .hwndToolbar
End With
Call SetSearchbarButtons
'With tlbFavorite
' .ImageList = ImageList_tlbOther
' .Buttons.Add , "lock", , , ImgK_Small_LockPresent
' .Buttons.Add , "close", , , ImgK_Small_Close
' .Buttons("lock").Style = tbrCheck
' .Buttons("lock").Value = tbrPressed
' .Width = .ButtonWidth * 2
'End With
Call IniMainTbr
Call IniSideBarTbr
Call IniSmallTbr
End Sub
''获得toolbar最小长度
'Private Function GetTbrWidth(nTbr As MSComctlLib.ToolBar) As Long
'Dim tBtn As MSComctlLib.Button
'Dim tLen&
'For Each tBtn In nTbr.Buttons
' tLen = tLen + tBtn.Width
'Next tBtn
'GetTbrWidth = tLen / 15
'End Function
Private Function GetTbrWidth2(nTbr As cToolBar) As Long
Dim tR&
With nTbr
.GetBtnRect .GetButton(.ButtonCount - 1, False), , , tR
End With
GetTbrWidth2 = tR
End Function
'resize small tool bar
Public Function ResizeTbr()
Dim tLen&, tR&
With m_cTbrSmall
.GetBtnRect .GetButton(.ButtonCount - 1, False), , , tR
End With
tLen = tR ' GetTbrWidth(tlbOther)
m_cRebar.SetBandChildSize ID_Band_SmallTbr, 20, 19, , , , False
m_cRebar.SetBandWidth m_cRebar.IdToIndex(ID_Band_SmallTbr), tLen
'tLen = GetTbrWidth(tlbMe)
'myRebar.SizeBand ID_Band_MainTbr, 0, 26, Screen.Width / Screen.TwipsPerPixelX, True
'myRebar.SizeBand ID_Band_MainTbr, 0, 26, tLen, True
End Function
'关闭所有窗口
Public Sub CloseAllTabs()
Debug.Print "closeall"
If loadedBrowserCount > 0 Then
If MsgBox("关闭所有窗口?", vbYesNo + vbQuestion) = vbYes Then
'Call UnloadBrowsers(1, webbState(gActiveWebIndex).tabOrder - 1)
Call UnloadBrowsers(1, webbState(gActiveWebIndex).TabBtn.index - 1)
Call UnloadBrowsers(2, loadedBrowserCount)
Call UnloadBrowser(gActiveWebIndex)
End If
End If
End Sub
'关闭相似页面
Private Sub CloseLikeTabs(ByVal nIndex As Long)
Dim tFrm As frmCloseLike
Set tFrm = New frmCloseLike
Load tFrm
tFrm.IniMe nIndex, Me
End Sub
Private Sub IniPopMenu()
'Set mBlockElementPopMenu = New cPopMenu
'With mBlockElementPopMenu
' .Create
' .Add "下载图片", , 101
' .Add "下载音乐", , 102
' .Add "下载视频", , 103
' .Add "允许脚本", , 104
' .Add "允许ActiveX", , 105
' .Add "允许JavaApplet", , 106
' .Add "下载ActiveX", , 107
' .Add "", pmsSeparator
' .Add "全部开启", pmsString, 201
' .Add "全部关闭", pmsString, 202
'End With
Set mPopmnuAutoBlockPopwin = New cPopMenu
With mPopmnuAutoBlockPopwin
.Create
.Add "宽松", , 101
.Add "一般", , 102
.Add "严格", , 103
End With
Dim tHmnu&
tHmnu = LoadMenuVB(400)
Set mPopmnuTabpop = New cPopMenu
With mPopmnuTabpop
.Create GetSubMenu(tHmnu, 0)
.Parent = Me.hWnd
.EnableItem mIDM_Tabs_AddFavor, False
End With
RemoveMenu tHmnu, 0, MF_BYPOSITION
Set mPopmnuSystray = New cPopMenu
With mPopmnuSystray
.Create GetSubMenu(tHmnu, 0)
.SetDefault 101
.Parent = Me.hWnd
End With
RemoveMenu tHmnu, 0, MF_BYPOSITION
Set mPopmnuTurnTo = New cPopMenu
With mPopmnuTurnTo
.Create GetSubMenu(tHmnu, 0)
.Parent = Me.hWnd
.SetDefault mIDM_Turnto_TT
'.EnableItem mIDM_Turnto_GoUp, False
End With
RemoveMenu tHmnu, 0, MF_BYPOSITION
DestroyMenu tHmnu
End Sub
''弹出"下载控制"按钮下拉菜单
'Private Sub ShowBlockElementMenu(x&, y&)
'''Dim tPt As POINTAPI
''Dim tFrm As frmBrowser
''Dim tId As Long
''
'''tPt = GetTbrDropDownPoint(mHwndTbrMain, tlbMe.Buttons(TbrK_Main_BlockElement).index - 1)
''Set tFrm = webbState(gActiveWebIndex).webForm
''With mBlockElementPopMenu
'' .CheckItem 0, tFrm.DL_Image, False
'' .CheckItem 1, tFrm.DL_BgSound, False
'' .CheckItem 2, tFrm.DL_Video, False
'' .CheckItem 3, tFrm.DL_Script, False
'' .CheckItem 4, tFrm.DL_ActiveX, False
'' .CheckItem 5, tFrm.DL_JavaApplet, False
'' .CheckItem 6, tFrm.Dl_DlActiveX, False
'' tId = .Popup2(Me.hWnd, False, x, y)
''
'' Select Case tId
'' Case 101
'' tFrm.DL_Image = Not tFrm.DL_Image
'' Case 102
'' tFrm.DL_BgSound = Not tFrm.DL_BgSound
'' Case 103
'' tFrm.DL_Video = Not tFrm.DL_Video
'' Case 104
'' tFrm.DL_Script = Not tFrm.DL_Script
'' Case 105
'' tFrm.DL_ActiveX = Not tFrm.DL_ActiveX
'' Case 106
'' tFrm.DL_JavaApplet = Not tFrm.DL_JavaApplet
'' Case 107
'' tFrm.Dl_DlActiveX = Not tFrm.Dl_DlActiveX
'' Case 201
'' tFrm.Dl_EnableAll True
'' Case 202
'' tFrm.Dl_EnableAll False
'' End Select
''End With
'End Sub
'Private Sub ShowFontSizeMenu()
'Dim tPt As POINTAPI
'tPt = GetTbrDropDownPoint(mHwndTbrMain, tlbMe.Buttons(TbrK_Main_FontSize).index - 1)
'pMnu_FontSize.Popup2 Me.hwnd, False, tPt.x, tPt.y, TPM_LEFTALIGN
''ScreenToClient Me.hwnd, tpt
''Me.PopupMenu mnuFontSize, , tpt.x * 15, tpt.y * 15
'End Sub
''获得toolbar按钮左下角屏幕坐标
'Private Function GetTbrDropDownPoint(nHtbr As Long, nPos As Long) As POINTAPI
'Dim tBifo As TBBUTTON
'Dim trc As RECT
'Dim tPt As POINTAPI
'SendMessage nHtbr, TB_GETBUTTON, nPos, tBifo
'SendMessage nHtbr, TB_GETRECT, tBifo.idCommand, trc
'tPt.x = trc.Left: tPt.y = trc.Bottom
'ClientToScreen nHtbr, tPt
'GetTbrDropDownPoint = tPt
'End Function
'替换地址栏,转换为预设的地址(自动完成地址,例如搜索,域名)
Private Sub ReplaceAddress(nIndex As Long)
Dim turl As String
If nIndex > 0 And nIndex <= SearchurlCount Then
turl = Replace$(searchUrl(nIndex).url, SearchUrlKeywordFlag, cmbAdd.Text)
Call OpenAddressUrl(True, , turl)
'Call NewWebbrowser(tUrl)
End If
End Sub
'打开搜索页
Private Sub OpenSearchPage(nIndex As Long)
Dim turl As String
If nIndex > 0 And nIndex <= gSearchEgnCount Then
If Trim(gSearchEgn(nIndex).url) <> "-" Then
turl = Replace$(gSearchEgn(nIndex).url, SearchUrlKeywordFlag, cmbSearch.Text)
Call NewWebbrowser(turl)
Call AddSearchList(cmbSearch.Text)
End If
End If
End Sub
'打开搜索页(多页面)
Private Sub OpenMulSearchPage(nIndex As Long)
On Error Resume Next
Dim i&
If nIndex > 0 And nIndex <= gMulSearchCount Then
For i = 1 To gMulSearch(nIndex).Count
If gMulSearch(nIndex).UseMul(i) Then
Call OpenSearchPage(i)
End If
Next i
End If
End Sub
'设置"自动过滤"按钮状态
Public Sub SetTbrBtnState_AutoPvntPop(nValue As Long) 'MSComctlLib.ValueConstants)
'tlbMe.Buttons(TbrK_Main_AutoPreventPop).Value = nValue
If Not m_cTbrMain Is Nothing Then
m_cTbrMain.CheckButton TbrID_Main_AutoPreventPop, nValue = 1
End If
End Sub
'关闭页面,包括关闭被选择的页面
Public Sub ClosePage()
If loadedBrowserCount > 0 Then
If selectedTabsCount <= 0 Then
Call UnloadBrowser(gActiveWebIndex)
ElseIf selectedTabsCount > 0 Then
Call CloseMulTab
End If
End If
End Sub
''重新加载脚本
'Private Sub ReloadScript()
'Call LoadAllScriptFile
'Call LoadScriptMenu
'End Sub
''加载脚本菜单
'Private Sub LoadScriptMenu()
'Dim i&, tcnt&
'
'With pMnu_Plugin_Scripts
' If .GetItemCount > 2 Then
' .RemoveItems 0, .GetItemCount - 4
' End If
'
' For i = gScriptCnt To 1 Step -1
' .Add2 gScripts(i).Title, 0, , , i + IdOffset_Plugin_Script
' Next i
'
' If gScriptCnt > 0 Then
'
' Else
' .Add2 "(空)", 0, , pmsString Or pmsDisabled
' End If
'
'End With
'Dim tMenu As VB.Menu
'mnuTabs_Scripts_Item(0).Visible = True
'For Each tMenu In mnuTabs_Scripts_Item
' If tMenu.index <> 0 Then
' Unload tMenu
' End If
'Next tMenu
'
'For i = 1 To gScriptCnt
' Load mnuTabs_Scripts_Item(i)
' With mnuTabs_Scripts_Item(i)
' .Caption = gScripts(i).Title
' .Visible = True
' .Enabled = True
' End With
'Next i
'
'If gScriptCnt > 0 Then
' mnuTabs_Scripts_Item(0).Visible = False
'Else
' mnuTabs_Scripts_Item(0).Visible = True
' mnuTabs_Scripts_Item(0).Enabled = False
'End If
'End Sub
''弹出最近关闭下拉菜单
'Private Sub ShowReopenButtonMenu(index&)
'Dim tPt As POINTAPI
'Dim rId&
'
'tPt = GetTbrDropDownPoint(mHwndTbrMain, index - 1)
'rId = pMnu_Reopen.Popup2(Me.hwnd, False, tPt.x, tPt.y, TPM_LEFTALIGN)
'
''Call OpenReopen(rId)
'
''Call ScreenToClient(Me.hwnd, tpt)
''Me.PopupMenu mnuRecent_ClosePages, , tpt.X * 15, tpt.Y * 15
'
''If rId > 0 Then
'' Call NewWebbrowser(ClosedPages.GetUrl(rId))
''End If
'End Sub
'弹出选项按钮的下拉菜单
Private Sub ShowOptionButtonMenu(x&, y&)
Dim rId&
Dim i&
Const pgoffset As Long = 1000
With pMnu_Option_Dlctrl
.CheckItem IDP_Opt_Dltl_Image, gDL_Image
.CheckItem IDP_Opt_Dltl_ActiveX, gDL_ActiveX
.CheckItem IDP_Opt_Dltl_JavaApplet, gDL_JavaApplet
.CheckItem IDP_Opt_Dltl_Music, gDL_BgSound
.CheckItem IDP_Opt_Dltl_DlActiveX, gDl_DlActiveX
.CheckItem IDP_Opt_Dltl_Script, gDL_Script
.CheckItem IDP_Opt_Dltl_Video, gDL_Video
End With
With pMnu_Option_Pagerule
.ClearItems
For i = 1 To PageRuleCnt
.Add PageRule(i).Title, , pgoffset + i
.CheckItem pgoffset + i, PageRule(i).Enabled = 1
Next i
.Add "", pmsSeparator
.Add "开启", , IDP_Opt_Pgr_Enabled
.CheckItem IDP_Opt_Pgr_Enabled, gEnablePageRule = 1
End With
With pMnu_Option_Main
.CheckItem IDP_Opt_AutoPreventPop, PreventPopWindow > 0
.CheckItem IDP_Opt_UrlFilter, EnableUrlFilter = 1
.CheckItem IDP_Opt_EnableDragDrop, EnableDragLink = 1
End With
'tPt = GetTbrDropDownPoint(mHwndTbrMain, index - 1)
rId = pMnu_Option_Main.Popup2(Me.hWnd, False, x, y)
Select Case rId
Case IDP_Opt_Dltl_ActiveX
gDL_ActiveX = Not gDL_ActiveX
Case IDP_Opt_Dltl_Image
gDL_Image = Not gDL_Image
Case IDP_Opt_Dltl_JavaApplet
gDL_JavaApplet = Not gDL_JavaApplet
Case IDP_Opt_Dltl_Music
gDL_BgSound = Not gDL_BgSound
Case IDP_Opt_Dltl_DlActiveX
gDl_DlActiveX = Not gDl_DlActiveX
Case IDP_Opt_Dltl_Script
gDL_Script = Not gDL_Script
Case IDP_Opt_Dltl_Video
gDL_Video = Not gDL_Video
'=================================
Case IDP_Opt_Pgr_Enabled
If gEnablePageRule = 1 Then
gEnablePageRule = 0
Else
gEnablePageRule = 1
End If
Case Is > pgoffset
If PageRule(rId - pgoffset).Enabled = 1 Then
PageRule(rId - pgoffset).Enabled = 0
Else
PageRule(rId - pgoffset).Enabled = 1
End If
'=================================
Case IDP_Opt_AutoPreventPop
If PreventPopWindow > 0 Then
PreventPopWindow = 0
Else
PreventPopWindow = 2
End If
Case IDP_Opt_UrlFilter
If EnableUrlFilter = 1 Then
EnableUrlFilter = 0
Else
EnableUrlFilter = 1
End If
Case IDP_Opt_EnableDragDrop
If EnableDragLink = 1 Then
EnableDragLink = 0
Else
EnableDragLink = 1
End If
Case IDP_Opt_SaveNow
Call SaveSettingsToIni(False)
End Select
End Sub
Public Sub EnableOptionButton(nEnabled As Boolean)
'tlbMe.Buttons(TbrK_Main_Option).Enabled = nEnabled
On Error Resume Next
Call m_cTbrMain.EnableButton(TbrID_Main_Option, nEnabled)
End Sub
'改变主窗口标题
Public Sub ChangeCaption(Optional nTitle$)
Dim tTle$
nTitle = Trim(nTitle)
If nTitle <> "" Then
tTle = nTitle & " - " & meCaption
Else
tTle = meCaption
End If
If gFullScreenMode Then
mTempCaption = tTle
Else
Me.Caption = tTle
End If
End Sub
'将pcitruebox放到combo里
'Private Sub HackCombobox(nHCmb&, nHPct&)
'Dim hEdit&
'Dim trc As RECT, tPt As POINTAPI
'
'hEdit = FindWindowEx(nHCmb, 0, "EDIT", vbNullString)
'
'GetWindowRect hEdit, trc
'tPt.x = trc.Left: tPt.y = trc.Top
'ScreenToClient nHCmb, tPt
'If tPt.x < 20 Then
' Call MoveWindow(hEdit, tPt.x + 20, tPt.y, trc.Right - trc.Left - 20, trc.Bottom - trc.Top, 1)
'End If
'
'If nHPct <> 0 Then
' SetParent nHPct, nHCmb
' If tPt.x < 20 Then
' MoveWindow nHPct, tPt.x, tPt.y, 16, 16, 1
' End If
'End If
'End Sub
'查找页面关键字,供外部使用
Public Sub FindKeyWord()
If loadedBrowserCount > 0 Then
webbState(gActiveWebIndex).webForm.FindWord (cmbSearch.Text)
End If
End Sub
Private Sub TrnToBtnBar_MouseDown(Button As Integer, Shift As Integer, x As Long, y As Long, btn As cButton)
turntoX = x: turntoY = y
turntoCan = True
turntoButtonDown = True
End Sub
Private Sub TrnToBtnBar_MouseMove(Button As Integer, Shift As Integer, x As Long, y As Long, btn As cButton)
On Error Resume Next
Dim tXY As POINTAPI
Dim tWRC As RECT
Dim tId&
If Button = vbLeftButton Then
If Abs(x - turntoX) > 4 Or Abs(y - turntoY) > 4 Then
turntoCan = False
Call GetWindowRect(pctTurnBtn.hWnd, tWRC)
tXY.x = tWRC.Left: tXY.y = tWRC.Bottom + 1
'Call ScreenToClient(Me.hwnd, tXY)
'btn.ButtonState = cbtnNormal
'Me.PopupMenu mnuTurnto, 0, tXY.x * 15, tXY.y * 15
tId = mPopmnuTurnTo.Popup(False, tXY.x, tXY.y)
Call DoTurntoMenu(tId)
'cbnTurnto.Refresh
btn.ButtonState = cbtnNormal
turntoButtonDown = False
addbarGetFocus = False
End If
End If
End Sub
'处理"转到"按钮菜单
Private Sub DoTurntoMenu(id&)
Select Case id
Case mIDM_Turnto_TT
Call OpenAddressUrl(False)
Case mIDM_Turnto_NewTab
Call OpenAddressUrl(True)
Case mIDM_Turnto_NewIE
Call NewIE(cmbAdd.Text)
Case mIDM_Turnto_GoUp
Call Turnto_GoUp
Case Else
Call ReplaceAddress(CLng(id - mOffset_Turnto))
End Select
End Sub
Private Sub Turnto_GoUp()
Dim turl$
If GetUpUrl(cmbAdd.Text, turl) Then
If vkPress(VK_SHIFT) Then
cmbAdd.Text = turl
Else
If loadedBrowserCount > 0 Then
webbState(gActiveWebIndex).webForm.Navigate turl
Else
cmbAdd.Text = turl
End If
End If
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : GetUpUrl
' DateTime : 2005-8-15 23:37
' Author : Lingll
' Purpose : 获取上一级地址
'---------------------------------------------------------------------------------------
Private Function GetUpUrl(ByVal vUrl$, vUperUrl$) As Boolean
Dim tPos&, tBPos&
Dim tPoPos&
Dim tRtn As Boolean
tBPos = InStr(1, vUrl, "//")
If Right$(vUrl, 1) = "/" Then
tPos = InStrRev(vUrl, "/", Len(vUrl) - 1)
Else
tPos = InStrRev(vUrl, "/")
End If
tRtn = False
If tPos > 0 Then
If tPos > tBPos + 1 Or tBPos = 0 Then
vUperUrl = Left$(vUrl, tPos)
tRtn = True
Else
If tBPos > 0 Then
tPoPos = InStr(tBPos, vUrl, ".")
If tPoPos > 0 Then
If LCase(Mid(vUrl, tBPos + 2, tPoPos - tBPos - 2)) <> "www" Then
vUperUrl = Left$(vUrl, tBPos + 1) & "www" & Mid(vUrl, tPoPos)
tRtn = True
End If
End If
End If
End If
End If
GetUpUrl = tRtn
End Function
Private Sub TrnToBtnBar_MouseUp(Button As Integer, Shift As Integer, x As Long, y As Long, btn As cButton)
If turntoCan Then
If Button = vbLeftButton Then
If Abs(x - turntoX) < 4 And Abs(y - turntoY) < 4 Then
cmbAdd.AddItem cmbAdd.Text
If loadedBrowserCount > 0 Then
webbState(gActiveWebIndex).webForm.Navigate cmbAdd.Text, False
Else
Call NewWebbrowser(cmbAdd.Text)
End If
turntoButtonDown = False
addbarGetFocus = False
End If
End If
End If
End Sub
'处理收藏夹菜单弹出子菜单时
Public Sub SubCls_INITMENUPOPUP(ByVal wParam As Long)
Dim i&, tcnt&
Select Case GetMenuParam(wParam)
Case MenuData_MainMenu
tcnt = GetMenuItemCount(gHMainMenu)
For i = 0 To tcnt - 1
If wParam = GetSubMenu(gHMainMenu, i) Then
Call SetMainMenuState(i)
Exit For
End If
Next i
Case MenuData_FavoriteMenu
For i = 1 To subMenuCount
If wParam = loadSubInfo(i).hWnd And (Not loadSubInfo(i).isLoadSub) Then
'SeedFile loadSubInfo(i).path, loadSubInfo(i).hWnd, , , loadSubInfo(i).hNode
Call SeekFavoriteFolder(loadSubInfo(i).path, loadSubInfo(i).hWnd, , , loadSubInfo(i).hNode)
loadSubInfo(i).isLoadSub = True
Exit For
End If
Next i
Case Else
If wParam = pMnu_DlCtl.hWnd Then
Call SetDlCtrlMenuState
End If
End Select
mSelectedIsSubmenu = False
mSelectedMenu = wParam
End Sub
'
'---------------------------------------------------------------------------------------
' Procedure : SetDlCtrlMenuState
' DateTime : 2005-6-21 12:39
' Author : Lingll
' Purpose : 处理DlCtrl菜单状态
'---------------------------------------------------------------------------------------
Private Sub SetDlCtrlMenuState()
Dim tFrm As frmBrowser
Set tFrm = webbState(gActiveWebIndex).webForm
With pMnu_DlCtl
.CheckItem 0, tFrm.DL_Image, False
.CheckItem 1, tFrm.DL_BgSound, False
.CheckItem 2, tFrm.DL_Video, False
.CheckItem 3, tFrm.DL_Script, False
.CheckItem 4, tFrm.DL_ActiveX, False
.CheckItem 5, tFrm.DL_JavaApplet, False
.CheckItem 6, tFrm.Dl_DlActiveX, False
End With
End Sub
'处理收藏夹菜单选择时
Public Sub SubCls_MENUSELECT(ByVal wParam&, ByVal lParam&)
Dim tMnuStyle&, tMnuId&
Dim urlIndex&
tMnuStyle = (wParam And &HFFFF0000) / &H10000
If (tMnuStyle And MF_POPUP) <> MF_POPUP Then
tMnuId = wParam And &HFFFF&
urlIndex = tMnuId - MenuIDOffset
If urlIndex >= 1 And urlIndex <= itemMenuCount Then
ChangeStatusText favoriteInfo(urlIndex).url
Else
ChangeStatusText ""
End If
Else
ChangeStatusText ""
End If
mSelectedIsSubmenu = _
(((wParam / &H10000) And MF_POPUP) <> 0) And _
(((wParam / &H10000) And MF_GRAYED) = 0)
mSelectedMenu = lParam
End Sub
'处理收藏夹菜单的 WM_COMMAND
Public Sub SubCls_COMMAND(ByVal wParam&, hSubMenu&)
Dim notRun As Boolean
Dim SelectIndex As Long
notRun = True
SelectIndex = wParam - MenuIDOffset
If SelectIndex >= 1 And SelectIndex <= itemMenuCount Then
If (GetAsyncKeyState(VK_SHIFT) And &H8000) = 0 Then
favConet favoriteInfo(SelectIndex).url
ClickFavorite favoriteInfo(SelectIndex).Title, favoriteInfo(SelectIndex).url
Else
favConet favoriteInfo(SelectIndex).url, False
ClickFavorite favoriteInfo(SelectIndex).Title, favoriteInfo(SelectIndex).url
End If
Else
Select Case wParam
Case 9999
Call ShowFloatSubFav(hSubMenu)
Case 9998
Call OpenAllLink(hSubMenu)
End Select
End If
End Sub
'处理 WM_MOVE ,WM_SIZE
Public Sub SubCls_MoveSize()
If Not gFullScreenMode Then
Dim tTitleBar As PTITLEBARINFO
Dim bX As Long, bY As Long
tTitleBar.cbSize = Len(tTitleBar)
Call GetTitleBarInfo(Me.hWnd, tTitleBar)
bX = GetSystemMetrics(SM_CXSIZE) - 2
bY = GetSystemMetrics(SM_CYSIZE) - 4
MoveWindow fraTitleButton.hWnd, tTitleBar.rcTitleBar.Right - 4 * bX - 2 - 2 - 3, tTitleBar.rcTitleBar.Top + 2, bX, bY, 1
MoveWindow cmdTray.hWnd, 0, 0, bX, bY, 1
End If
End Sub
'系统颜色改变时
Public Sub UpdateButtonColor()
TabBar.Refresh
TrnToBtnBar.Refresh
TabGoLeftBar.Refresh
TabGoRightBar.Refresh
m_cRebar.UpdateSystemColor
End Sub
'##########################################
'==== 主菜单模拟菜单相关函数 =========
Public Sub DropMenu_MouseMove(x&, y&)
Dim tPos&, tId&
'Dim tTop&, tLeft&
If WindowFromPoint(x, y) = mcTbrMainMenu.hwndToolbar Then
tPos = mcTbrMainMenu.Hittest(x, y)
If tPos >= 0 Then
tId = mcTbrMainMenu.GetButton(tPos, False)
If mDropdownId <> tId Then
If tId > 0 Then
mPopId = tId
PostMessage Me.hWnd, WM_CANCELMODE, 0, 0
End If
End If
End If
End If
End Sub
Private Sub DropMenu_EnuDropDown(id&)
Dim tx&, ty&
mcTbrMainMenu.GetBtnRect id, tx, ty
PostMessage mcTbrMainMenu.hwndToolbar, WM_LBUTTONDOWN, MK_LBUTTON, ByVal (ty * &H10000 + tx)
PostMessage mcTbrMainMenu.hwndToolbar, WM_LBUTTONDOWN, MK_LBUTTON, ByVal (ty * &H10000 + tx)
End Sub
Private Sub DropMenu_EnuDropDown2(id&)
Dim tx&, ty&
mcTbrMainMenu.GetBtnRect id, tx, ty
PostMessage mcTbrMainMenu.hwndToolbar, WM_LBUTTONDOWN, MK_LBUTTON, ByVal (ty * &H10000 + tx)
End Sub
Public Sub DropMenu_ShowNextMenu(nNext As Boolean)
Dim tPos&, tcnt&
tPos = mcTbrMainMenu.GetButton(mDropdownId, True)
If tPos >= 0 Then
tcnt = mcTbrMainMenu.ButtonCount
If nNext Then
tPos = tPos + 1
If tPos >= tcnt Then tPos = 0
Else
tPos = tPos - 1
If tPos < 0 Then tPos = tcnt - 1
End If
If mSelectedIsSubmenu And nNext Then
ElseIf (mSelectedMenu <> mDropMenuHwnd) And (Not nNext) Then
Else
mPopId = mcTbrMainMenu.GetButton(tPos, False)
PostMessage Me.hWnd, WM_CANCELMODE, 0, 0
End If
End If
End Sub
Public Function DropMenu_KeyDown(KeyCode&, lParam&) As Long
Dim rtn&
Dim tId&
'Dim tnr As NMTOOLBAR_id
tId = -1
rtn = 0
'Debug.Print "keydown", KeyCode, (lParam And &H40000000) = 0
If KeyCode = VK_MENU Then
Call GetAsyncKeyState(vbKeyTab)
If vkPress(VK_CONTROL) Or vkPress(VK_SHIFT) Then
mCanTrackPopMenu = False
Else
mCanTrackPopMenu = True
End If
Else
If (lParam And &H20000000) <> 0 Then
mCanTrackPopMenu = False
End If
End If
If mInDropDown Then
If KeyCode = VK_MENU Then
mDropDownPressMenu = True
End If
Else
If KeyCode = VK_MENU Or KeyCode = VK_ESCAPE Then
If mInHotTack Then
mcTbrMainMenu.SetHotButton (-1)
mInHotTack = (KeyCode = VK_MENU)
rtn = 1
End If
Else
'If vkPress(VK_MENU) Then
If (lParam And &H20000000) <> 0 Then
If mcTbrMainMenu.GetAcceleratorButton(KeyCode, tId) Then
If tId > 0 Then
rtn = 1
DropMenu_EnuDropDown2 tId
End If
End If
Else
If mInHotTack Then
Select Case KeyCode
Case VK_LEFT
Call DropMenu_HotTackNext(False)
rtn = 1
Case VK_RIGHT
Call DropMenu_HotTackNext(True)
rtn = 1
Case VK_UP, VK_DOWN, VK_RETURN
Call DropMenu_DropHotTack
rtn = 1
Case Else
If mcTbrMainMenu.GetAcceleratorButton(KeyCode, tId) Then
If tId > 0 Then
mcTbrMainMenu.SetHotButton (-1)
rtn = 1
Call DropMenu_EnuDropDown2(tId)
End If
End If
End Select
Else
rtn = DropMenu_DoHotkey(KeyCode, lParam)
End If
End If
End If
End If
If mInHotTack Then rtn = 1
DropMenu_KeyDown = rtn
End Function
Private Function DropMenu_DoHotkey(KeyCode&, lParam&) As Long
Dim rtn&
rtn = 0
Select Case KeyCode
Case vbKeyF6
If vkPress(VK_CONTROL) Then
cmbSearch.SetFocus
rtn = 1
Else
cmbAdd.SetFocus
rtn = 1
End If
Case vbKeyF3
If vkPress(VK_CONTROL) Then
Call mnuViewSlide_Click
Else
Call FindKeyWord
End If
Case vbKeyF4
Call mnuCloseTab_Click
Case vbKeyF8
If vkPress(VK_CONTROL) Then
Call mnuViewHide_Click
End If
Case vbKeyF9
Call mnuView_FullScreen_Click
Case vbKeyB
If vkPress(VK_CONTROL) Then
Call mnuNewB_Click
End If
Case vbKeyO
If vkPress(VK_CONTROL) Then
Call mnuOpen_Click
End If
Case vbKeyS
If vkPress(VK_CONTROL) Then
Call mnuSaveAs_Click
End If
Case vbKeyE
If vkPress(VK_CONTROL) Then
Call mnuTabs_NoObject_Click
End If
Case vbKeyW
If vkPress(VK_CONTROL) Then
Call mnuTabs_NoFloat_Click
End If
Case vbKeyH
If vkPress(VK_CONTROL) Then
Call mnuClearMouseLimit_Click
End If
Case vbKeyTab
If vkPress(VK_CONTROL) Then
If vkPress(VK_SHIFT) Then
Call NextLastTab(False)
rtn = 1
Else
Call NextLastTab(True)
rtn = 1
End If
End If
End Select
DropMenu_DoHotkey = rtn
End Function
Private Sub DropMenu_HotTackNext(isNext As Boolean)
Dim tPos&, tcnt&
tPos = mcTbrMainMenu.GetHotButton
If tPos >= 0 Then
tcnt = mcTbrMainMenu.ButtonCount
If isNext Then
tPos = tPos + 1
If tPos >= tcnt Then tPos = 0
Else
tPos = tPos - 1
If tPos < 0 Then tPos = tcnt - 1
End If
mcTbrMainMenu.SetHotButton tPos
End If
End Sub
Private Sub DropMenu_DropHotTack()
Dim tPos& ', tId&
tPos = mcTbrMainMenu.GetHotButton
If tPos >= 0 Then
mcTbrMainMenu.SetHotButton -1
DropMenu_EnuDropDown2 mcTbrMainMenu.GetButton(tPos, False)
End If
End Sub
Public Function DropMenu_KeyUp(KeyCode&, lParam&) As Long
Dim rtn&
rtn = 0
If Not mInDropDown Then
If mDropDownPressMenu Then
mDropDownPressMenu = False
Else
If KeyCode = VK_MENU And mCanTrackPopMenu Then
'Debug.Print GetAsyncKeyState(vbKeyTab) And &H1&
If (GetAsyncKeyState(vbKeyTab) And &H1&) = 0 Then
If mInHotTack Then
mInHotTack = False
rtn = 1
Else
mcTbrMainMenu.SetHotButton (0)
mInHotTack = True
rtn = 1
End If
End If
End If
End If
End If
DropMenu_KeyUp = rtn
End Function
'##########################################
'-------------------------------------------------------
'######################################################
'======== common controls ====================
'---------------------------------------------------------------------------------------
' Procedure : IniStatusBar
' DateTime : 2005-3-27 23:37
' Author : Lingll
' Purpose :
'---------------------------------------------------------------------------------------
Private Sub IniStatusBar()
pctHoldStatus.height = 18 * 15
Set m_cSsbar = CreateCmmCtrl(strCLSID_cStatusbar32) ' New cStatusbar32
With m_cSsbar
.Create pctHoldStatus.hWnd, , False
.SetMinHeight 16
Call SetStatusParts
End With
End Sub
Private Sub SetStatusParts()
Dim tRc As mAPIs.RECT
Dim tW(0 To 1) As Long
If Not m_cSsbar Is Nothing Then
Call mAPIs.GetWindowRect(m_cSsbar.hWnd, tRc)
tW(0) = tRc.Right - tRc.Left - 100
If tW(0) < 0 Then
tW(0) = (tRc.Right - tRc.Left) / 2
End If
tW(1) = -1
m_cSsbar.SetParts 2, tW
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : IniRebar
' DateTime : 2005-8-2 01:05
' Author : Lingll
' Purpose :
'---------------------------------------------------------------------------------------
Private Sub IniRebar()
Dim tW&, tH&
Set m_cRebar = CreateCmmCtrl(strCLSID_cRebar)
With m_cRebar
.Create pctReBar.hWnd, 0, 0, pctReBar.ScaleWidth, pctReBar.ScaleHeight, RBS_Default
'菜单栏
mcTbrMainMenu.GetTbrMaxSize tW, tH
.AddBands ID_Band_MainMenu, mcTbrMainMenu.hwndToolbar, RBBS_USECHEVRON, _
GetSystemMetrics(SM_CXSCREEN) - GetTbrWidth2(m_cTbrSmall) - 20, _
tW
'小工具栏
m_cTbrSmall.GetTbrMaxSize tW, tH
.AddBands ID_Band_SmallTbr, m_cTbrSmall.hwndMsgwin, RBBS_USECHEVRON, _
GetSystemMetrics(SM_CXSCREEN), tW
'主工具栏
.AddBands ID_Band_MainTbr, m_cTbrMain.hwndMsgwin, RBBS_BREAK
'地址栏
.AddBands ID_Band_Address, pctAddress.hWnd, RBBS_BREAK, _
GetSystemMetrics(SM_CXSCREEN) * 3 / 5, , "地址"
'搜索栏
.AddBands ID_Band_SearchTbr, mcTbrSearch.hwndMsgwin, , _
GetSystemMetrics(SM_CXSCREEN) * 2 / 5, , "搜索"
'标签栏
.AddBands ID_Band_Tabs, pctTabs.hWnd, RBBS_BREAK
.SetBandChildSize ID_Band_MainMenu, 50, 21, , , , False
.SetBandChildSize ID_Band_MainTbr, 30, 26, , , , False
.SetBandChildSize ID_Band_Address, 0, 22, , , , False
.SetBandChildSize ID_Band_Tabs, 0, 20, , , , False
.SetBandChildSize ID_Band_SearchTbr, 0, 22, , , , False
Call ResizeTbr
End With
End Sub
'---------------------------------------------------------------------------------------
' Procedure : IniFavoriteTree
' DateTime : 2005-3-28 18:12
' Author : Lingll
' Purpose :
'---------------------------------------------------------------------------------------
Private Sub IniFavoriteTree()
Set m_cTvwFav = CreateCmmCtrl(strCLSID_cTreeView32) ' New cTreeView32
With m_cTvwFav
.Create pctSideBandHold.hWnd, _
TVS_HASBUTTONS Or TVS_LINESATROOT Or TVS_SHOWSELALWAYS Or _
TVS_INFOTIP Or TVS_HASLINES Or TVS_TRACKSELECT, _
0, 0, 100, 100
.SetImageList TVSIL_NORMAL, 0, 16, 16, LoadImageEx(IDB_MenuIcon, "gif").handle, &HFF00FF
.SetToopTipTopMost
End With
End Sub
'---------------------------------------------------------------------------------------
' Procedure : IniSideBarFavTbr
' DateTime : 2005-3-29 16:00
' Author : Lingll
' Purpose : 初始化边栏工具栏
'---------------------------------------------------------------------------------------
Private Sub IniSideBarTbr()
Set m_cTbrSidebar = CreateCmmCtrl(strCLSID_cToolBar) ' New cToolBar
With m_cTbrSidebar
.CreateToolbar pctHoldFavorite.hWnd, True, True, 13, 13, , TBSTYLE_EX_Default Or TBSTYLE_EX_MIXEDBUTTONS
.AddImages LoadImageEx(IDB_OtherBar, "gif").handle, &HFF00FF
.AddButton 101, "float", 5, BTNS_AUTOSIZE Or BTNS_CHECK
.SetButtonState 101, TBSTATE_CHECKED Or TBSTATE_ENABLED
.AddButton 102, "关闭", 4
.SetMaxSize
.SetToopTipTopMost
End With
End Sub
'---------------------------------------------------------------------------------------
' Procedure : IniSmallTbr
' DateTime : 2005-3-29 20:19
' Author : Lingll
' Purpose : 初始化小工具栏
'---------------------------------------------------------------------------------------
Private Sub IniSmallTbr()
Dim tPop As cPopMenu
Dim tDesc(0 To 7) As cButtonPosInfo ' String
Dim i&
Set m_cTbrSmall = CreateCmmCtrl(strCLSID_cToolBar) ' New cToolBar
With m_cTbrSmall
.CreateToolbar pctReBar.hWnd, True, True, 13, 13, , TBSTYLE_EX_Default Or TBSTYLE_EX_MIXEDBUTTONS
.AddImages LoadImageEx(IDB_OtherBar, "gif"), &HFF00FF
.AddButton TbrID_Small_LastTab, "上一窗口", 0
.AddButton TbrID_Small_NextTab, "下一窗口", 1
.AddButton TbrID_Small_Min, "最小化|还原", 2
.AddButton TbrID_Small_Max, "最大化|还原", 3, BTNS_DROPDOWN Or BTNS_AUTOSIZE
.AddButton TbrID_Small_Close, "关闭当前页", 4, BTNS_DROPDOWN Or BTNS_AUTOSIZE
.AddButton 106, vbNullString, 0, BTNS_SEP
.AddButton TbrID_Small_LockPresent, "不激活新窗口", 5, BTNS_CHECK Or BTNS_AUTOSIZE
.CheckButton TbrID_Small_LockPresent, isLockPresentWeb = 1
.AddButton TbrID_Small_LockNew, "总在新窗口打开", 6, BTNS_AUTOSIZE Or BTNS_CHECK
End With
Set tPop = New cPopMenu
With tPop
.Create
.Add "还原所有(&R)", , 101
.Add "最大化所有(&X)", , 102
End With
m_cTbrSmall.p_colBff.Add tPop, "max"
Set tPop = New cPopMenu
With tPop
.Create
.Add "反向", , 101
.Add "类似", , 102
.Add "所有", , 103
.Add vbNullString, pmsSeparator
.Add "当前", , 104, True
End With
m_cTbrSmall.p_colBff.Add tPop, "close"
For i = 0 To 7
Set tDesc(i) = New cButtonPosInfo
tDesc(i).o_Pos = i
Next i
Dim tArr() As Long
Call LoadTbrButtonPos("small", tArr)
tDesc(0).IniMe "上一窗口", TbrID_Small_LastTab, tArr(0)
tDesc(1).IniMe "下一窗口", TbrID_Small_NextTab, tArr(1)
tDesc(2).IniMe "最小化|还原", TbrID_Small_Min, tArr(2)
tDesc(3).IniMe "最大化|还原", TbrID_Small_Max, tArr(3)
tDesc(4).IniMe "关闭当前页", TbrID_Small_Close, tArr(4)
tDesc(5).IniMe "----", 106, tArr(5)
tDesc(6).IniMe "不激活新窗口", TbrID_Small_LockPresent, tArr(6)
tDesc(7).IniMe "总在新窗口打开", TbrID_Small_LockNew, tArr(7)
For i = 0 To gTbrSmallBtnCnt - 1
m_cTbrSmall.ShowButton m_cTbrSmall.GetButton(i, False), gTbrSmallBtnShow(i) = 1
Next i
Dim tBif As New cButtonPosInfo
tBif.SortByPos tDesc
m_cTbrSmall.p_colBff.Add tDesc, "desarr"
For i = 0 To gTbrSmallBtnCnt - 1
m_cTbrSmall.MoveButton m_cTbrSmall.GetButton(tDesc(i).id, True), i
m_cTbrSmall.ShowButton tDesc(i).id, tDesc(i).vis
Next i
End Sub
'---------------------------------------------------------------------------------------
' Procedure : IniMainTbr
' DateTime : 2005-3-29 20:20
' Author : Lingll
' Purpose : 初始化主工具栏
'---------------------------------------------------------------------------------------
Private Sub IniMainTbr()
Dim tPop As cPopMenu
Dim tDesc(0 To gTbrMainBtnCnt - 1) As cButtonPosInfo ' String
Dim i&
Set m_cTbrMain = CreateCmmCtrl(strCLSID_cToolBar) ' New cToolBar
With m_cTbrMain
.CreateToolbar pctReBar.hWnd, True, True, 20, 20, , TBSTYLE_EX_Default Or TBSTYLE_EX_MIXEDBUTTONS
.AddImages LoadImageEx(IDB_MainBar, "gif").handle, &HFF00FF
.SetImageList TBI_ImglstType_Gray, 0, 20, 20, LoadImageEx(IDB_MainBar_Gray, "gif").handle, &HFF00FF
.AddButton TbrID_Main_New, "新建", 0, BTNS_AUTOSIZE Or BTNS_DROPDOWN
.AddButton TbrID_Main_Back, "后退", 1, BTNS_AUTOSIZE Or BTNS_DROPDOWN
.AddButton TbrID_Main_Forward, "前进", 2, BTNS_AUTOSIZE Or BTNS_DROPDOWN
.AddButton TbrID_Main_Stop, "停止", 3
.AddButton TbrID_Main_Refresh, "刷新", 4
.AddButton TbrID_Main_Favorites, "收藏", 5, BTNS_AUTOSIZE Or BTNS_DROPDOWN
.AddButton TbrID_Main_Proxy, "代理", 6, BTNS_AUTOSIZE Or BTNS_DROPDOWN
.AddButton TbrID_Main_FontSize, "文字大小", 7, BTNS_AUTOSIZE Or BTNS_WHOLEDROPDOWN
.AddButton TbrID_Main_AutoPreventPop, "自动过滤(当前窗口)", 8, BTNS_AUTOSIZE Or BTNS_DROPDOWN
.AddButton TbrID_Main_Reopen, "最近关闭的页面", 9, BTNS_AUTOSIZE Or BTNS_DROPDOWN
.AddButton TbrID_Main_DLCtrl, "下载控制(当前窗口)", 10, BTNS_AUTOSIZE Or BTNS_WHOLEDROPDOWN
.AddButton TbrID_Main_Option, "选项", 11, BTNS_AUTOSIZE Or BTNS_DROPDOWN
.AddButton TbrID_Main_FullScreen, "全屏", 12
.AddButton TbrID_Main_SideBand, "侧边栏", 13, BTNS_AUTOSIZE Or BTNS_WHOLEDROPDOWN
End With
Set tPop = New cPopMenu
With tPop
.Create
.Add "空白页", , 1, True
.Add "当前页", , 2
.Add "剪贴板", , 3
.Add vbNullString, pmsSeparator
.Add "IE(空白)", , 4
.Add "IE(当前)", , 5
End With
m_cTbrMain.p_colBff.Add tPop, "new"
Set tPop = New cPopMenu
tPop.Create
m_cTbrMain.p_colBff.Add tPop, "back"
Set tPop = New cPopMenu
tPop.Create
m_cTbrMain.p_colBff.Add tPop, "forward"
For i = 0 To gTbrMainBtnCnt - 1
Set tDesc(i) = New cButtonPosInfo
tDesc(i).o_Pos = i
Next i
Dim tArr() As Long
Call LoadTbrButtonPos("main", tArr)
tDesc(0).IniMe "新建", TbrID_Main_New, tArr(0)
tDesc(1).IniMe "后退", TbrID_Main_Back, tArr(1)
tDesc(2).IniMe "前进", TbrID_Main_Forward, tArr(2)
tDesc(3).IniMe "停止", TbrID_Main_Stop, tArr(3)
tDesc(4).IniMe "刷新", TbrID_Main_Refresh, tArr(4)
tDesc(5).IniMe "收藏", TbrID_Main_Favorites, tArr(5)
tDesc(6).IniMe "代理", TbrID_Main_Proxy, tArr(6)
tDesc(7).IniMe "文字大小", TbrID_Main_FontSize, tArr(7)
tDesc(8).IniMe "自动过滤(当前窗口)", TbrID_Main_AutoPreventPop, tArr(8)
tDesc(9).IniMe "最近关闭的页面", TbrID_Main_Reopen, tArr(9)
tDesc(10).IniMe "下载控制(当前窗口)", TbrID_Main_DLCtrl, tArr(10)
tDesc(11).IniMe "选项", TbrID_Main_Option, tArr(11)
tDesc(12).IniMe "全屏", TbrID_Main_FullScreen, tArr(12)
tDesc(13).IniMe "侧边栏", TbrID_Main_SideBand, tArr(13)
Dim tBif As New cButtonPosInfo
tBif.SortByPos tDesc
m_cTbrMain.p_colBff.Add tDesc, "desarr"
For i = 0 To gTbrMainBtnCnt - 1
m_cTbrMain.MoveButton m_cTbrMain.GetButton(tDesc(i).id, True), i
m_cTbrMain.ShowButton tDesc(i).id, tDesc(i).vis
Next i
'For i = 0 To gTbrMainBtnCnt - 1
' m_cTbrMain.ShowButton m_cTbrMain.GetButton(i, False), gTbrMainBtnShow(i) = 1
'Next i
End Sub
'#####################################################
'---------------------------------------------------------------------------------------
' Procedure : LoadAddUrlz
' DateTime : 2005-4-15 21:34
' Author : Lingll
' Purpose : 添加地址栏输入历史记录
'---------------------------------------------------------------------------------------
Private Sub LoadAddUrlz()
Dim tCoN As Collection, tCoTy As Collection
Dim i&, tstr$, tType&
Dim tcnt&
cmbAdd.Clear
Call EnumRegValue(HKEY_CURRENT_USER, "SoftwareMicrosoftInternet ExplorerTypedUrls", _
tCoN, tCoTy)
tcnt = tCoN.Count
For i = 1 To tcnt
tstr = tCoN(i)
tType = tCoTy(i)
If tType = REG_SZ Then
cmbAdd.AddItem QueryValue(HKEY_CURRENT_USER, "SoftwareMicrosoftInternet ExplorerTypedUrls", tstr)
End If
Next i
gAddUrlCnt = cmbAdd.ListCount
ReDim gAddUrlz(0 To gAddUrlCnt)
For i = 1 To gAddUrlCnt
gAddUrlz(i) = cmbAdd.List(i - 1)
Next i
End Sub
'---------------------------------------------------------------------------------------
' Procedure : SaveAddUrlz
' DateTime : 2005-4-15 22:08
' Author : Lingll
' Purpose : 保存地址栏输入历史记录
'---------------------------------------------------------------------------------------
Private Sub SaveAddUrlz()
Dim i&
Dim hKey&
If RegOpenKey(HKEY_CURRENT_USER, "SoftwareMicrosoftInternet ExplorerTypedUrls", hKey) = 0 Then
SHDeleteKey HKEY_CURRENT_USER, "SoftwareMicrosoftInternet ExplorerTypedUrls"
End If
RegCreateKey HKEY_CURRENT_USER, "SoftwareMicrosoftInternet ExplorerTypedUrls", hKey
If hKey <> 0 Then
For i = 1 To gAddUrlCnt
RegSetValueExString hKey, "url" & LTrim$(Str$(i)), 0, REG_SZ, gAddUrlz(i), LenB(gAddUrlz(i))
Next i
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : AddAddbarUrl
' DateTime : 2005-4-15 22:31
' Author : Lingll
' Purpose : 添加地址栏历史记录
'---------------------------------------------------------------------------------------
Private Sub AddAddbarUrl(vUrl$)
Dim i&
Dim turl$
Dim inOldIndex&
vUrl = Trim$(vUrl)
If LenB(vUrl) = 0 Then Exit Sub
turl = LCase$(vUrl)
inOldIndex = 0
For i = 1 To gAddUrlCnt
If LCase$(gAddUrlz(i)) = turl Then
inOldIndex = i
End If
Next i
If inOldIndex > 0 Then
Else
gAddUrlCnt = gAddUrlCnt + 1
ReDim Preserve gAddUrlz(0 To gAddUrlCnt)
gAddUrlz(gAddUrlCnt) = vUrl
inOldIndex = gAddUrlCnt
End If
For i = inOldIndex To 2 Step -1
SwapData VarPtr(gAddUrlz(i)), VarPtr(gAddUrlz(i - 1))
Next i
If inOldIndex = 1 And gAddUrlCnt > 1 Then
Else
cmbAdd.Clear
For i = 1 To gAddUrlCnt
cmbAdd.AddItem gAddUrlz(i)
Next i
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : GetWindowOrder
' DateTime : 2005-4-16 12:06
' Author : Lingll
' Purpose : 获得窗口zorder表
'---------------------------------------------------------------------------------------
Private Sub GetWindowOrder(coOrder As Collection)
Dim tHwnd&
If coOrder Is Nothing Then
Set coOrder = New Collection
End If
If loadedBrowserCount > 0 Then
tHwnd = webbState(gActiveWebIndex).webForm.hWnd
While tHwnd <> 0
coOrder.Add tHwnd
tHwnd = GetWindow(tHwnd, GW_HWNDNEXT)
Wend
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : SideBandParentHwnd
' DateTime : 2005-5-30 00:47
' Author : Lingll
' Purpose : hwnd of side band
'---------------------------------------------------------------------------------------
Public Property Get SideBandParentHwnd() As Long
SideBandParentHwnd = pctSideBandHold.hWnd
End Property
Public Sub SetSidebandSize(vBand As cPluginSideband)
vBand.Resize 0, 0, _
pctSideBandHold.ScaleWidth, _
pctSideBandHold.ScaleHeight
End Sub
'---------------------------------------------------------------------------------------
' Procedure : UnloadPlugins
' DateTime : 2005-6-14 21:25
' Author : Lingll
' Purpose : 卸载插件
'---------------------------------------------------------------------------------------
Private Sub UnloadPlugins()
Dim i&
For i = 1 To gPluginCnt
Set gPlugins(i) = Nothing
Next i
For i = 1 To gPluginSBCnt
Set gPluginsSideBand(i) = Nothing
Next i
End Sub