浏览器

开发平台：
Visual Basic

cTvwFavorite.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cTvwFavorite"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Private WithEvents mTvwMain As TreeView
Private WithEvents m_cTvwMain As cTreeView32
Attribute m_cTvwMain.VB_VarHelpID = -1
Private mMdiFrm As MDIFrmMain
Private Sub m_cTvwMain_Click(hItem As Long, x As Long, y As Long)
Dim tIndex&
On Error GoTo m_cTvwMain_Click_Error
If hItem <> 0 Then
    Select Case m_cTvwMain.GetItemCChildren(hItem)
        Case 1
    
            'Call ExpandNode( , Not tmpNode.Expanded)
        Case 0
            tIndex = m_cTvwMain.GetItemParam(hItem)
            If vkPress(VK_SHIFT) Then
                Call mMdiFrm.NewWebbrowser(favoriteInfo(tIndex).Url)
            Else
                If loadedBrowserCount > 0 Then
                    webbState(gActiveWebIndex).webForm.Navigate favoriteInfo(tIndex).Url, False
                Else
                    Call mMdiFrm.NewWebbrowser(favoriteInfo(tIndex).Url)
                End If
            End If
    End Select
End If
   
   Exit Sub
m_cTvwMain_Click_Error:
    Debug.Print "Error " & Err.Number & " (" & Err.Description & ") in procedure m_cTvwMain_Click of Class Module cTvwFavorite"
End Sub
Private Sub m_cTvwMain_Expanding(hItem As Long, isExpand As Boolean)
On Error Resume Next
Dim tIndex&
tIndex = m_cTvwMain.GetItemParam(hItem)
If isExpand Then
    With loadSubInfo(tIndex)
        If Not .isLoadSub Then
            'mMdiFrm.SeedFile .path, .hWnd, , , .hNode
            mMdiFrm.SeekFavoriteFolder .path, .hWnd, , , .hNode
            .isLoadSub = True
        End If
    End With
    Call m_cTvwMain.SetItemIcon(hItem, 5, 5)
Else
    Call m_cTvwMain.SetItemIcon(hItem, 4, 4)
End If
End Sub
Private Sub m_cTvwMain_RClick(hItem As Long, x As Long, y As Long)
If hItem <> 0 Then
    Call PopMenu(hItem)
End If
End Sub
Private Sub m_cTvwMain_SetTip(hItem As Long, vTip As String)
On Error Resume Next
If m_cTvwMain.GetItemCChildren(hItem) = 0 Then
    With favoriteInfo(m_cTvwMain.GetItemParam(hItem))
        vTip = .Title & vbNewLine & .Url
    End With
End If
End Sub
'Private Sub mTvwMain_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'Dim tmpNode As Node
'Set tmpNode = mTvwMain.HitTest(x, y)
'If Not (tmpNode Is Nothing) Then
'    Select Case Button
'        Case vbLeftButton
'            If tmpNode.Tag = "Root" Then
'                Call ExpandNode(tmpNode, Not tmpNode.Expanded)
'            Else
''                If Not mMdiFrm.tlbOther.Buttons("locknew").Value Then webbState(gActiveWebIndex).isFirst = 1
'                If Shift = vbShiftMask Then
'                    'isTabClick = True
'                    Call mMdiFrm.NewWebbrowser(tmpNode.Tag) 'gActiveWebIndex = newWebbrowser(tmpNode.Tag)
'                Else
'                    If loadedBrowserCount > 0 Then
'                        webbState(gActiveWebIndex).webForm.Navigate tmpNode.Tag, False
'                    Else
'                        Call mMdiFrm.NewWebbrowser(tmpNode.Tag)
'                    End If
'                End If
'            End If
'            Button = 0
'        Case vbRightButton
'            Call PopMenu(tmpNode)
'            Button = 0
'    End Select
'End If
'End Sub
Public Sub ExpandNode(nNode As Long, nExpanded As Boolean)
Dim tIndex&
If m_cTvwMain Is Nothing Then Exit Sub
On Error GoTo ExpandNode_Error
tIndex = m_cTvwMain.GetItemParam(nNode)
With loadSubInfo(tIndex)
    If Not .isLoadSub Then
        'Call mMdiFrm.SeedFile(.path, .hWnd, , , .hNode)
        Call mMdiFrm.SeekFavoriteFolder(.path, .hWnd, , , .hNode)
        .isLoadSub = True
    End If
End With
If nExpanded Then
    Call m_cTvwMain.ExpandItem(nNode, TVE_EXPAND)
