浏览器

开发平台：
Visual Basic

frmSpPageList.frm：源码内容
							VERSION 5.00
Begin VB.Form frmSpPageList 
   Caption         =   "页面管理"
   ClientHeight    =   4950
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8490
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MinButton       =   0   'False
   ScaleHeight     =   4950
   ScaleWidth      =   8490
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.PictureBox pctTabs 
      Appearance      =   0  'Flat
      BackColor       =   &H0000C0C0&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      HasDC           =   0   'False
      Height          =   1695
      Index           =   1
      Left            =   4440
      ScaleHeight     =   1695
      ScaleWidth      =   1395
      TabIndex        =   6
      Top             =   1740
      Visible         =   0   'False
      Width           =   1395
   End
   Begin VB.PictureBox pctTabs 
      Appearance      =   0  'Flat
      BackColor       =   &H000040C0&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      HasDC           =   0   'False
      Height          =   1695
      Index           =   0
      Left            =   1260
      ScaleHeight     =   1695
      ScaleWidth      =   1395
      TabIndex        =   5
      Top             =   1380
      Width           =   1395
   End
   Begin VB.Frame fraButtons 
      BorderStyle     =   0  'None
      Caption         =   "Frame1"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   420
      Left            =   3240
      TabIndex        =   0
      Top             =   4440
      Width           =   5220
      Begin VB.CommandButton cmdClose 
         Cancel          =   -1  'True
         Caption         =   "关闭(&C)"
         Height          =   420
         Left            =   4020
         TabIndex        =   4
         Top             =   0
         Width           =   1200
      End
      Begin VB.CommandButton cmdOpenLink 
         Caption         =   "打开(&O)"
         Height          =   420
         Left            =   2640
         TabIndex        =   3
         Top             =   0
         Width           =   1200
      End
      Begin VB.CommandButton cmdSelectAll 
         Caption         =   "全选(&A)"
         Height          =   420
         Left            =   0
         TabIndex        =   1
         Top             =   0
         Width           =   1200
      End
      Begin VB.CommandButton cmdSelectInvert 
         Caption         =   "反选(&I)"
         Height          =   420
         Left            =   1260
         TabIndex        =   2
         Top             =   0
         Width           =   1200
      End
   End
End
Attribute VB_Name = "frmSpPageList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const TabCount As Long = 2
Private WithEvents mFiltratePages As cFiltratePages
Attribute mFiltratePages.VB_VarHelpID = -1
Private WithEvents mCloasePages As cClosedPages
Attribute mCloasePages.VB_VarHelpID = -1
'Private mPresentLvw As MSComctlLib.ListView
Private WithEvents m_cTab As cTabControl32
Attribute m_cTab.VB_VarHelpID = -1
Private m_cLvwClosePage As cSysListView32
Private m_cLvwFiltratePage As cSysListView32
Private m_cLvwPres As cSysListView32
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdOpenLink_Click()
On Error Resume Next
Dim i&, tcnt&
Select Case m_cTab.SelectIndex
    Case 0  'close pages
        tcnt = m_cLvwClosePage.GetItemCount
        For i = 0 To tcnt - 1
            If m_cLvwClosePage.GetCheckState(i) Then
                Call gMainForm.NewWebbrowser(mCloasePages.GetUrl(tcnt - i))
            End If
        Next i
    Case 1 'filtrate pages
        tcnt = m_cLvwFiltratePage.GetItemCount
        For i = 0 To tcnt - 1
            If m_cLvwFiltratePage.GetCheckState(i) Then
                gMainForm.NewWebbrowser (mFiltratePages.GetUrl(i + 1))
            End If
        Next i
End Select
'Dim tLvwItem As MSComctlLib.ListItem
'Select Case m_cTab.GetSelected()
'    Case 0  'close pages
'        For Each tLvwItem In lvwClosePages.ListItems
'            If tLvwItem.Checked Then
'                Call gMainForm.NewWebbrowser(tLvwItem.SubItems(1))
'            End If
'        Next tLvwItem
'    Case 1 'filtrate pages
'        For Each tLvwItem In lvwFiltratePages.ListItems
'            If tLvwItem.Checked Then
'                Call gMainForm.NewWebbrowser(tLvwItem.Text)
'            End If
'        Next tLvwItem
'End Select
'Select Case TabStrip1.SelectedItem.index
'    Case 1  'close pages
'        For Each tLvwItem In lvwClosePages.ListItems
'            If tLvwItem.Checked Then
'                Call gMainForm.NewWebbrowser(tLvwItem.SubItems(1))
'            End If
'        Next tLvwItem
'    Case 2  'filtrate pages
'        For Each tLvwItem In lvwFiltratePages.ListItems
'            If tLvwItem.Checked Then
'                Call gMainForm.NewWebbrowser(tLvwItem.Text)
'            End If
'        Next tLvwItem
'End Select
End Sub
Private Sub cmdSelectAll_Click()
Dim i&, tcnt&
If Not m_cLvwPres Is Nothing Then
    With m_cLvwPres
        tcnt = m_cLvwPres.GetItemCount
        For i = 0 To tcnt - 1
            Call m_cLvwPres.CheckItem(True, i)
        Next i
    End With
