浏览器

开发平台：

Visual Basic

frmOption.frm：源码内容

'Private Sub cmdExtoolDel_Click()
'Dim tIndex&, tItem As MSComctlLib.ListItem
'Dim i&
'Set tItem = lvwExtoolListall.SelectedItem
'If Not tItem Is Nothing Then
' tIndex = tItem.index
' mExToolsCount = mExToolsCount - 1
' For i = tIndex To mExToolsCount
' mExTools(i) = mExTools(i + 1)
' Next i
' lvwExtoolListall.ListItems.Remove tIndex
' If mExToolsCount > 0 Then
' If tIndex <= mExToolsCount Then
' lvwExtoolListall.ListItems(tIndex).Selected = True
' Call ClickExtoolItem(tIndex)
' Else
' lvwExtoolListall.ListItems(mExToolsCount).Selected = True
' Call ClickExtoolItem(mExToolsCount)
' End If
' End If
'End If
'End Sub
'
'Private Sub cmdExtoolDown_Click()
'Dim tItem As MSComctlLib.ListItem
'Set tItem = lvwExtoolListall.SelectedItem
'If Not tItem Is Nothing Then
' Call MoveExtoolItem(tItem.index, 1)
'End If
'End Sub
'Private Sub cmdExtoolOk_Click()
'Dim i&
'ExToolsCount = mExToolsCount
'ReDim ExTools(0 To ExToolsCount)
'For i = 1 To ExToolsCount
' ExTools(i) = mExTools(i)
'Next i
'Call gMainForm.LoadExToolsMenu
'MsgBox "Finish", vbOKOnly
'End Sub
'Private Sub cmdExtoolUp_Click()
'Dim tItem As MSComctlLib.ListItem
'Set tItem = lvwExtoolListall.SelectedItem
'If Not tItem Is Nothing Then
' Call MoveExtoolItem(tItem.index, -1)
'End If
'End Sub
Private Sub cmdFilterOK_Click()
Dim i&
UrlFilterCount = lstFliterList.ListCount
ReDim UrlFilter(0 To UrlFilterCount)
For i = 1 To UrlFilterCount
UrlFilter(i) = lstFliterList.List(i - 1)
Next i
End Sub
Private Sub cmdMouseHandAdd_Click()
Dim tItem&
MouseHand.AddHand
With m_cLvwMouseHand
tItem = .AddItem("鼠标手势:")
.SetItemText "(无)", tItem, 1
.SelectItem tItem, True
End With
'Dim tItem As MSComctlLib.ListItem
'MouseHand.AddHand
'With lvwMouseHand
' Set tItem = .ListItems.Add(, , "鼠标手势:")
' tItem.SubItems(1) = "(无)"
' Set .SelectedItem = tItem
' Call lvwMouseHand_ItemClick(tItem)
'End With
End Sub
Private Sub cmdMouseHandDel_Click()
Dim tItem&
Dim tIndex&
tItem = m_cLvwMouseHand.GetNextItem(-1, LVNI_SELECTED)
If tItem >= 0 Then
tIndex = tItem + 1
If MouseHand.RemoveHand(tIndex) Then
m_cLvwMouseHand.DelItem tItem
If m_cLvwMouseHand.GetItemCount < tIndex Then
tItem = m_cLvwMouseHand.GetItemCount - 1
End If
If tItem >= 0 Then
m_cLvwMouseHand.SelectItem tItem, True
End If
End If
End If
'Dim tItem As MSComctlLib.ListItem
'Dim tIndex&
'Set tItem = lvwMouseHand.SelectedItem
'If Not tItem Is Nothing Then
' tIndex = tItem.index
' If MouseHand.RemoveHand(tIndex) Then
' lvwMouseHand.ListItems.Remove tIndex
' If lvwMouseHand.ListItems.Count < tIndex Then
' tIndex = lvwMouseHand.ListItems.Count
' End If
' If tIndex > 0 Then
' Set tItem = lvwMouseHand.ListItems(tIndex)
' Set lvwMouseHand.SelectedItem = tItem
' Call lvwMouseHand_ItemClick(tItem)
' End If
' End If
'End If
End Sub
Private Sub cmdMouseHandDir_Click(index As Integer)
If Len(labMouseHandShow.Caption) < 3 Then
labMouseHandShow.Caption = labMouseHandShow.Caption & _
cmdMouseHandDir(index).Caption
mHand(Len(labMouseHandShow.Caption) - 1) = index + 1
Debug.Print mHand(0), mHand(1), mHand(2)
End If
End Sub
Private Sub cmdMouseHandDirBlank_Click()
If labMouseHandShow.Caption <> "" Then
labMouseHandShow.Caption = Left(labMouseHandShow.Caption, _
Len(labMouseHandShow.Caption) - 1)
mHand(Len(labMouseHandShow.Caption)) = 0
Debug.Print mHand(0), mHand(1), mHand(2)
End If
End Sub
Private Sub cmdMouseHandUpdateHand_Click()
Dim tItem&
tItem = m_cLvwMouseHand.GetNextItem(-1, LVNI_SELECTED)
If tItem >= 0 Then
Call MouseHand.ChangeHand_ByIndex(tItem + 1, VarPtr(mHand(0)))
MouseHand.GetHand tItem + 1, VarPtr(mHand(0))
Call ShowMouseHand
m_cLvwMouseHand.SetItemText MouseHand.GetDescription(tItem + 1), tItem
End If
'Dim tItem As MSComctlLib.ListItem
'Set tItem = lvwMouseHand.SelectedItem
'If Not tItem Is Nothing Then
' Debug.Print MouseHand.ChangeHand_ByIndex(tItem.index, VarPtr(mHand(0)))
' MouseHand.GetHand tItem.index, VarPtr(mHand(0))
' Call ShowMouseHand
'
' tItem.Text = MouseHand.GetDescription(tItem.index)
'End If
End Sub
Private Sub cmdPageRuleAdd_Click()
mPageRuleCnt = mPageRuleCnt + 1
ReDim Preserve mPageRule(0 To mPageRuleCnt)
With mPageRule(mPageRuleCnt)
.Title = "新建规则"
.Enabled = 1
.Inherit = True
.ForceChange = False
.AllwaysOpenNew = False
.AutoPreventPop = PreventPopWindow
.DL_Image = gDL_Image
.DL_BgSound = gDL_BgSound
.DL_Video = gDL_Video
.DL_ActiveX = gDL_ActiveX
.DL_Script = gDL_Script
.DL_JavaApplet = gDL_JavaApplet
.OutExeParam = "%url%"
.OutExePath = ""
.Urls = ""
.Type = 0
lstPageRuleList.AddItem .Title
End With
lstPageRuleList.ListIndex = lstPageRuleList.ListCount - 1
lstPageRuleList.Selected(lstPageRuleList.ListCount - 1) = True
txtPageRuleTitle.SetFocus
End Sub
Private Sub cmdPageRuleBrowse_Click()
Dim tOpen As OpenSaveDlg
Set tOpen = New OpenSaveDlg
With tOpen
.Filter = "*.exe|*.exe|*.*|*.*"
If .ShowOpen(Me.hWnd) Then
txtPageRuleExepath.Text = .FileName
End If
End With
txtPageRuleExepath.SetFocus
End Sub
Private Sub cmdPageRuleDel_Click()
Dim tIndex&, i&
tIndex = lstPageRuleList.ListIndex
If tIndex >= 0 Then
For i = tIndex + 1 To mPageRuleCnt - 1
mPageRule(i) = mPageRule(i + 1)
Next i
mPageRuleCnt = mPageRuleCnt - 1
'ReDim Preserve mPageRule(0 To mPageRuleCnt)
lstPageRuleList.RemoveItem tIndex
If tIndex + 1 <= mPageRuleCnt Then
lstPageRuleList.ListIndex = tIndex
Else
lstPageRuleList.ListIndex = mPageRuleCnt - 1
End If
End If
End Sub
Private Sub cmdPageRuleMoveDown_Click()
Dim tIndex& ', i&
tIndex = lstPageRuleList.ListIndex
If tIndex >= 0 And tIndex < lstPageRuleList.ListCount - 1 Then
Call SwitchPageRule(tIndex + 1, tIndex)
lstPageRuleList.List(tIndex) = mPageRule(tIndex + 1).Title
lstPageRuleList.List(tIndex - 1) = mPageRule(tIndex).Title
lstPageRuleList.ListIndex = tIndex - 1
End If
End Sub
Private Sub cmdPageRuleMoveUp_Click()
Dim tIndex& ', i&
tIndex = lstPageRuleList.ListIndex
If tIndex > 0 Then
Call SwitchPageRule(tIndex + 1, tIndex)
lstPageRuleList.List(tIndex) = mPageRule(tIndex + 1).Title
lstPageRuleList.List(tIndex - 1) = mPageRule(tIndex).Title
lstPageRuleList.ListIndex = tIndex - 1
End If
End Sub
'互相交换两个PageRule
Private Sub SwitchPageRule(index1&, index2&)
Dim tPageRule As mTypPageRule
tPageRule = mPageRule(index1)
mPageRule(index1) = mPageRule(index2)
mPageRule(index2) = tPageRule
End Sub
Private Sub cmdPageRuleOk_Click()
Dim i&, j&, tcnt&, tstr$
PageRuleCnt = mPageRuleCnt
ReDim PageRule(0 To PageRuleCnt)
For i = 1 To PageRuleCnt
With PageRule(i)
.Title = mPageRule(i).Title
.Enabled = mPageRule(i).Enabled
.Type = mPageRule(i).Type
tstr = LCase(mPageRule(i).Urls)
tstr = Replace(tstr, Chr(13) & Chr(10), "")
tstr = Replace(tstr, " ", "")
.Urls = Split(tstr, ";")
.UrlCnt = UBound(.Urls) + 1
tcnt = 0
For j = 0 To .UrlCnt - 1
If Trim$(.Urls(j)) <> "" Then
tcnt = tcnt + 1
If tcnt < j + 1 Then
.Urls(tcnt - 1) = .Urls(j)
End If
End If
Next j
.UrlCnt = tcnt
If .UrlCnt > 0 Then
ReDim Preserve .Urls(0 To .UrlCnt - 1)
End If
If .Type = 0 Then
.AutoPreventPop = mPageRule(i).AutoPreventPop
.DL_ActiveX = mPageRule(i).DL_ActiveX
.DL_BgSound = mPageRule(i).DL_BgSound
.DL_Image = mPageRule(i).DL_Image
.DL_Video = mPageRule(i).DL_Video
.DL_JavaApplet = mPageRule(i).DL_JavaApplet
.DL_Script = mPageRule(i).DL_Script
.AllwaysOpenNew = mPageRule(i).AllwaysOpenNew
.Inherit = mPageRule(i).Inherit
.ForceChange = mPageRule(i).ForceChange
Else
.OutExeParam = mPageRule(i).OutExeParam
.OutExePath = mPageRule(i).OutExePath
End If
End With
Next i
MsgBox "已修改", vbOKOnly + vbInformation
End Sub
Private Sub cmdPlugin_Apply_Click()
Call PluginControlApplyChange
End Sub
Private Sub cmdPlugin_Browse_Click()
Dim tOL As OpenSaveDlg
Set tOL = New OpenSaveDlg
Select Case m_cTabPluginTypes.SelectIndex
Case 0
tOL.InitDir = App.path & "plugin"
tOL.Filter = "*.ini,*.exe|*.ini;*.exe"
Case 1
tOL.InitDir = App.path & "pluginsideband"
tOL.Filter = "*.ini|*.ini"
Case 2
End Select
If tOL.ShowOpen(Me.hWnd) Then
txtPlugin_Command.Text = tOL.FileName
End If
End Sub
Private Sub cmdSave_Click()
Call gMainForm.SaveSettingsToIni(False)
End Sub
'Private Sub cmdSearchAdd_Click()
''mSearchurlCount = mSearchurlCount + 1
''ReDim Preserve mSearchUrl(0 To mSearchurlCount)
''mSearchUrl(mSearchurlCount).Title = "新建"
''lstSearchUrl.AddItem "新建"
''lstSearchUrl.ListIndex = mSearchurlCount - 1
''lstSearchUrl.Selected(mSearchurlCount - 1) = True
''
''Call Show_Listbox_HScrollebar(lstSearchUrl)
'
'End Sub
Private Sub cmdSearchbarAdd_Click()
Dim tItem&
mSearchEgnCount = mSearchEgnCount + 1
ReDim Preserve mSearchEgn(0 To mSearchEgnCount)
tItem = m_cLvwSearchBar.AddItem("")
Call m_cLvwSearchBar.SelectItem(tItem, True)
txtSearchBarTitle.SetFocus
'Dim tItem As MSComctlLib.ListItem
'mSearchEgnCount = mSearchEgnCount + 1
'ReDim Preserve mSearchEgn(0 To mSearchEgnCount)
'Set tItem = lvwSearchBar.ListItems.Add()
'tItem.Selected = True
''Set lvwSearchBar.SelectedItem = tItem
'Call lvwSearchBar_ItemClick(tItem)
'txtSearchBarTitle.SetFocus
End Sub
Private Sub cmdSearchbarApply_Click()
Dim i&
'Dim tTle$
gSearchEgnCount = mSearchEgnCount
ReDim gSearchEgn(0 To gSearchEgnCount)
pMnu_Searchbar.ClearItems
For i = 1 To gSearchEgnCount
gSearchEgn(i) = mSearchEgn(i)
Next i
If gSearchEgnCount > 0 Then
If gDefaultEgn <= 0 Or gDefaultEgn > gSearchEgnCount Then
gDefaultEgn = 1
End If
Else
gDefaultEgn = 0
End If
'多引擎
gMulSearchCount = mMulSearchCount
ReDim gMulSearch(0 To gMulSearchCount)
For i = 1 To gMulSearchCount
gMulSearch(i) = mMulSearch(i)
If gMulSearch(i).Count <> gSearchEgnCount Then
gMulSearch(i).Count = gSearchEgnCount
ReDim Preserve gMulSearch(i).UseMul(0 To gSearchEgnCount)
End If
Next i
If gMulSearchCount > 0 Then
If gDefaultMulEgn <= 0 Or gDefaultMulEgn > gMulSearchCount Then
gDefaultMulEgn = 1
End If
Else
gDefaultMulEgn = 0
End If
Call LoadSearchEgnMenu
Call LoadMulSearchEgnMenu
Call gMainForm.SetSearchbarButtons
End Sub
Private Sub cmdSearchbarDel_Click()
Dim tItem&
Dim tIndex&, i&
tItem = m_cLvwSearchBar.GetNextItem(-1, LVNI_SELECTED)
If tItem >= 0 Then
tIndex = tItem + 1
For i = tIndex To mSearchEgnCount - 1
mSearchEgn(i) = mSearchEgn(i + 1)
Next i
m_cLvwSearchBar.DelItem tItem
With mSearchEgn(mSearchEgnCount)
.Title = ""
.Url = ""
End With
mSearchEgnCount = mSearchEgnCount - 1
'ReDim Preserve mSearchEgn(0 To mSearchEgnCount - 1)
If mSearchEgnCount < tIndex And mSearchEgnCount > 0 Then
m_cLvwSearchBar.SelectItem mSearchEgnCount - 1, True
End If
'Call lvwSearchBar_ItemClick(tItem)
End If
'Dim tItem As MSComctlLib.ListItem
'Dim tIndex&, i&
'Set tItem = lvwSearchBar.SelectedItem
'If Not tItem Is Nothing Then
' tIndex = tItem.index
' For i = tIndex To mSearchEgnCount - 1
' mSearchEgn(i) = mSearchEgn(i + 1)
' Next i
' lvwSearchBar.ListItems.Remove mSearchEgnCount
'
' With mSearchEgn(mSearchEgnCount)
' '.MulSearch = False
' .Title = ""
' .Url = ""
' End With
'
' mSearchEgnCount = mSearchEgnCount - 1
' 'ReDim Preserve mSearchEgn(0 To mSearchEgnCount - 1)
'
' If mSearchEgnCount < tIndex And mSearchEgnCount > 0 Then
' Set tItem = lvwSearchBar.ListItems(mSearchEgnCount)
' tItem.Selected = True
' End If
' Call lvwSearchBar_ItemClick(tItem)
'End If
End Sub
Private Sub cmdSearchbarMoveDown_Click()
Dim tItem&
Dim tIndex&, tEgn As UrlSimpleInfo
tItem = m_cLvwSearchBar.GetNextItem(-1, LVNI_SELECTED)
If tItem >= 0 Then
tIndex = tItem + 1
If (tIndex < mSearchEgnCount) And (mSearchEgnCount > 1) Then
tEgn = mSearchEgn(tIndex)
mSearchEgn(tIndex) = mSearchEgn(tIndex + 1)
mSearchEgn(tIndex + 1) = tEgn
With mSearchEgn(tIndex)
'tItem.Checked = .MulSearch
m_cLvwSearchBar.SetItemText .Title, tItem, 1
m_cLvwSearchBar.SetItemText .Url, tItem, 2
End With
tItem = tItem + 1
With mSearchEgn(tIndex + 1)
'tItem.Checked = .MulSearch
m_cLvwSearchBar.SetItemText .Title, tItem, 1
m_cLvwSearchBar.SetItemText .Url, tItem, 2
End With
Call m_cLvwSearchBar.SelectItem(tItem, True)
'Call lvwSearchBar_ItemClick(tItem)
End If
End If
'Dim tItem As MSComctlLib.ListItem
'Dim tIndex&, tEgn As typSearchEngine
'Set tItem = lvwSearchBar.SelectedItem
'If Not tItem Is Nothing Then
' tIndex = tItem.index
' If (tIndex < mSearchEgnCount) And (mSearchEgnCount > 1) Then
' tEgn = mSearchEgn(tIndex)
' mSearchEgn(tIndex) = mSearchEgn(tIndex + 1)
' mSearchEgn(tIndex + 1) = tEgn
'
' With mSearchEgn(tIndex)
' 'tItem.Checked = .MulSearch
' tItem.SubItems(1) = .Title
' tItem.SubItems(2) = .Url
' End With
'
' Set tItem = lvwSearchBar.ListItems(tIndex + 1)
' With mSearchEgn(tIndex + 1)
' 'tItem.Checked = .MulSearch
' tItem.SubItems(1) = .Title
' tItem.SubItems(2) = .Url
' End With
'
' tItem.Selected = True
' Call lvwSearchBar_ItemClick(tItem)
'
' End If
'End If
End Sub
Private Sub cmdSearchbarMoveup_Click()
Dim tItem&
Dim tIndex&, tEgn As UrlSimpleInfo
tItem = m_cLvwSearchBar.GetNextItem(-1, LVNI_SELECTED)
Debug.Print m_cLvwSearchBar.GetSelectedCount, tItem
If tItem >= 0 Then
tIndex = tItem + 1
If (tIndex > 1) And (mSearchEgnCount > 1) Then
tEgn = mSearchEgn(tIndex)
mSearchEgn(tIndex) = mSearchEgn(tIndex - 1)
mSearchEgn(tIndex - 1) = tEgn
With mSearchEgn(tIndex)
'tItem.Checked = .MulSearch
m_cLvwSearchBar.SetItemText .Title, tItem, 1
m_cLvwSearchBar.SetItemText .Url, tItem, 2
End With
tItem = tItem - 1
With mSearchEgn(tIndex - 1)
'tItem.Checked = .MulSearch
m_cLvwSearchBar.SetItemText .Title, tItem, 1
m_cLvwSearchBar.SetItemText .Url, tItem, 2
End With
m_cLvwSearchBar.SelectItem tItem, True
'Call lvwSearchBar_ItemClick(tItem)
End If
End If
'Dim tItem As MSComctlLib.ListItem
'Dim tIndex&, tEgn As typSearchEngine
'Set tItem = lvwSearchBar.SelectedItem
'If Not tItem Is Nothing Then
' tIndex = tItem.index
' If (tIndex > 1) And (mSearchEgnCount > 1) Then
' tEgn = mSearchEgn(tIndex)
' mSearchEgn(tIndex) = mSearchEgn(tIndex - 1)
' mSearchEgn(tIndex - 1) = tEgn
'
' With mSearchEgn(tIndex)
' 'tItem.Checked = .MulSearch
' tItem.SubItems(1) = .Title
' tItem.SubItems(2) = .Url
' End With
'
' Set tItem = lvwSearchBar.ListItems(tIndex - 1)
' With mSearchEgn(tIndex - 1)
' 'tItem.Checked = .MulSearch
' tItem.SubItems(1) = .Title
' tItem.SubItems(2) = .Url
' End With
'
' tItem.Selected = True
' Call lvwSearchBar_ItemClick(tItem)
'
' End If
'End If
End Sub
Private Sub cmdSearchbarMulegnDel_Click()
Dim i&, tIndex&
tIndex = cmbSearchbarMulegn.ListIndex + 1
If tIndex > 0 Then
For i = tIndex To mMulSearchCount - 1
mMulSearch(i) = mMulSearch(i + 1)
Next i
mMulSearchCount = mMulSearchCount - 1
cmbSearchbarMulegn.RemoveItem tIndex - 1
ReDim Preserve mMulSearch(0 To mMulSearchCount)
End If
End Sub
Private Sub cmdSearchbarMulegnNew_Click()
Dim tTitle$
tTitle = Trim$(InputBox("输入标题:", "新建方案"))
If tTitle <> "" Then
mMulSearchCount = mMulSearchCount + 1
ReDim Preserve mMulSearch(0 To mMulSearchCount)
With mMulSearch(mMulSearchCount)
.Title = tTitle
.Count = mSearchEgnCount
ReDim .UseMul(0 To mSearchEgnCount)
End With
cmbSearchbarMulegn.AddItem tTitle
cmbSearchbarMulegn.ListIndex = mMulSearchCount - 1
End If
End Sub
Private Sub cmdSearchbarMulegnRename_Click()
Dim tTitle$
If cmbSearchbarMulegn.ListIndex >= 0 Then
tTitle = Trim$(InputBox("输入新标题", "重命名", cmbSearchbarMulegn.Text))
If tTitle <> "" Then
mMulSearch(cmbSearchbarMulegn.ListIndex + 1).Title = tTitle
cmbSearchbarMulegn.List(cmbSearchbarMulegn.ListIndex) = tTitle
End If
End If
End Sub
'Private Sub cmdSearchMoveDown_Click()
''Dim tLstIndex As Long
''Dim tInfo As typSearchUrl
''If mSearchurlCount > 0 Then
'' tLstIndex = lstSearchUrl.ListIndex
'' If tLstIndex < mSearchurlCount - 1 Then
'' tInfo = mSearchUrl(tLstIndex + 2)
'' mSearchUrl(tLstIndex + 2) = mSearchUrl(tLstIndex + 1)
'' mSearchUrl(tLstIndex + 1) = tInfo
''
'' lstSearchUrl.List(tLstIndex + 1) = mSearchUrl(tLstIndex + 2).Title
'' lstSearchUrl.List(tLstIndex) = mSearchUrl(tLstIndex + 1).Title
''
'' lstSearchUrl.ListIndex = tLstIndex + 1
'' End If
''End If
'End Sub
'Private Sub cmdSearchMoveUp_Click()
''Dim tLstIndex As Long
''Dim tInfo As typSearchUrl
''If mSearchurlCount > 0 Then
'' tLstIndex = lstSearchUrl.ListIndex
'' If tLstIndex > 0 Then
'' tInfo = mSearchUrl(tLstIndex)
'' mSearchUrl(tLstIndex) = mSearchUrl(tLstIndex + 1)
'' mSearchUrl(tLstIndex + 1) = tInfo
''
'' lstSearchUrl.List(tLstIndex - 1) = mSearchUrl(tLstIndex).Title
'' lstSearchUrl.List(tLstIndex) = mSearchUrl(tLstIndex + 1).Title
''
'' lstSearchUrl.ListIndex = tLstIndex - 1
'' End If
''End If
'End Sub
Private Sub cmdSearchOk_Click()
Dim i&
Call gMainForm.RemoveSearchurlMenu
SearchurlCount = mSearchurlCount
ReDim searchUrl(0 To SearchurlCount)
For i = 1 To SearchurlCount
searchUrl(i) = mSearchUrl(i)
Next i
Call gMainForm.LoadSearchurlMenu
Call LoadAddbarEvent
Call cobAddbarShortkey_Click
End Sub
'Private Sub cmdSearchRemove_Click()
''Dim i&
''Dim tIndex&
''If mSearchurlCount > 0 Then
'' tIndex = lstSearchUrl.ListIndex + 1
''
'' For i = tIndex To mSearchurlCount - 1
'' mSearchUrl(i) = mSearchUrl(i + 1)
'' Next i
'' mSearchurlCount = mSearchurlCount - 1
'' ReDim Preserve mSearchUrl(0 To mSearchurlCount)
''
'' lstSearchUrl.RemoveItem tIndex - 1
'' If tIndex > mSearchurlCount Then
'' lstSearchUrl.ListIndex = mSearchurlCount - 1
'' Else
'' lstSearchUrl.ListIndex = tIndex - 1
'' End If
''
'' Call Show_Listbox_HScrollebar(lstSearchUrl)
''
''End If
'End Sub
Private Sub cobAddbarEvent_Click()
Dim tId As Long
tId = cobAddbarEvent.ListIndex
If tId > 4 Then
tId = tId - 4
ElseIf tId <= 4 And tId > 0 Then
tId = tId - 5
End If
Select Case cobAddbarShortkey.ListIndex
Case 0
AddBarShortKey_Enter = tId
Case 1
AddBarShortKey_Shift = tId
Case 2
AddBarShortKey_Ctrl = tId
Case 3
AddBarShortKey_Alt = tId
Case 4
AddBarShortKey_CtrlShift = tId
Case 5
AddBarShortKey_AltShift = tId
End Select
End Sub
Private Sub cobAddbarShortkey_Click()
Dim tId As Long
Select Case cobAddbarShortkey.ListIndex
Case 0
tId = AddBarShortKey_Enter
Case 1
tId = AddBarShortKey_Shift
Case 2
tId = AddBarShortKey_Ctrl
Case 3
tId = AddBarShortKey_Alt
Case 4
tId = AddBarShortKey_CtrlShift
Case 5
tId = AddBarShortKey_AltShift
End Select
If tId < 0 Then
tId = tId + 5
ElseIf tId > 0 Then
If tId > SearchurlCount Then
tId = 0
Else
tId = tId + 4
End If
End If
Debug.Print tId
cobAddbarEvent.ListIndex = tId
End Sub
Private Sub cobPvnPop_Click()
PreventPopWindow = cobPvnPop.ListIndex
End Sub
Private Sub Form_Initialize()
mLoading = True
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Unload Me
End Sub
Private Sub Form_Load()
gMainForm.EnableOptionButton False
chkSaveWhenExit.Value = SaveWhenExit
'chkPvnPop.Value = PreventPopWindow
cobPvnPop.AddItem "不过滤"
cobPvnPop.AddItem "宽松"
cobPvnPop.AddItem "一般"
cobPvnPop.AddItem "严格"
cobPvnPop.ListIndex = PreventPopWindow
txtDragDropImageSavePath.Text = DragDropSaveImageFolder
txtDragDropTextSavePath.Text = DragDropSaveTextFolder
Call IniAddBarPage
'Call IniSearchBar
Call IniSearchLvw
Call IniMulSearch
'Call IniExTools
Call IniControls
Call mcUDScrollRate.Create(True, fraScrollSpeed.hWnd, _
txtScrollRate1.hWnd, , 9, 1, ScrollRate)
Call mcUDScrollRate2.Create(True, fraScrollSpeed.hWnd, _
txtScrollRate2.hWnd, , 9, 1, ScrollRate2)
chkInvertDir.Value = RollInvert
If Rollmode = 0 Then
optRollmodeDown.Value = True
Else
optRollmodeClick.Value = True
End If
chkDragLink.Value = EnableDragLink
Call IniMouseEventCombo
Call iniUrlFilter
Call iniAddbarShortkey
Call LoadDlctlOption
Call IniPageRuleTab
Call IniMouseHand
Call IniDragDrop
Call IniPluginControl
Call IniFavoriteControl
Call IniDownload
mLoading = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set m_cTabMain = Nothing
Set m_cTabMouse = Nothing
Set m_cTabPluginTypes = Nothing
Set m_cLvwSearchBar = Nothing
Set m_cLvwMouseHand = Nothing
gMainForm.EnableOptionButton True
End Sub
Private Sub lstFliterList_Click()
txtAddFliter.Text = lstFliterList.Text
End Sub
Private Sub lstPageRuleList_Click()
Dim tIndex&
If mLoading Then Exit Sub
tIndex = lstPageRuleList.ListIndex + 1
If tIndex > 0 And lstPageRuleList.ListCount > 0 Then
With mPageRule(tIndex)
txtPageRuleTitle.Text = .Title
txtPageRuleUrls = .Urls
optPageRuleType(.Type).Value = True
If .Type = 0 Then
cmbPageRuleAuitpPrv.ListIndex = .AutoPreventPop
'chkPageRuleOpenNew.Value = BooleanToBool(.AllwaysOpenNew)
chkPageRuleOpenNew.Value = BooleanToBool(.AllwaysOpenNew)
chkPageRuleInherit.Value = BooleanToBool(.Inherit)
chkPageRuleForceChange.Value = BooleanToBool(.ForceChange)
chkPageRuleDlctl(0).Value = BooleanToBool(.DL_Image)
chkPageRuleDlctl(1).Value = BooleanToBool(.DL_BgSound)
chkPageRuleDlctl(2).Value = BooleanToBool(.DL_Video)
chkPageRuleDlctl(3).Value = BooleanToBool(.DL_Script)
chkPageRuleDlctl(4).Value = BooleanToBool(.DL_ActiveX)
chkPageRuleDlctl(5).Value = BooleanToBool(.DL_JavaApplet)
' If .AllwaysOpenNew Then
' chkPageRuleOpenNew.Value = 1
' Else
' chkPageRuleOpenNew.Value = 0
' End If
'
' If .Inherit Then
' chkPageRuleInherit.Value = 1
' Else
' chkPageRuleInherit.Value = 0
' End If
'
' If .ForceChange Then
' chkPageRuleForceChange.Value = 1
' Else
' chkPageRuleForceChange.Value = 0
' End If
'
' If .DL_Image Then
' chkPageRuleDlctl(0).Value = 1
' Else
' chkPageRuleDlctl(0).Value = 0
' End If
'
' If .DL_BgSound Then
' chkPageRuleDlctl(1).Value = 1
' Else
' chkPageRuleDlctl(1).Value = 0
' End If
'
' If .DL_Video Then
' chkPageRuleDlctl(2).Value = 1
' Else
' chkPageRuleDlctl(2).Value = 0
' End If
'
' If .DL_Script Then
' chkPageRuleDlctl(3).Value = 1
' Else
' chkPageRuleDlctl(3).Value = 0
' End If
'
' If .DL_ActiveX Then
' chkPageRuleDlctl(4).Value = 1
' Else
' chkPageRuleDlctl(4).Value = 0
' End If
'
' If .DL_JavaApplet Then
' chkPageRuleDlctl(5).Value = 1
' Else
' chkPageRuleDlctl(5).Value = 0
' End If
Else
txtPageRuleExepath.Text = .OutExePath
txtPageRuleParam.Text = .OutExeParam
End If
End With
End If
End Sub
Private Sub lstPageRuleList_ItemCheck(Item As Integer)
Dim tIndex&
If mLoading Then Exit Sub
tIndex = lstPageRuleList.ListIndex
If tIndex >= 0 And lstPageRuleList.ListCount > 0 Then
If lstPageRuleList.Selected(tIndex) Then
mPageRule(tIndex + 1).Enabled = 1
Else
mPageRule(tIndex + 1).Enabled = 0
End If
End If
Debug.Print mPageRule(tIndex + 1).Enabled
End Sub
'Private Sub lstSearchUrl_Click()
''Dim tIndex&
''tIndex = lstSearchUrl.ListIndex + 1
''txtSearchTitle.Text = mSearchUrl(tIndex).Title
''txtSearchUrl.Text = mSearchUrl(tIndex).Url
'
'End Sub
'Private Sub lvwExtoolListall_ItemClick(ByVal item As MSComctlLib.ListItem)
'Dim tIndex&
'tIndex = item.index
'lvwExtoolListall.SelectedItem = item
'Call ClickExtoolItem(tIndex)
'End Sub
'Private Sub lvwMouseHand_ItemClick(ByVal item As MSComctlLib.ListItem)
'Dim tObj As cCallByName
''Dim tDescription$, tHandShow$, tInsideIndex&, tEventText$
''MouseHand.GetInfo_ByIndex item.index, tDescription, tHandShow, tInsideIndex, tEventText
''cmbMouseHandEventList.ListIndex = tInsideIndex
''labMouseHandShow.Text = tHandShow
'
'Set tObj = MouseHand.GetCallObject_ByIndex(item.index)
'If Not tObj Is Nothing Then
' 'cmbMouseHandEventList.ListIndex = tObj.InsideIndex
' Call ShowMouseHandOrder(tObj)
' MouseHand.GetHand item.index, VarPtr(mHand(0))
' Call ShowMouseHand
'End If
'
'Debug.Print mHand(0), mHand(1), mHand(2)
'
'End Sub
Private Sub m_cLvwMouseHand_ItemChange(vIndex As Long, uNewState As clveLVIS, uOldState As clveLVIS)
Dim tObj As cCallByName
If (uNewState And LVIS_SELECTED) <> 0 Then
Set tObj = MouseHand.GetCallObject_ByIndex(vIndex + 1)
If Not tObj Is Nothing Then
Call ShowMouseHandOrder(tObj)
MouseHand.GetHand vIndex + 1, VarPtr(mHand(0))
Call ShowMouseHand
End If
End If
End Sub
'Private Sub lvwSearchBar_ItemCheck(ByVal item As MSComctlLib.ListItem)
'On Error Resume Next
'Dim tIndex&, tIndex2&
'tIndex = item.index
''mSearchEgn(tIndex).MulSearch = item.Checked
'
'tIndex2 = cmbSearchbarMulegn.ListIndex + 1
'If tIndex2 > 0 Then
' With mMulSearch(tIndex2)
' If tIndex > .Count Then
' .Count = mSearchEgnCount
' ReDim Preserve .UseMul(0 To .Count)
' End If
' .UseMul(tIndex) = item.Checked
' End With
'End If
'
'
''txtSearchBarTitle.Text = mSearchEgn(tIndex).Title
''txtSearchBarUrl.Text = mSearchEgn(tIndex).Url
'End Sub
Private Sub m_cLvwSearchBar_ItemChange(vIndex As Long, uNewState As clveLVIS, uOldState As clveLVIS)
On Error Resume Next
'selected change
If (uNewState And LVIS_SELECTED) <> 0 Then
m_Sch_ChangeLock = True
txtSearchBarTitle.Text = mSearchEgn(vIndex + 1).Title
txtSearchBarUrl.Text = mSearchEgn(vIndex + 1).Url
m_Sch_ChangeLock = False
End If
'check change
If (uNewState And LVIS_STATEIMAGEMASK) <> 0 Then
Dim tIndex&, tIndex2&
tIndex = vIndex + 1
tIndex2 = cmbSearchbarMulegn.ListIndex + 1
If tIndex2 > 0 Then
With mMulSearch(tIndex2)
If tIndex > .Count Then
.Count = mSearchEgnCount
ReDim Preserve .UseMul(0 To .Count)
End If
.UseMul(tIndex) = m_cLvwSearchBar.GetCheckState(vIndex)
End With
End If
End If
'On Error Resume Next
'Dim tIndex&, tIndex2&
'tIndex = item.index
''mSearchEgn(tIndex).MulSearch = item.Checked
'
'tIndex2 = cmbSearchbarMulegn.ListIndex + 1
'If tIndex2 > 0 Then
' With mMulSearch(tIndex2)
' If tIndex > .Count Then
' .Count = mSearchEgnCount
' ReDim Preserve .UseMul(0 To .Count)
' End If
' .UseMul(tIndex) = item.Checked
' End With
'End If
End Sub
'Private Sub lvwSearchBar_ItemClick(ByVal item As MSComctlLib.ListItem)
'On Error Resume Next
'Dim tIndex&
'tIndex = item.index
'txtSearchBarTitle.Text = mSearchEgn(tIndex).Title
'txtSearchBarUrl.Text = mSearchEgn(tIndex).Url
'End Sub
Private Sub m_cTabMain_Changed(vPos As Long)
Dim i&
For i = 0 To frameCnt - 1
fraOption(i).Visible = False
Next i
fraOption(vPos).Visible = True
End Sub
Private Sub m_cTabMouse_Changed(vPos As Long)
If vPos = 0 Then
fraMouse(0).Visible = True
fraMouse(1).Visible = False
Else
fraMouse(0).Visible = False
fraMouse(1).Visible = True
End If
End Sub
Private Sub m_cTabPluginTypes_Changed(vPos As Long)
Dim i&
lstPlugin_List.Clear
Select Case vPos
Case 0
For i = 1 To mPluginCnt
lstPlugin_List.AddItem mPlugins(i).Title
lstPlugin_List.Selected(i - 1) = mPlugins(i).VisInMenu
Next i
Case 1
For i = 1 To mPlugins_SBCnt
lstPlugin_List.AddItem mPlugins_SideBand(i).Title
lstPlugin_List.Selected(i - 1) = mPlugins_SideBand(i).VisInMenu
Next i
Case 2
End Select
If lstPlugin_List.ListCount > 0 Then
lstPlugin_List.ListIndex = 0
Call mPluginControls_ListClick(0)
End If
End Sub
Private Sub mAddBarControls_AddItem(Cancel As Boolean, newData As String)
mSearchurlCount = mSearchurlCount + 1
ReDim Preserve mSearchUrl(0 To mSearchurlCount)
mSearchUrl(mSearchurlCount).Title = "新建"
newData = "新建"
'lstSearchUrl.AddItem "新建"
'lstSearchUrl.ListIndex = mSearchurlCount - 1
'lstSearchUrl.Selected(mSearchurlCount - 1) = True
'Call Show_Listbox_HScrollebar(lstSearchUrl)
End Sub
Private Sub mAddBarControls_AddItemAfter()
Call Show_Listbox_HScrollebar(lstSearchUrl)
End Sub
Private Sub mAddBarControls_DelItem(Cancel As Boolean, vIndex As Long)
Dim i&
Dim tIndex&
If mSearchurlCount > 0 Then
tIndex = vIndex + 1
For i = tIndex To mSearchurlCount - 1
mSearchUrl(i) = mSearchUrl(i + 1)
Next i
mSearchurlCount = mSearchurlCount - 1
ReDim Preserve mSearchUrl(0 To mSearchurlCount)
' lstSearchUrl.RemoveItem tIndex - 1
' If tIndex > mSearchurlCount Then
' lstSearchUrl.ListIndex = mSearchurlCount - 1
' Else
' lstSearchUrl.ListIndex = tIndex - 1
' End If
End If
End Sub
Private Sub mAddBarControls_DelItemAfter()
Call Show_Listbox_HScrollebar(lstSearchUrl)
End Sub
Private Sub mAddBarControls_ListClick(index As Long)
Dim tIndex&
tIndex = index + 1
txtSearchTitle.Text = mSearchUrl(tIndex).Title
txtSearchUrl.Text = mSearchUrl(tIndex).Url
End Sub
Private Sub mAddBarControls_MoveDown(iUp As Long, iDown As Long, ptUp As Long, ptDown As Long, lenData As Long)
If iUp >= 0 And iUp < mSearchurlCount And _
iDown >= 0 And iDown < mSearchurlCount Then
ptUp = VarPtr(mSearchUrl(iUp + 1))
ptDown = VarPtr(mSearchUrl(iDown + 1))
lenData = 8
End If
End Sub
Private Sub mAddBarControls_MoveUp(iUp As Long, iDown As Long, ptUp As Long, ptDown As Long, lenData As Long)
If iUp >= 0 And iUp < mSearchurlCount And _
iDown >= 0 And iDown < mSearchurlCount Then
ptUp = VarPtr(mSearchUrl(iUp + 1))
ptDown = VarPtr(mSearchUrl(iDown + 1))
lenData = 8
End If
'Dim tLstIndex As Long
'Dim tInfo As typSearchUrl
'If mSearchurlCount > 0 Then
' tLstIndex = lstSearchUrl.ListIndex
' If tLstIndex > 0 Then
' tInfo = mSearchUrl(tLstIndex)
' mSearchUrl(tLstIndex) = mSearchUrl(tLstIndex + 1)
' mSearchUrl(tLstIndex + 1) = tInfo
'
' lstSearchUrl.List(tLstIndex - 1) = mSearchUrl(tLstIndex).Title
' lstSearchUrl.List(tLstIndex) = mSearchUrl(tLstIndex + 1).Title
'
' lstSearchUrl.ListIndex = tLstIndex - 1
' End If
'End If
End Sub
Private Sub mPluginControls_AddItem(Cancel As Boolean, newData As String)
newData = "new plugin"
Dim tType$, tTitle$, tPath$
If GetPluginInfo(tType, tTitle, tPath) Then
Select Case tType
Case "command"
m_cTabPluginTypes.SelectIndex = 0
m_cTabPluginTypes_Changed 0
Case "sideband"
m_cTabPluginTypes.SelectIndex = 1
m_cTabPluginTypes_Changed 1
Case Else
MsgBox "some error", vbOKOnly Or vbInformation
Cancel = True
Exit Sub
End Select
' txtPlugin_Title.Text = tTitle
' txtPlugin_Command.Text = tPath
newData = tTitle
Select Case m_cTabPluginTypes.SelectIndex
Case 0
mPluginCnt = mPluginCnt + 1
ReDim Preserve mPlugins(0 To mPluginCnt)
With mPlugins(mPluginCnt)
.Title = tTitle
.Command = tPath
.Param = vbNullString
End With
Case 1
mPlugins_SBCnt = mPlugins_SBCnt + 1
ReDim Preserve mPlugins_SideBand(0 To mPlugins_SBCnt)
With mPlugins_SideBand(mPlugins_SBCnt)
.Title = tTitle
.Command = tPath
.Param = vbNullString
End With
Case 2
Cancel = True
End Select
Else
Cancel = True
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : GetPluginInfo
' DateTime : 2005-8-7 00:40
' Author : Lingll
' Purpose :
'---------------------------------------------------------------------------------------
Private Function GetPluginInfo(vType$, vTitle$, vPath$) As Boolean
Dim tIni As cINIFile
Dim tOL As OpenSaveDlg
Set tOL = New OpenSaveDlg
tOL.InitDir = App.path & "plugin"
tOL.Filter = "*.ini|*.ini|*.exe,*.com|*.exe;*.com|*.*|*.*"
If tOL.ShowOpen(Me.hWnd) Then
Select Case LCase(GetExtendName(tOL.FileName))
Case "ini"
Set tIni = New cINIFile
tIni.IniFile = tOL.FileName
GetPluginInfo = False
If tIni.ReadKey("General", "Flag") = LEPluginFlag Then
vType = LCase(tIni.ReadKey("General", "PluginType"))
Select Case vType
Case "command", "sideband" ' ,"toolbar"
vTitle = tIni.ReadKey("General", "Title")
vPath = tOL.FileName
GetPluginInfo = True
Case Else
End Select
End If
Case Else
vType = "command"
vTitle = tOL.FileTitle
vPath = tOL.FileName
GetPluginInfo = True
End Select
Else
GetPluginInfo = False
End If
End Function
Private Sub mPluginControls_DelItem(Cancel As Boolean, vIndex As Long)
Dim i&
Select Case m_cTabPluginTypes.SelectIndex
Case 0
If mPluginCnt > 0 Then
For i = vIndex + 1 To mPluginCnt - 1
mPlugins(i) = mPlugins(i + 1)
Next i
mPluginCnt = mPluginCnt - 1
End If
Case 1
If mPlugins_SBCnt > 0 Then
For i = vIndex + 1 To mPlugins_SBCnt - 1
mPlugins_SideBand(i) = mPlugins_SideBand(i + 1)
Next i
mPlugins_SBCnt = mPlugins_SBCnt - 1
End If
Case 2
Cancel = True
End Select
End Sub
Private Sub mPluginControls_ListCheck(ByVal index As Long, vChecked As Boolean)
Select Case m_cTabPluginTypes.SelectIndex
Case 0
If index >= 0 And index < mPluginCnt Then
mPlugins(index + 1).VisInMenu = vChecked
End If
Case 1
If index >= 0 And index < mPlugins_SBCnt Then
mPlugins_SideBand(index + 1).VisInMenu = vChecked
End If
Case 2
End Select
End Sub
Private Sub mPluginControls_ListClick(index As Long)
Select Case m_cTabPluginTypes.SelectIndex
Case 0
txtPlugin_Title.Text = mPlugins(index + 1).Title
txtPlugin_Command.Text = mPlugins(index + 1).Command
txtPlugin_Param.Text = mPlugins(index + 1).Param
Case 1
txtPlugin_Title.Text = mPlugins_SideBand(index + 1).Title
txtPlugin_Command.Text = mPlugins_SideBand(index + 1).Command
txtPlugin_Param.Text = mPlugins_SideBand(index + 1).Param
Case 2
End Select
End Sub
Private Sub mPluginControls_MoveDown(iUp As Long, iDown As Long, ptUp As Long, _
ptDown As Long, lenData As Long)
Select Case m_cTabPluginTypes.SelectIndex
Case 0
If iUp >= 0 And iUp < mPluginCnt And _
iDown >= 0 And iDown < mPluginCnt Then
ptUp = VarPtr(mPlugins(iUp + 1))
ptDown = VarPtr(mPlugins(iDown + 1))
lenData = Len(mPlugins(iUp + 1))
End If
Case 1
If iUp >= 0 And iUp < mPlugins_SBCnt And _
iDown >= 0 And iDown < mPlugins_SBCnt Then
ptUp = VarPtr(mPlugins_SideBand(iUp + 1))
ptDown = VarPtr(mPlugins_SideBand(iDown + 1))
lenData = Len(mPlugins_SideBand(iUp + 1))
End If
Case 2
End Select
End Sub
Private Sub mPluginControls_MoveUp(iUp As Long, iDown As Long, ptUp As Long, ptDown As Long, lenData As Long)
Select Case m_cTabPluginTypes.SelectIndex
Case 0
If iUp >= 0 And iUp < mPluginCnt And _
iDown >= 0 And iDown < mPluginCnt Then
ptUp = VarPtr(mPlugins(iUp + 1))
ptDown = VarPtr(mPlugins(iDown + 1))
lenData = Len(mPlugins(iUp + 1))
End If
Case 1
If iUp >= 0 And iUp < mPlugins_SBCnt And _
iDown >= 0 And iDown < mPlugins_SBCnt Then
ptUp = VarPtr(mPlugins_SideBand(iUp + 1))
ptDown = VarPtr(mPlugins_SideBand(iDown + 1))
lenData = Len(mPlugins_SideBand(iUp + 1))
End If
Case 2
End Select
End Sub
Private Sub optFavorite_Path_Cus_Click()
txtFavorite_Path.Enabled = True
cmdFavorite_Browse.Enabled = True
m_FavoriteUseDefaultPath = 0
End Sub
Private Sub optFavorite_Path_Default_Click()
txtFavorite_Path.Enabled = False
cmdFavorite_Browse.Enabled = False
m_FavoriteUseDefaultPath = 1
End Sub
Private Sub optPageRuleType_Click(index As Integer)
fraPageRuleType(0).Visible = False
fraPageRuleType(1).Visible = False
fraPageRuleType(index).Visible = True
Dim tIndex&
tIndex = lstPageRuleList.ListIndex
If tIndex >= 0 Then
mPageRule(tIndex + 1).Type = index
Call lstPageRuleList_Click
End If
End Sub
Private Sub optRollmodeClick_Click()
Rollmode = 1
End Sub
Private Sub optRollmodeDown_Click()
Rollmode = 0
End Sub
'Private Sub TabMain_Click()
'Dim i&
'Dim tIndex&
'tIndex = TabMain.SelectedItem.index - 1
'For i = 0 To frameCnt - 1
' fraOption(i).Visible = False
'Next i
'fraOption(tIndex).Visible = True
'End Sub
'Private Sub tabMouse_Click()
''Dim i&
'Dim tIndex&
'tIndex = tabMouse.SelectedItem.index - 1
'If tIndex = 0 Then
' fraMouse(0).Visible = True
' fraMouse(1).Visible = False
'Else
' fraMouse(0).Visible = False
' fraMouse(1).Visible = True
'End If
'End Sub
Private Sub txtAddFliter_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Call cmdAddFliter_Click
End If
End Sub
Private Sub txtDragDropImageSavePath_Change()
DragDropSaveImageFolder = txtDragDropImageSavePath.Text
End Sub
Private Sub txtDragDropImageSavePath_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
'Dim nfs As New nFileSysObj
'If nfs.nFolderExists(Data.Files(1)) Then
If FileExist(Data.Files(1), False) Then
txtDragDropImageSavePath.Text = Data.Files(1)
End If
End Sub
Private Sub txtDragDropImageSavePath_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
If Not Data.GetFormat(vbCFFiles) Then Effect = 0
End Sub
Private Sub txtDragDropTextSavePath_Change()
DragDropSaveTextFolder = txtDragDropTextSavePath.Text
End Sub
Private Sub txtDragDropTextSavePath_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
'Dim nfs As New nFileSysObj
'If nfs.nFolderExists(Data.Files(1)) Then
If FileExist(Data.Files(1), False) Then
txtDragDropTextSavePath.Text = Data.Files(1)
End If
End Sub
Private Sub txtDragDropTextSavePath_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
If Not Data.GetFormat(vbCFFiles) Then Effect = 0
End Sub
'初始化"地址栏"页
Private Sub IniAddBarPage() ' IniSearchurl()
Dim i&
mSearchurlCount = SearchurlCount
ReDim mSearchUrl(0 To mSearchurlCount)
For i = 1 To mSearchurlCount
mSearchUrl(i) = searchUrl(i)
lstSearchUrl.AddItem mSearchUrl(i).Title
Next i
Set mAddBarControls = New cListMove
mAddBarControls.IniMe lstSearchUrl, cmdSearchMoveUp, cmdSearchMoveDown, cmdSearchAdd, cmdSearchRemove
If mSearchurlCount > 0 Then
lstSearchUrl.ListIndex = 0
'lstSearchUrl.Selected(0) = True
Call Show_Listbox_HScrollebar(lstSearchUrl)
End If
End Sub
''初始化"搜索栏"页
'Private Sub IniSearchBar()
''Dim tItem As MSComctlLib.ListItem
''Dim i&
''
''With lvwSearchBar
'' .FullRowSelect = True
'' .LabelEdit = lvwManual
'' .View = lvwReport
'' .Checkboxes = True
'' .HideSelection = False
''
'' .ColumnHeaders.Add , , "多引擎搜索", 1050
'' .ColumnHeaders.Add , , "名称", 1200
'' .ColumnHeaders.Add , , "地址", 3000
''
'' mSearchEgnCount = gSearchEgnCount
'' ReDim mSearchEgn(0 To mSearchEgnCount)
''
'' For i = 1 To mSearchEgnCount
'' mSearchEgn(i) = gSearchEgn(i)
''
'' Set tItem = .ListItems.Add()
'' 'tItem.Checked = mSearchEgn(i).MulSearch
'' tItem.SubItems(1) = mSearchEgn(i).Title
'' tItem.SubItems(2) = mSearchEgn(i).Url
'' Next i
''
'' If mSearchEgnCount > 0 Then
'' .ListItems(1).Selected = True
'' txtSearchBarTitle.Text = mSearchEgn(1).Title
'' txtSearchBarUrl.Text = mSearchEgn(1).Url
'' Else
'' txtSearchBarTitle.Text = ""
'' txtSearchBarUrl.Text = ""
'' End If
''
''End With
'End Sub
'初始化"多引擎搜索"
Private Sub IniMulSearch()
Dim i&
mMulSearchCount = gMulSearchCount
ReDim mMulSearch(0 To mMulSearchCount)
For i = 1 To mMulSearchCount
mMulSearch(i) = gMulSearch(i)
cmbSearchbarMulegn.AddItem mMulSearch(i).Title
Next i
If mMulSearchCount > 0 Then
cmbSearchbarMulegn.ListIndex = 0
End If
End Sub
''====ExTools===============================
'Private Sub IniExTools()
'Dim i&, tItem As MSComctlLib.ListItem
'mExToolsCount = ExToolsCount
'ReDim mExTools(0 To mExToolsCount)
'
'With lvwExtoolListall
' .View = lvwReport
' .ColumnHeaders.Add , , "名称"
' .ColumnHeaders.Add , , "路径"
' .ColumnHeaders.Add , , "参数"
' .ColumnHeaders(1).Width = 1000
' .ColumnHeaders(2).Width = .Width - 2500
' .ColumnHeaders(3).Width = 1400
' For i = 1 To mExToolsCount
' mExTools(i) = ExTools(i)
' Set tItem = .ListItems.Add(, , mExTools(i).Caption)
' tItem.SubItems(1) = mExTools(i).path
' tItem.SubItems(2) = mExTools(i).Param
' Next i
' If mExToolsCount > 0 Then
' .ListItems(1).Selected = True
' Call ClickExtoolItem(1)
' End If
'End With
'End Sub
'
'Private Sub RefreshExTools(nType As String)
'Dim tSelItem As MSComctlLib.ListItem
'Dim tIndex&
'Set tSelItem = lvwExtoolListall.SelectedItem
'If Not tSelItem Is Nothing Then
' tIndex = tSelItem.index
' Select Case nType
' Case "Caption"
' mExTools(tIndex).Caption = txtExtoolCaption.Text
' tSelItem.Text = mExTools(tIndex).Caption
' Case "Path"
' mExTools(tIndex).path = txtExtoolPath.Text
' tSelItem.SubItems(1) = mExTools(tIndex).path
' Case "Param"
' mExTools(tIndex).Param = txtExtoolParam.Text
' tSelItem.SubItems(2) = mExTools(tIndex).Param
' End Select
'End If
'End Sub
'
'Private Sub ClickExtoolItem(nIndex As Long)
'txtExtoolCaption.Text = mExTools(nIndex).Caption
'txtExtoolPath.Text = mExTools(nIndex).path
'txtExtoolParam.Text = mExTools(nIndex).Param
'End Sub
'
'Private Sub MoveExtoolItem(nIndex&, nPos&)
'Dim tIfo As typExTool
'Dim nIndex2&
'nIndex2 = nIndex + nPos
'If nIndex2 > 0 And nIndex2 <= mExToolsCount Then
' tIfo = mExTools(nIndex)
' mExTools(nIndex) = mExTools(nIndex2)
' mExTools(nIndex2) = tIfo
'
' Call ExtoolToLvwitem(mExTools(nIndex), _
' lvwExtoolListall.ListItems(nIndex))
' Call ExtoolToLvwitem(mExTools(nIndex2), _
' lvwExtoolListall.ListItems(nIndex2))
' lvwExtoolListall.ListItems(nIndex2).Selected = True
'End If
'End Sub
'
''Private Sub ExtoolToLvwitem(nInf As typExTool, nItem As MSComctlLib.ListItem)
''nItem.Text = nInf.Caption
''nItem.SubItems(1) = nInf.path
''nItem.SubItems(2) = nInf.Param
''End Sub
'
'Private Sub txtExtoolCaption_Change()
'Call RefreshExTools("Caption")
'End Sub
'
'Private Sub txtExtoolParam_Change()
'Call RefreshExTools("Param")
'End Sub
'
'Private Sub txtExtoolPath_Change()
'Call RefreshExTools("Path")
'End Sub
''========ExTools====== END ======================
Private Sub txtFavorite_Path_Change()
m_FavoriteCustomPath = txtFavorite_Path.Text
End Sub
Private Sub txtPageRuleExepath_Validate(Cancel As Boolean)
Dim tIndex&
tIndex = lstPageRuleList.ListIndex
If tIndex >= 0 Then
mPageRule(tIndex + 1).OutExePath = txtPageRuleExepath.Text
End If
End Sub
Private Sub txtPageRuleParam_Validate(Cancel As Boolean)
Dim tIndex&
tIndex = lstPageRuleList.ListIndex
If tIndex >= 0 Then
mPageRule(tIndex + 1).OutExeParam = txtPageRuleParam.Text
End If
End Sub
Private Sub txtPageRuleTitle_Change()
Dim tIndex&
tIndex = lstPageRuleList.ListIndex
If tIndex >= 0 Then
mPageRule(tIndex + 1).Title = txtPageRuleTitle.Text
lstPageRuleList.List(tIndex) = txtPageRuleTitle.Text
End If
End Sub
Private Sub txtPageRuleTitle_GotFocus()
With txtPageRuleTitle
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Private Sub txtPageRuleUrls_Validate(Cancel As Boolean)
Dim tIndex&
tIndex = lstPageRuleList.ListIndex
If tIndex >= 0 Then
mPageRule(tIndex + 1).Urls = txtPageRuleUrls.Text
End If
End Sub
Private Sub txtPlugin_Command_Change()
Dim tIndex&
tIndex = lstPlugin_List.ListIndex
If tIndex >= 0 Then
Select Case m_cTabPluginTypes.SelectIndex
Case 0
mPlugins(tIndex + 1).Command = txtPlugin_Command.Text
Case 1
mPlugins_SideBand(tIndex + 1).Command = txtPlugin_Command.Text
Case 2
End Select
End If
End Sub
Private Sub txtPlugin_Param_Change()
Dim tIndex&
tIndex = lstPlugin_List.ListIndex
If tIndex >= 0 Then
Select Case m_cTabPluginTypes.SelectIndex
Case 0
mPlugins(tIndex + 1).Param = txtPlugin_Param.Text
Case 1
mPlugins_SideBand(tIndex + 1).Param = txtPlugin_Param.Text
Case 2
End Select
End If
End Sub
Private Sub txtPlugin_Title_Change()
Dim tIndex&
tIndex = lstPlugin_List.ListIndex
If tIndex >= 0 Then
Select Case m_cTabPluginTypes.SelectIndex
Case 0
mPlugins(tIndex + 1).Title = txtPlugin_Title.Text
lstPlugin_List.List(tIndex) = mPlugins(tIndex + 1).Title
Case 1
mPlugins_SideBand(tIndex + 1).Title = txtPlugin_Title.Text
lstPlugin_List.List(tIndex) = mPlugins_SideBand(tIndex + 1).Title
Case 2
End Select
End If
End Sub
Private Sub txtScrollRate1_Change()
ScrollRate = Val(txtScrollRate1.Text)
End Sub
Private Sub txtScrollRate2_Change()
ScrollRate2 = Val(txtScrollRate2.Text)
End Sub
Private Sub txtSearchBarTitle_Change()
Dim tIndex&
Dim tItem&
If m_Sch_ChangeLock Then Exit Sub
If Not m_cLvwSearchBar Is Nothing Then
tItem = m_cLvwSearchBar.GetNextItem(-1, LVNI_SELECTED)
If tItem >= 0 Then
tIndex = tItem + 1
mSearchEgn(tIndex).Title = txtSearchBarTitle.Text
Call m_cLvwSearchBar.SetItemText( _
mSearchEgn(tIndex).Title, tItem, 1)
End If
End If
'Dim tIndex&
'Dim tItem As MSComctlLib.ListItem
'Set tItem = lvwSearchBar.SelectedItem
'If Not tItem Is Nothing Then
' tIndex = tItem.index
' mSearchEgn(tIndex).Title = txtSearchBarTitle.Text
' tItem.SubItems(1) = mSearchEgn(tIndex).Title
'End If
End Sub
Private Sub txtSearchBarUrl_Change()
Dim tIndex&
Dim tItem&
If m_Sch_ChangeLock Then Exit Sub
If Not m_cLvwSearchBar Is Nothing Then
tItem = m_cLvwSearchBar.GetNextItem(-1, LVNI_SELECTED)
If tItem >= 0 Then
tIndex = tItem + 1
mSearchEgn(tIndex).Url = txtSearchBarUrl.Text
Call m_cLvwSearchBar.SetItemText( _
mSearchEgn(tIndex).Url, tItem, 2)
End If
End If
'Dim tIndex&
'Dim tItem As MSComctlLib.ListItem
'Set tItem = lvwSearchBar.SelectedItem
'If Not tItem Is Nothing Then
' tIndex = tItem.index
' mSearchEgn(tIndex).Url = txtSearchBarUrl.Text
' tItem.SubItems(2) = mSearchEgn(tIndex).Url
'End If
End Sub
Private Sub txtSearchTitle_Change()
Dim tIndex As Long
tIndex = lstSearchUrl.ListIndex
mSearchUrl(tIndex + 1).Title = txtSearchTitle.Text
lstSearchUrl.List(tIndex) = mSearchUrl(tIndex + 1).Title
Call Show_Listbox_HScrollebar(lstSearchUrl)
End Sub
Private Sub txtSearchUrl_Change()
Dim tIndex As Long
tIndex = lstSearchUrl.ListIndex
mSearchUrl(tIndex + 1).Url = txtSearchUrl.Text
End Sub
Private Sub IniControls()
'Dim i&
Me.width = 5700
Me.height = 4500 + 450 + 300 + 600
Call IniMainTab
Call IniMouseTab
Call IniPluginTab
'With TabMain
' .Left = 0
' .Top = 0
' .Width = Me.ScaleWidth
' .Height = Me.ScaleHeight
'End With
'
'Dim i&
'
'With TabMain.Tabs
' .Clear
' .Add , , "一般"
' .Add , , "过滤"
' .Add , , "地址栏" '"搜索"
' .Add , , "页面规则"
' .Add , , "鼠标设置"
' '.Add , , "外部工具"
' .Add , , "插件" '"群组"
' .Add , , "拖拽"
'
' .Add , , "搜索栏"
' 'TabMain.Tabs.Add , , "鼠标(2)"
'End With
'For i = 0 To frameCnt - 1
' With fraOption(i)
' .BackColor = &H8000000F
' .Top = TabMain.clientTop
' .Left = TabMain.clientLeft
' .Width = TabMain.clientWidth
' .Height = TabMain.clientHeight
'
' .Visible = False
' End With
'Next i
'fraOption(0).Visible = True
'With tabMouse.Tabs
' .Clear
' .Add , , "一般"
' .Add , , "鼠标手势"
'End With
'With fraOption(4)
' tabMouse.Move 0, 60, .Width, .Height - 60
'End With
'For i = 0 To 1
' With fraMouse(i)
' .BackColor = &H8000000F
' .Top = tabMouse.clientTop
' .Left = tabMouse.clientLeft
' .Width = tabMouse.clientWidth
' .Height = tabMouse.clientHeight
'
' .Visible = False
' End With
'Next i
'fraMouse(0).Visible = True
End Sub
Private Sub IniMouseEventCombo()
Dim i& ', j&
'For i = 0 To 7
' With cmbMouseEventProc(i)
' For j = 0 To mouse_event_prc(i).SubCount
' .AddItem mouse_event_prc(i).GetEventText(j)
' Next j
' .ListIndex = mouse_event_prc(i).InsideIndex
' End With
'Next i
For i = 0 To mouse_event_leftright.SubCount
cmbMouseEventLeftRight.AddItem mouse_event_leftright.GetEventText(i)
cmbMouseEventRightLeft.AddItem mouse_event_leftright.GetEventText(i)
Next i
cmbMouseEventLeftRight.ListIndex = mouse_event_leftright.InsideIndex
cmbMouseEventRightLeft.ListIndex = mouse_event_rightleft.InsideIndex
End Sub
Private Sub iniUrlFilter()
Dim i&
lstFliterList.Clear
For i = 1 To UrlFilterCount
lstFliterList.AddItem UrlFilter(i)
Next i
Call Show_Listbox_HScrollebar(lstFliterList)
chkFliterEnable.Value = EnableUrlFilter
End Sub
Private Sub iniAddbarShortkey()
With cobAddbarShortkey
.AddItem "Enter"
.AddItem "Shift + Enter"
.AddItem "Ctrl + Enter"
.AddItem "Alt + Enter"
.AddItem "Ctrl + Shift + Enter"
'.AddItem "Ctrl + Alt + Enter"
.AddItem "Shift + Alt + Enter"
End With
Call LoadAddbarEvent
cobAddbarShortkey.ListIndex = 0
End Sub
Private Sub LoadAddbarEvent()
Dim i&
cobAddbarEvent.Clear
With cobAddbarEvent
.AddItem "(无)"
.AddItem "当前页"
.AddItem "上一级"
.AddItem "新建页"
.AddItem "打开IE"
End With
For i = 1 To mSearchurlCount
cobAddbarEvent.AddItem mSearchUrl(i).Title
Next i
End Sub
'加载下载控制选项
Private Sub LoadDlctlOption()
chkGDlctl(0).Value = BooleanToBool(gDL_Image)
chkGDlctl(1).Value = BooleanToBool(gDL_BgSound)
chkGDlctl(2).Value = BooleanToBool(gDL_Video)
chkGDlctl(3).Value = BooleanToBool(gDL_Script)
chkGDlctl(4).Value = BooleanToBool(gDL_ActiveX)
chkGDlctl(5).Value = BooleanToBool(gDL_JavaApplet)
chkGDlctl(6).Value = BooleanToBool(gDl_DlActiveX)
'If gDL_Image Then
' chkGDlctl(0).Value = 1
'Else
' chkGDlctl(0).Value = 0
'End If
'
'If gDL_BgSound Then
' chkGDlctl(1).Value = 1
'Else
' chkGDlctl(1).Value = 0
'End If
'
'If gDL_Video Then
' chkGDlctl(2).Value = 1
'Else
' chkGDlctl(2).Value = 0
'End If
'
'If gDL_Script Then
' chkGDlctl(3).Value = 1
'Else
' chkGDlctl(3).Value = 0
'End If
'
'If gDL_ActiveX Then
' chkGDlctl(4).Value = 1
'Else
' chkGDlctl(4).Value = 0
'End If
'
'If gDL_JavaApplet Then
' chkGDlctl(5).Value = 1
'Else
' chkGDlctl(5).Value = 0
'End If
'
'If gDl_NoDlActiveX Then
' chkGDlctl(6).Value = 1
'Else
' chkGDlctl(6).Value = 0
'End If
End Sub
'初始化"页面规则"页
Private Sub IniPageRuleTab()
Dim i&, j&
mPageRuleCnt = PageRuleCnt
ReDim mPageRule(0 To mPageRuleCnt)
For i = 1 To mPageRuleCnt
With mPageRule(i)
.Title = PageRule(i).Title
.Enabled = PageRule(i).Enabled
.Type = PageRule(i).Type
.Urls = ""
For j = 0 To PageRule(i).UrlCnt - 1
.Urls = .Urls & PageRule(i).Urls(j)
If j < PageRule(i).UrlCnt - 1 Then
.Urls = .Urls & ";" & Chr(13) & Chr(10)
End If
Next j
If .Type = 0 Then
.AutoPreventPop = PageRule(i).AutoPreventPop
.DL_ActiveX = PageRule(i).DL_ActiveX
.DL_BgSound = PageRule(i).DL_BgSound
.DL_Image = PageRule(i).DL_Image
.DL_Video = PageRule(i).DL_Video
.DL_JavaApplet = PageRule(i).DL_JavaApplet
.DL_Script = PageRule(i).DL_Script
.AllwaysOpenNew = PageRule(i).AllwaysOpenNew
.Inherit = PageRule(i).Inherit
.ForceChange = PageRule(i).ForceChange
Else
.OutExeParam = PageRule(i).OutExeParam
.OutExePath = PageRule(i).OutExePath
End If
End With
Next i
With cmbPageRuleAuitpPrv
.AddItem "不过滤"
.AddItem "宽松"
.AddItem "一般"
.AddItem "严格"
End With
txtPageRuleExepath.Text = ""
txtPageRuleParam.Text = ""
txtPageRuleTitle.Text = ""
txtPageRuleUrls.Text = ""
optPageRuleType(0).Value = True
lstPageRuleList.ListIndex = -1
For i = 1 To PageRuleCnt
lstPageRuleList.AddItem PageRule(i).Title
lstPageRuleList.Selected(i - 1) = (mPageRule(i).Enabled = 1)
Next i
lstPageRuleList.ListIndex = -1
chkPageRuleEnable.Value = gEnablePageRule
End Sub
'初始化鼠标手势设置的控件
Private Sub IniMouseHand()
Dim i&
'Dim tCn As cCallByName
'Dim tItem As MSComctlLib.ListItem
Dim tDescription$, tHandShow$, tInsideIndex&, tEventText$
Dim tcnt&
DirFlag(0) = ""
DirFlag(1) = "→"
DirFlag(2) = "↑"
DirFlag(3) = "←"
DirFlag(4) = "↓"
Call IniMouseHandLvw
'With lvwMouseHand
' .View = lvwReport
' .ColumnHeaders.Add , , "名称", .Width / 2 - 600
' .ColumnHeaders.Add , , "命令", .Width / 2
'
' '.ListItems.Add , , "按着左键单击右键"
' tcnt = MouseHand.GetHandCount
' For i = 1 To tcnt
' Call MouseHand.GetInfo_ByIndex(i, tDescription, tHandShow, tInsideIndex, tEventText)
' Set tItem = .ListItems.Add(, , tDescription)
' tItem.SubItems(1) = tEventText
' Next i
'End With
'Set tCn = New cCallByName
'For i = 0 To tCn.SubCount
' cmbMouseHandEventList.AddItem tCn.GetEventText(i)
'Next i
With cmbMouseHandEventType
.AddItem "一般"
.AddItem "插件"
End With
End Sub
Private Sub ShowMouseHandOrder(nObj As cCallByName)
On Error Resume Next
'If nObj.InsideIndex = nObj.GetScriptIndex Then 'script mode
If nObj.InsideIndex = nObj.GetPluginIndex Then 'script mode
cmbMouseHandEventType.ListIndex = 1
' Call ShowInCombo_Script
Call ShowInCombo_Plugin
' If nObj.ScriptIndex > gScriptCnt Then
' nObj.ScriptIndex = gScriptCnt
' End If
If nObj.PluginIndex > gPluginCnt Then
nObj.PluginIndex = gPluginCnt
End If
'cmbMouseHandEventList.ListIndex = nObj.ScriptIndex - 1
cmbMouseHandEventList.ListIndex = nObj.PluginIndex - 1
Else
cmbMouseHandEventType.ListIndex = 0
Call ShowInCombo_Order
cmbMouseHandEventList.ListIndex = nObj.InsideIndex
End If
End Sub
Private Sub ShowInCombo_Order()
Dim tObj As New cCallByName
Dim i&
cmbMouseHandEventList.Clear
For i = 0 To tObj.SubCount
cmbMouseHandEventList.AddItem tObj.GetEventText(i)
Next i
End Sub
Private Sub ShowInCombo_Plugin()
Dim i&
cmbMouseHandEventList.Clear
For i = 1 To gPluginCnt
cmbMouseHandEventList.AddItem gPlugins(i).Title
Next i
End Sub
'Private Sub ShowInCombo_Script()
''Dim i&
''cmbMouseHandEventList.Clear
''For i = 1 To gScriptCnt
'' cmbMouseHandEventList.AddItem gScripts(i).Title
''Next i
'End Sub
'显示鼠标手势
Private Sub ShowMouseHand()
Dim tstr$
tstr = DirFlag(mHand(0)) & DirFlag(mHand(1)) & DirFlag(mHand(2))
labMouseHandShow.Caption = tstr
End Sub
'初始化拖拽控件
Private Sub IniDragDrop()
Dim i& ', j&
For i = 0 To 3
txtDragDropLink(i).Text = gDDEventLink(i).EventText
txtDragDropText(i).Text = gDDEventText(i).EventText
txtDragDropImage(i).Text = gDDEventImage(i).EventText
Next i
End Sub
'改变拖拽设置
Private Sub ChangeDragDropSetup( _
nTxt As VB.TextBox, nObj As cDragDropEvent)
Call nObj.PopMenuInSetup(Me.hWnd)
nTxt.Text = nObj.EventText
End Sub
'================ Plugin zzzzz ======================
Private Sub IniPluginControl()
Dim i&
mPluginCnt = gPluginCnt
ReDim mPlugins(0 To mPluginCnt)
For i = 1 To mPluginCnt
mPlugins(i).Title = gPlugins(i).Title
mPlugins(i).Command = gPlugins(i).FileName
mPlugins(i).Param = gPlugins(i).Param
mPlugins(i).VisInMenu = (gPlugins(i).VisInMenu = 1)
lstPlugin_List.AddItem mPlugins(i).Title
lstPlugin_List.Selected(i - 1) = mPlugins(i).VisInMenu
Next i
Set mPluginControls = New cListMove
mPluginControls.IniMe lstPlugin_List, cmdPlugin_MoveUp, cmdPlugin_MoveDown, cmdPlugin_Add, cmdPlugin_Del
If mPluginCnt > 0 Then
lstPlugin_List.ListIndex = 0
End If
mPlugins_SBCnt = gPluginSBCnt
ReDim mPlugins_SideBand(0 To mPlugins_SBCnt)
For i = 1 To mPlugins_SBCnt
With mPlugins_SideBand(i)
.Title = gPluginsSideBand(i).Title
.Command = gPluginsSideBand(i).FileName
.Param = gPluginsSideBand(i).Param
.VisInMenu = (gPluginsSideBand(i).VisInMenu = 1)
End With
Next i
End Sub
Private Sub PluginControlApplyChange()
Select Case m_cTabPluginTypes.SelectIndex
Case 0
Call PluginControlApplyChange_Command
Case 1
Call PluginControlApplyChange_SideBand
Case 2
Call PluginControlApplyChange_ToolBand
End Select
End Sub
Private Sub PluginControlApplyChange_Command()
Dim i&
gPluginCnt = mPluginCnt
ReDim gPlugins(0 To gPluginCnt)
For i = 1 To gPluginCnt
Set gPlugins(i) = New cPluginData
gPlugins(i).Title = mPlugins(i).Title
gPlugins(i).FileName = mPlugins(i).Command
gPlugins(i).Param = mPlugins(i).Param
gPlugins(i).VisInMenu = BooleanToBool(mPlugins(i).VisInMenu)
Next i
Set gPlugins(0) = New cPluginData
Call mPlugin.ReloadPluginData
Call mPlugin.LoadPluginsMenu
End Sub
Private Sub PluginControlApplyChange_SideBand()
Dim i&
gPluginSBCnt = mPlugins_SBCnt
ReDim gPluginsSideBand(0 To gPluginSBCnt)
For i = 1 To gPluginSBCnt
Set gPluginsSideBand(i) = New cPluginSideband
With mPlugins_SideBand(i)
gPluginsSideBand(i).Title = .Title
gPluginsSideBand(i).FileName = .Command
gPluginsSideBand(i).Param = .Param
gPluginsSideBand(i).VisInMenu = BooleanToBool(.VisInMenu)
End With
Next i
Set gPluginsSideBand(0) = New cPluginSideband
Call mPlugin.ReloadPluginData_SideBand
Call mPlugin.LoadPlugins_SideBand
End Sub
Private Sub PluginControlApplyChange_ToolBand()
End Sub
'=============== END of Plugin zzz ===================
'============== common controls zzz===================
'---------------------------------------------------------------------------------------
' Procedure : IniMainTab
' DateTime : 2005-3-29 22:46
' Author : Lingll
' Purpose : 初始化主Tab
'---------------------------------------------------------------------------------------
Private Sub IniMainTab()
Dim i&, tRc As RECT
Set m_cTabMain = CreateCmmCtrl(strCLSID_cTabControl32) 'New cTabControl32
With m_cTabMain
.Create Me.hWnd, TCS_MULTILINE, 0, 0, _
Me.ScaleWidth, Me.ScaleHeight
.SetFont
.SetMiniWidth 0
.AddItem 0, "一般"
.AddItem 1, "过滤"
.AddItem 2, "地址栏"
.AddItem 3, "页面规则"
.AddItem 4, "鼠标设置"
.AddItem 5, "插件"
.AddItem 6, "拖拽"
.AddItem 7, "搜索栏"
.AddItem 8, "收藏夹"
.GetAdjustRect tRc.Left, tRc.Top, tRc.Right, tRc.Bottom
End With
For i = 0 To frameCnt - 1
With fraOption(i)
.BackColor = &H8000000F
'MoveWindow .hWnd, tRc.Left, tRc.Top, _
tRc.Right - tRc.Left, tRc.Bottom - tRc.Top
.Move tRc.Left, tRc.Top, _
tRc.Right - tRc.Left, _
tRc.Bottom - tRc.Top
.Visible = False
End With
fraOption(0).Visible = True
Next i
End Sub
'---------------------------------------------------------------------------------------
' Procedure : IniMouseTab
' DateTime : 2005-3-29 23:23
' Author : Lingll
' Purpose : 初始化"鼠标"页里面的tab
'---------------------------------------------------------------------------------------
Private Sub IniMouseTab()
Dim i&, tRc As RECT
Set m_cTabMouse = CreateCmmCtrl(strCLSID_cTabControl32) ' New cTabControl32
With m_cTabMouse
.Create fraOption(4).hWnd, TCS_BUTTONS Or TCS_FLATBUTTONS Or TCS_FIXEDWIDTH, _
0, 4, fraOption(4).width, fraOption(4).height - 4
.SetFont
.AddItem 0, "一般"
.AddItem 1, "鼠标手势"
.GetAdjustRect tRc.Left, tRc.Top, tRc.Right, tRc.Bottom
End With
For i = 0 To 1
With fraMouse(i)
.BackColor = &H8000000F
MoveWindow .hWnd, tRc.Left, tRc.Top, _
tRc.Right - tRc.Left, tRc.Bottom - tRc.Top, 0
'.Move tRc.Left, tRc.Top, _
(tRc.Right - tRc.Left), _
(tRc.Bottom - tRc.Top)
.Visible = False
End With
Next i
fraMouse(0).Visible = True
End Sub
'---------------------------------------------------------------------------------------
' Procedure : IniPluginTab
' DateTime : 2005-5-29 16:24
' Author : Lingll
' Purpose : 初始化"插件"里的tab
'---------------------------------------------------------------------------------------
Private Sub IniPluginTab()
Dim i&, tRc As RECT
Set m_cTabPluginTypes = CreateCmmCtrl(strCLSID_cTabControl32)
With m_cTabPluginTypes
.Create fraOption(5).hWnd, TCS_BUTTONS Or TCS_FLATBUTTONS, _
4, 4, 250, 156
.SetFont
.AddItem 0, "命令按钮"
.AddItem 1, "侧边栏"
.AddItem 2, "工具栏"
.GetAdjustRect tRc.Left, tRc.Top, tRc.Right, tRc.Bottom
End With
'For i = 0 To 2
' With fraPlugin(i)
' .BackColor = &H8000000F
' MoveWindow .hWnd, tRc.Left, tRc.Top, _
' tRc.Right - tRc.Left, tRc.Bottom - tRc.Top, 0
' '.Move tRc.Left, tRc.Top, _
' (tRc.Right - tRc.Left), _
' (tRc.Bottom - tRc.Top)
' .Visible = False
' End With
'Next i
'fraPlugin(0).Visible = True
MoveWindow lstPlugin_List.hWnd, tRc.Left, tRc.Top, _
tRc.Right - tRc.Left, tRc.Bottom - tRc.Top, 0
End Sub
'---------------------------------------------------------------------------------------
' Procedure : IniSearchLvw
' DateTime : 2005-3-29 23:57
' Author : Lingll
' Purpose : 初始化"搜索"页lvw
'---------------------------------------------------------------------------------------
Private Sub IniSearchLvw()
Dim i&
m_Sch_ChangeLock = True
Set m_cLvwSearchBar = CreateCmmCtrl(strCLSID_cSysListView32) 'New cSysListView32
With m_cLvwSearchBar
.Create pctSearchBar_HoldLvw.hWnd, _
LVS_REPORT Or LVS_SHOWSELALWAYS Or LVS_SINGLESEL, _
LVS_EX_FULLROWSELECT Or LVS_EX_CHECKBOXES, _
0, 0, pctSearchBar_HoldLvw.ScaleWidth, pctSearchBar_HoldLvw.ScaleHeight
.AddColumn 0, "多引擎搜索", 70
.AddColumn 1, "名称", 80
.AddColumn 2, "地址", 200
mSearchEgnCount = gSearchEgnCount
ReDim mSearchEgn(0 To mSearchEgnCount)
For i = 1 To mSearchEgnCount
mSearchEgn(i) = gSearchEgn(i)
.AddItem vbNullString, i - 1
.SetItemText mSearchEgn(i).Title, i - 1, 1
.SetItemText mSearchEgn(i).Url, i - 1, 2
Next i
If mSearchEgnCount > 0 Then
.SelectItem 0, True
txtSearchBarTitle.Text = mSearchEgn(1).Title
txtSearchBarUrl.Text = mSearchEgn(1).Url
Else
txtSearchBarTitle.Text = ""
txtSearchBarUrl.Text = ""
End If
End With
m_Sch_ChangeLock = False
End Sub
'---------------------------------------------------------------------------------------
' Procedure : IniMouseHandLvw
' DateTime : 2005-3-30 12:22
' Author : Lingll
' Purpose : 初始化"鼠标手势"页 lvw
'---------------------------------------------------------------------------------------
Private Sub IniMouseHandLvw()
Dim tcnt&, i&
Dim tDescription$, tHandShow$, tInsideIndex&, tEventText$
Set m_cLvwMouseHand = CreateCmmCtrl(strCLSID_cSysListView32) ' New cSysListView32
With m_cLvwMouseHand
.Create pctMouseHand_HoldLvw.hWnd, _
LVS_REPORT Or LVS_SHOWSELALWAYS Or LVS_SINGLESEL, _
LVS_EX_FULLROWSELECT, 0, 0, _
pctMouseHand_HoldLvw.ScaleWidth, _
pctMouseHand_HoldLvw.ScaleHeight
.AddColumn 0, "名称", pctMouseHand_HoldLvw.ScaleWidth / 2 - 40
.AddColumn 1, "命令", pctMouseHand_HoldLvw.ScaleWidth / 2
tcnt = MouseHand.GetHandCount
For i = 1 To tcnt
Call MouseHand.GetInfo_ByIndex(i, tDescription, tHandShow, tInsideIndex, tEventText)
.AddItem tDescription, i - 1
.SetItemText tEventText, i - 1, 1
Next i
End With
End Sub
'============== END of common controls ================
'---------------------------------------------------------------------------------------
' Procedure : IniFavoriteControl
' DateTime : 2005-4-19 17:58
' Author : Lingll
' Purpose : 初始化"收藏夹"页
'---------------------------------------------------------------------------------------
Private Sub IniFavoriteControl()
If gFavoriteUseDefaultPath Then
optFavorite_Path_Default.Value = True
txtFavorite_Path.Enabled = False
cmdFavorite_Browse.Enabled = False
Else
optFavorite_Path_Cus.Value = True
txtFavorite_Path.Enabled = True
cmdFavorite_Browse.Enabled = True
End If
chkFavorite_Showhidden.Value = gFavoriteShowHidden
chkFavorite_SinglLine = gFavoriteSinglLineMenu
txtFavorite_Path.Text = gFavoriteCustomPath
m_FavoriteUseDefaultPath = gFavoriteUseDefaultPath
m_FavoriteCustomPath = gFavoriteCustomPath$
m_FavoriteSinglLineMenu = gFavoriteSinglLineMenu
m_FavoriteShowHidden = gFavoriteShowHidden
End Sub
'---------------------------------------------------------------------------------------
' Procedure : IniDownload
' DateTime : 2005-8-15 00:04
' Author : Lingll
' Purpose : 初始化下载...
'---------------------------------------------------------------------------------------
Private Sub IniDownload()
On Error Resume Next
Dim i&
chkDownShowDlg.Value = gShowDownDlg
chkDownUseTool.Value = gUseDownTool
cmbDownTools.Clear
For i = 1 To gDownToolCount
cmbDownTools.AddItem gDownTools(i).Title
Next i
If gDownToolCount > 0 Then
cmbDownTools.ListIndex = gDownToolIndex - 1
End If
cmbDownTools.Enabled = (gUseDownTool = 1)
End Sub