Else
    Call m_cTvwMain.ExpandItem(nNode, TVE_COLLAPSE)
End If
'If nExpanded Then
'    Set tNode = nNode.Parent
'    While Not tNode Is Nothing
'        tNode.Expanded = True
'        Set tNode = tNode.Parent
'    Wend
'    nNode.image = ImgK_Icon_Folder_Open  ' 6
'Else
'    nNode.image = ImgK_Icon_Folder ' 1
'End If
   
Exit Sub
ExpandNode_Error:
    Debug.Print "Error " & Err.Number & " (" & Err.Description & ") in procedure ExpandNode of Class Module cTvwFavorite"
End Sub
Public Sub IniClass(nTvw As cTreeView32, nMdi As MDIForm)
Set m_cTvwMain = nTvw
Set mMdiFrm = nMdi
End Sub
Public Property Get TvwMain() As cTreeView32
    Set TvwMain = m_cTvwMain
End Property
Private Sub PopMenu(hItem&)
On Error Resume Next
Dim tShell As New cShowFilePropertyWindow
Dim tId As Long
Dim hw As Long
Dim tIndex&
Dim tNode&
hw = mMdiFrm.hWnd
tIndex = m_cTvwMain.GetItemParam(hItem)
Select Case m_cTvwMain.GetItemCChildren(hItem)
    Case 1
        FavoriteFolderPopMenu.SetDefault ID_FavFolder_SideFav
        tId = FavoriteFolderPopMenu.Popup2(hw)
        Select Case tId
            Case ID_FavFolder_Explorer
                tShell.ShowProps loadSubInfo(tIndex).path, verbShowExplorer
            Case ID_FavFolder_SideFav
                Call ExpandNode(hItem, True)
            Case ID_FavFolder_OpenAllLink
                Call ExpandNode(hItem, m_cTvwMain.GetItemState(hItem, TVIS_EXPANDED) = TVIS_EXPANDED)
                tNode = m_cTvwMain.GetNextItem(TVGN_CHILD, hItem)
                While tNode <> 0
                    If m_cTvwMain.GetItemCChildren(tNode) = 0 Then
                        mMdiFrm.NewWebbrowser favoriteInfo(m_cTvwMain.GetItemParam(tNode)).Url
                    End If
                    tNode = m_cTvwMain.GetNextItem(TVGN_NEXT, tNode)
                Wend
        End Select
    Case 0
        FavoriteURLPopMenu.SetDefault ID_FavUrl_Open
        tId = FavoriteURLPopMenu.Popup2(hw)
        Select Case tId
            Case ID_FavUrl_OpenNew
                mMdiFrm.NewWebbrowser favoriteInfo(tIndex).Url
            Case ID_FavUrl_Open
                If loadedBrowserCount > 0 Then
                    webbState(gActiveWebIndex).webForm.Navigate favoriteInfo(tIndex).Url, False
                Else
                    Call mMdiFrm.NewWebbrowser(favoriteInfo(tIndex).Url)
                End If
            Case ID_FavUrl_Property
               tShell.ShowProps favoriteInfo(tIndex).path, verbShowProperties
            Case ID_FavUrl_OpenIE
                Call mMdiFrm.NewIE(favoriteInfo(tIndex).Url)
            Case ID_FavUrl_Delete
'                If MsgBox("确实要删除 """ & favoriteInfo(tIndex).Title & """ ?", vbOKCancel Or vbQuestion, "删除收藏") = vbOK Then
'                    Kill favoriteInfo(tIndex).path
'                End If
        End Select