End If
'Dim tLvw As MSComctlLib.ListItem
'If Not mPresentLvw Is Nothing Then
'    With mPresentLvw
'        For Each tLvw In .ListItems
'            tLvw.Checked = True
'        Next tLvw
'    End With
'End If
End Sub
Private Sub cmdSelectInvert_Click()
Dim i&, tcnt&
If Not m_cLvwPres Is Nothing Then
    With m_cLvwPres
        tcnt = m_cLvwPres.GetItemCount
        For i = 0 To tcnt - 1
            Call m_cLvwPres.CheckItem(Not m_cLvwPres.GetCheckState(i), i)
        Next i
    End With
End If
'Dim tLvw As MSComctlLib.ListItem
'If Not mPresentLvw Is Nothing Then
'    With mPresentLvw
'        For Each tLvw In .ListItems
'            tLvw.Checked = Not tLvw.Checked
'        Next tLvw
'    End With
'End If
End Sub
Private Sub Form_Load()
Set m_cTab = CreateCmmCtrl(strCLSID_cTabControl32)   'New cTabControl32
With m_cTab
    .Create Me.hwnd, 0, 0, 0, 100, 100
    .SetFont
    .AddItem 0, "关闭的页面"
    .AddItem 1, "被拦截的页面"
    .SetToBottom
End With
'With TabStrip1
'    .Tabs.Clear
'    .Tabs.Add , , "关闭的页面"
'    .Tabs.Add , , "被拦截的页面"
'End With
Set mFiltratePages = FiltratePages
Set mCloasePages = ClosedPages
Call Form_Resize
Call iniClosePages
Call iniFiltratePages
'Set mPresentLvw = lvwClosePages
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set mCloasePages = Nothing
Set mFiltratePages = Nothing
Set m_cLvwClosePage = Nothing
Set m_cLvwFiltratePage = Nothing
Set m_cTab = Nothing
End Sub
Private Sub Form_Resize()
On Error Resume Next
Dim i&, tRc As mAPIs.RECT
If Not m_cTab Is Nothing Then
    m_cTab.Move 0, 0, Me.ScaleWidth / 15, (Me.ScaleHeight - 540) / 15
    m_cTab.GetAdjustRect tRc.Left, tRc.Top, tRc.Right, tRc.Bottom
    
    tRc.Right = tRc.Right - tRc.Left
    tRc.Bottom = tRc.Bottom - tRc.Top
    
    For i = 0 To TabCount - 1
        MoveWindow pctTabs(i).hwnd, tRc.Left, tRc.Top, tRc.Right, tRc.Bottom, 1
    Next i
    
    m_cLvwClosePage.Move 0, 0, tRc.Right, tRc.Bottom
    'lvwClosePages.Move 0, 0, tRc.Right * 15, tRc.Bottom * 15
    m_cLvwFiltratePage.Move 0, 0, tRc.Right, tRc.Bottom
    'lvwFiltratePages.Move 0, 0, tRc.Right * 15, tRc.Bottom * 15
    fraButtons.Move Me.ScaleWidth - fraButtons.Width - 60, Me.ScaleHeight - fraButtons.Height - 60
End If
'With TabStrip1
'    m_cTab.Move 0, 0, Me.ScaleWidth / 15, (Me.ScaleHeight - 540) / 15
'    .Move 0, 0, Me.ScaleWidth, Me.ScaleHeight - 540
'    For i = 0 To TabCount - 1
'        fraTabs(i).Move .clientLeft, .clientTop, .clientWidth, .clientHeight
'    Next i
'    lvwClosePages.Move 0, 0, .clientWidth, .clientHeight
'    lvwFiltratePages.Move 0, 0, .clientWidth, .clientHeight
'End With
'fraButtons.Move Me.ScaleWidth - fraButtons.Width - 60, Me.ScaleHeight - fraButtons.Height - 60
End Sub
Private Sub iniClosePages()
Set m_cLvwClosePage = CreateCmmCtrl(strCLSID_cSysListView32)  ' New cSysListView32
With m_cLvwClosePage
    .Create pctTabs(0).hwnd, LVS_REPORT Or LVS_SHOWSELALWAYS Or LVS_SINGLESEL, _
        LVS_EX_FULLROWSELECT Or LVS_EX_CHECKBOXES, 0, 0, Me.ScaleWidth / 15, 100
    .AddColumn 0, "标题", Me.ScaleWidth / 15 / 2
    .AddColumn 1, "地址", Me.ScaleWidth / 15 / 2 - 4
End With
'With lvwClosePages
'    .ColumnHeaders.Add , , "标题"
'    .ColumnHeaders.Add , , "地址"
'    .ColumnHeaders(1).Width = .Width / 2
'    .ColumnHeaders(2).Width = .Width / 2 - 60
'
'End With
Call RefreshClosepages
'With lvwClosePages
'    .ColumnHeaders.Add , , "标题"
'    .ColumnHeaders.Add , , "地址"
'    .ColumnHeaders(1).Width = .Width / 2
'    .ColumnHeaders(2).Width = .Width / 2 - 60
'
'End With
'Call RefreshClosepages
End Sub
'更新关闭页面信息
Private Sub RefreshClosepages()
Dim i& ', tLstItem As MSComctlLib.ListItem
Dim tUrls() As String, tTitles() As String, tcnt&
m_cLvwClosePage.ClearItem
mCloasePages.GetClosePages tUrls, tTitles, tcnt
For i = 1 To tcnt
    m_cLvwClosePage.AddItem tTitles(i), 0
    m_cLvwClosePage.SetItemText tUrls(i), 0, 1
Next i
    
'Dim i&, tLstItem As MSComctlLib.ListItem
'Dim tUrls() As String, tTitles() As String, tcnt&
'
'lvwClosePages.ListItems.Clear
'mCloasePages.GetClosePages tUrls, tTitles, tcnt
'
'With lvwClosePages
'    For i = tcnt To 1 Step -1
'        Set tLstItem = .ListItems.Add(, , tTitles(i))
'        tLstItem.SubItems(1) = tUrls(i)
'    Next i
'End With
End Sub
Private Sub iniFiltratePages()
Dim i&, tcnt&
Dim tPU$, tUrl$
Set m_cLvwFiltratePage = CreateCmmCtrl(strCLSID_cSysListView32)  ' New cSysListView32
With m_cLvwFiltratePage
    .Create pctTabs(1).hwnd, LVS_REPORT Or LVS_SHOWSELALWAYS Or LVS_SINGLESEL, _
        LVS_EX_CHECKBOXES Or LVS_EX_FULLROWSELECT, 0, 0, Me.ScaleWidth / 15, 100
    .AddColumn 0, "地址", Me.ScaleWidth / 2 / 15
    .AddColumn 1, "出处", Me.ScaleWidth / 2 / 15 - 4
    
    tcnt = mFiltratePages.Count
    For i = 1 To tcnt
        mFiltratePages.Item i, tPU, tUrl
        .AddItem tUrl, i - 1
        .SetItemText tPU, i - 1, 1
    Next i
End With
'Dim i&, tcnt&, tLstItem As MSComctlLib.ListItem
'Dim tPU$, tUrl$
'With lvwFiltratePages
'    .ColumnHeaders.Add , , "地址"
'    .ColumnHeaders.Add , , "出处"
'    .ColumnHeaders(1).Width = .Width / 2
'    .ColumnHeaders(2).Width = .Width / 2 - 60
'
'    tcnt = mFiltratePages.Count
'    For i = 1 To tcnt
'        mFiltratePages.Item i, tPU, tUrl
'        Set tLstItem = .ListItems.Add(, , tUrl)
'        tLstItem.SubItems(1) = tPU
'    Next i
'End With
End Sub
Private Sub m_cTab_Changed(vPos As Long)
Dim i&, tIndex&
tIndex = vPos
For i = 0 To TabCount - 1
    If tIndex = i Then
        pctTabs(i).Visible = True
        pctTabs(i).ZOrder
    Else
        pctTabs(i).Visible = False
    End If
Next i
Select Case tIndex
    Case 0  'close pages
        Set m_cLvwPres = m_cLvwClosePage
    Case 1  'filtrate pages
        Set m_cLvwPres = m_cLvwFiltratePage
    Case Else
        Set m_cLvwPres = Nothing
End Select
'Select Case tIndex
'    Case 0  'close pages
'        Set mPresentLvw = lvwClosePages
'    Case 1  'filtrate pages
'        Set mPresentLvw = lvwFiltratePages
'    Case Else
'        Set mPresentLvw = Nothing
'End Select
End Sub
Private Sub mCloasePages_eChange()
Call RefreshClosepages
End Sub
Private Sub mFiltratePages_eAdd(nParentUrl As String, nUrl As String)
If Not m_cLvwFiltratePage Is Nothing Then
    m_cLvwFiltratePage.SetItemText nParentUrl, _
        m_cLvwFiltratePage.AddItem(nUrl), 1
    
End If
'Dim tLstItem As MSComctlLib.ListItem
'Set tLstItem = lvwFiltratePages.ListItems.Add(, , nUrl)
'tLstItem.SubItems(1) = nParentUrl
End Sub
'Private Sub TabStrip1_Click()
'Dim i&, tIndex&
'With TabStrip1
'    tIndex = .SelectedItem.index
'    For i = 0 To TabCount - 1
'        If tIndex - 1 = i Then
'            fraTabs(i).Visible = True
'        Else
'            fraTabs(i).Visible = False
'        End If
'    Next i
'End With
'
'Select Case tIndex
'    Case 1  'close pages
'        Set mPresentLvw = lvwClosePages
'    Case 2  'filtrate pages
'        Set mPresentLvw = lvwFiltratePages
'    Case Else
'        Set mPresentLvw = Nothing
'End Select
'End Sub

						