End Select
End Sub
'Option Explicit
'
'Private WithEvents mTvwMain As TreeView
'Private mMdiFrm As MDIFrmMain
''Private tvwPopItemKey  As String
'Private mDownPt As POINTAPI
''Private mPrePt As POINTAPI
'Private mDownNode As MSComctlLib.Node
'
'Private Sub mTvwMain_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'mDownPt.x = x / 15
'mDownPt.y = y / 15
'Set mDownNode = mTvwMain.HitTest(x, y)
'If Not mDownNode Is Nothing Then
'    mDownNode.Selected = True
'End If
'End Sub
'
'Private Sub mTvwMain_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'Dim tmpNode As Node
'Set tmpNode = mTvwMain.HitTest(x, y)
'If Not (tmpNode Is Nothing) Then
'    If tmpNode.Tag <> "Root" Then
'        mTvwMain.ToolTipText = tmpNode.Tag
'    Else
'        mTvwMain.ToolTipText = ""
'    End If
'Else
'    mTvwMain.ToolTipText = ""
'End If
'If Button <> 0 Then
'    If Not (tmpNode Is mDownNode) Then
'        mTvwMain.Drag
'    End If
'End If
'End Sub
'
'Private Sub mTvwMain_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'Dim tmpNode As Node
'Set tmpNode = mTvwMain.HitTest(x, y)
'If Not (tmpNode Is Nothing) Then
'    Select Case Button
'        Case vbLeftButton
'            If tmpNode.Tag = "Root" Then
'                Call ExpandNode(tmpNode, Not tmpNode.Expanded)
'            Else
''                If Not mMdiFrm.tlbOther.Buttons("locknew").Value Then webbState(gActiveWebIndex).isFirst = 1
'                If Shift = vbShiftMask Then
'                    'isTabClick = True
'                    Call mMdiFrm.NewWebbrowser(tmpNode.Tag) 'gActiveWebIndex = newWebbrowser(tmpNode.Tag)
'                Else
'                    If loadedBrowserCount > 0 Then
'                        webbState(gActiveWebIndex).webForm.Navigate tmpNode.Tag, False
'                    Else
'                        Call mMdiFrm.NewWebbrowser(tmpNode.Tag)
'                    End If
'                End If
'            End If
'            Button = 0
'        Case vbRightButton
'            Call PopMenu(tmpNode)
'            Button = 0
'    End Select
'End If
'End Sub
'
'Public Sub ExpandNode(nNode As MSComctlLib.Node, nExpanded As Boolean)
'Dim tNode As MSComctlLib.Node
'If Not loadSubInfo(nNode.index).isLoadSub Then
'    Call mMdiFrm.SeedFile(nNode.Key, loadSubInfo(nNode.index).hwnd, , , loadSubInfo(nNode.index).hNode)
'    loadSubInfo(nNode.index).isLoadSub = True
'End If
'nNode.Expanded = nExpanded
'If nExpanded Then
'    Set tNode = nNode.Parent
'    While Not tNode Is Nothing
'        tNode.Expanded = True
'        Set tNode = tNode.Parent
'    Wend
'    nNode.image = ImgK_Icon_Folder_Open  ' 6
'Else
'    nNode.image = ImgK_Icon_Folder ' 1
'End If
'End Sub
'Public Sub IniClass(nTvw As TreeView, nMdi As MDIForm)
'Set mTvwMain = nTvw
'Set mMdiFrm = nMdi
'End Sub
'
'Public Property Get TvwMain() As TreeView
'    Set TvwMain = mTvwMain
'End Property
'
'Private Sub PopMenu(nNode As MSComctlLib.Node)
'Dim tShell As New cShowFilePropertyWindow
'Dim tId As Long
'Dim hw As Long
'Dim tNode As MSComctlLib.Node
'hw = mMdiFrm.hwnd
'
'If nNode.Tag = "Root" Then
'    FavoriteFolderPopMenu.SetDefault ID_FavFolder_SideFav
'    tId = FavoriteFolderPopMenu.Popup2(hw)
'    Select Case tId
'        Case ID_FavFolder_Explorer
'            tShell.ShowProps nNode.Key, verbShowExplorer
'        Case ID_FavFolder_SideFav
'            Call ExpandNode(nNode, True)
'        Case ID_FavFolder_OpenAllLink
'            Call ExpandNode(nNode, nNode.Expanded)
'            Set tNode = nNode.Child
'            While Not tNode Is Nothing
'                If tNode.Tag <> "Root" Then
'                    mMdiFrm.NewWebbrowser tNode.Tag
'                End If
'                Set tNode = tNode.Next
'            Wend
'    End Select
'Else
'    FavoriteURLPopMenu.SetDefault ID_FavUrl_Open
'    tId = FavoriteURLPopMenu.Popup2(hw)
'    Select Case tId
'        Case ID_FavUrl_OpenNew
'            mMdiFrm.NewWebbrowser nNode.Tag
'        Case ID_FavUrl_Open
'            If loadedBrowserCount > 0 Then
'                webbState(gActiveWebIndex).webForm.Navigate nNode.Tag, False
'            Else
'                Call mMdiFrm.NewWebbrowser(nNode.Tag)
'            End If
'        Case ID_FavUrl_Property
'           tShell.ShowProps nNode.Key, verbShowProperties
'        Case ID_FavUrl_OpenIE
'            Call mMdiFrm.NewIE(nNode.Tag)
'    End Select
'
'End If
'End Sub
'
'
'

						