treeview.frm

用VB写的数据树形程序,看看吧.对写程序有好处的.

        cn.Open
        Resume Next
    ElseIf Err <> 0 Then ' 其他的错误
        MsgBox "不期望的错误: " & Err.Description
        End
    End If
End Sub

Private Sub lvwDB_ColumnClick(ByVal ColumnHeader As ColumnHeader)
    lvwDB.SortKey = ColumnHeader.Index - 1
    ' 设置 Sorted 为真对列表进行排序。
    lvwDB.Sorted = True
End Sub

Private Sub lvwDB_ItemClick(ByVal Item As ListItem)
    GetData Item.Key
 End Sub
Private Sub GetData(ISBN As String)
    ' 全局的 EventFlag 指示有多少个状态栏被使用。
    
    If EventFlag <> TITLE Then
        sbrDB.Panels.Clear
        Dim pnlX As Panel
        Set pnlX = sbrDB.Panels.Add(, "ISBN")
        pnlX.AutoSize = sbrContents
        Set pnlX = sbrDB.Panels.Add(, "author")
        pnlX.AutoSize = sbrContents
        Set pnlX = sbrDB.Panels.Add(, "year")
        pnlX.Width = 1000
        Set pnlX = sbrDB.Panels.Add(, "description")
        pnlX.AutoSize = sbrContents
    End If
        
    ' 打开 ADODB 记录集为状态栏获得数据。
    Dim rsTitles As New ADODB.Recordset
    Dim strQ As String
    strQ = "SELECT Authors.Author, Titles.ISBN, Titles.[Year Published], " & _
    "Titles.Description FROM Authors INNER JOIN (Titles INNER JOIN " & _
    "[Title Author] ON " & _
    "Titles.ISBN = [Title Author].ISBN) ON Authors.Au_ID = " & _
    "[Title Author].Au_ID WHERE Titles.ISBN='" & ISBN & " '"

    ' 打开记录集。
    rsTitles.Open strQ, cn, adOpenStatic, adLockOptimistic
    
    ' 使用信息组织状态栏窗格。
    sbrDB.Panels("author").Text = rsTitles!author
    sbrDB.Panels("ISBN").Text = rsTitles!ISBN
    If Not IsNull(rsTitles![Year Published]) Then
        sbrDB.Panels("year").Text = rsTitles![Year Published]
    Else
        sbrDB.Panels("year").Text = "n/a"
    End If
    If Not IsNull(rsTitles!Description) Then
        sbrDB.Panels("description").Text = rsTitles!Description
    Else
        sbrDB.Panels("description").Text = "n/a"
    End If
    If Not rsTitles.EOF Then rsTitles.MoveNext
    ' 添加其他的作者名称。
    Do Until rsTitles.EOF
        
        If Not IsNull(rsTitles!author) Then
            sbrDB.Panels("author").Text = sbrDB.Panels("author").Text & _
            " & " & rsTitles!author
        End If
        rsTitles.MoveNext
    Loop
    ' 设置 EventFlag 时窗格不被重新创建。
    EventFlag = TITLE
End Sub


Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuLoad_Click()
    Static Loaded As Boolean
    If Loaded = True Then
        Exit Sub
    Else
        cmdLoad_Click
        Loaded = Abs(Loaded - 1)
        mnuLoad.Enabled = False
    End If
End Sub

Private Sub tvwDB_Collapse(ByVal node As node)
    ' 只有文件夹中的节点可以被折叠。
    If node.Tag = "Publisher" Or node.Index = 1 Then node.Image = "closed"
End Sub

Private Sub tvwDB_Expand(ByVal node As node)
    ' 只有顶节点，和出版商节点可以被折叠。
    If node.Tag = "Publisher" Or node.Index = 1 Then
        node.Image = "open"
        node.Sorted = True
    End If
    If node.Tag = "Publisher" And EventFlag <> _
    PUBLISHER Then MakeColumns
    ' 如果标志为 "Publisher" 并且 mItemCurrentIndex
    ' 索引与 Node.key 不相同 , 那么
    ' 激活 GetTitles 函数。
    If node.Tag = "Publisher" And mCurrentIndex <> Val(node.Key) _
    Then GetTitles node, Val(node.Key)
    
    If node.Tag = "Publisher" Then PopStatus node

    node.Sorted = True

End Sub

Private Sub MakeColumns()
    ' 清除 ColumnHeaders 集合。
    lvwDB.ColumnHeaders.Clear
    ' 添加四个 ColumnHeaders。
    lvwDB.ColumnHeaders.Add , , "Title", 2800
    lvwDB.ColumnHeaders.Add , , "Author"
    lvwDB.ColumnHeaders.Add , , "Year", 800
    lvwDB.ColumnHeaders.Add , , "ISBN"
    
    ' 设置 EventFlag 变量使这个过程不要再三发生。
    EventFlag = PUBLISHER
End Sub
Private Sub AddListItemsOnly(pubID)
    Dim rsTitles As New ADODB.Recordset
    Dim newNode As node
    Dim strQ As String
    strQ = "SELECT Titles.Title, Authors.Author, Titles.ISBN, " & _
    "Titles.[Year Published] FROM Authors INNER JOIN " & _
    "(Titles INNER JOIN [Title Author] " & _
    "ON Titles.ISBN = [Title Author].ISBN) ON Authors.Au_ID = " & _
    "[Title Author].Au_ID WHERE Titles.PubID=" & pubID
    
    lvwDB.ListItems.Clear
    With rsTitles
        .Open strQ, cn, adOpenStatic, adLockReadOnly, adCmdText
        .MoveLast
        .MoveFirst
        prgLoad.Max = .RecordCount + 1
    End With
    
    ' 显示进程栏
    prgLoad.Visible = True

    Dim intCounter As Integer
    ' 创建子节点。
    

    ' 添加相应的 ListItem 。
    AddListItem mItem, rsTitles
    
    rsTitles.MoveNext
    ' 遍历记录集中的剩余记录。如果下一个记录是
    ' 一个副本，那么仅添加作者名称。
    ' 否则, 添加新的 Node 及 ListItem。
    Do Until rsTitles.EOF
        intCounter = intCounter + 1 ' 作用于进程栏
        prgLoad.Value = intCounter  ' 更新进程。

        If mItem.Key = rsTitles!ISBN Then ' 副本
            ' 添加作者到作者列表。
            mItem.ListSubItems(1).Text = _
            mItem.ListSubItems(1).Text & _
            " & " & rsTitles!author
        Else
            AddListItem mItem, rsTitles
        End If
        rsTitles.MoveNext
    Loop
    prgLoad.Visible = False
    mCurrentIndex = pubID
End Sub

Private Function GetTitles(ByRef ParentNode As node, pubID) As Boolean
    Dim rsTitles As New ADODB.Recordset
    Dim newNode As node ' 作为新的 Node.
    Dim strQ As String
    Dim intCounter As Integer ' 作为进程栏的值
    
    ' 检查节点是否没有被组织。如果已经被组织，那么
    ' 仅添加 ListItem 对象到 ListView 并且退出。
    If ParentNode.Children Then
        AddListItemsOnly pubID
        Exit Function
    End If
    
    ' 如果 ListView 已经被组织，则清除它。
    lvwDB.ListItems.Clear
    
    ' SQL Query 检索所有所需字段。
    strQ = "SELECT Titles.Title, Authors.Author, Titles.ISBN, " & _
    "Titles.[Year Published] FROM Authors INNER JOIN " & _
    "(Titles INNER JOIN [Title Author] " & _
    "ON Titles.ISBN = [Title Author].ISBN) ON Authors.Au_ID = " & _
    "[Title Author].Au_ID WHERE Titles.PubID=" & pubID
    
    ' 打开记录集。如果为空则退出。
    With rsTitles
        .Open strQ, cn, adOpenStatic, adLockReadOnly, adCmdText
        If .BOF Then
            ' 如果为空，返回 false 并退出。
            GetTitles = False
            Exit Function
        End If
        .MoveLast
        .MoveFirst
        prgLoad.Max = .RecordCount + 1
    End With
    
    ' 显示进程栏
    prgLoad.Visible = True
    
    On Error GoTo childErr
    ' 添加第一个节点。
    AddNode newNode, ParentNode, rsTitles
    ' 添加相应的 ListItem 。
    AddListItem mItem, rsTitles
    
    rsTitles.MoveNext
    
    ' 遍历记录集中的剩余记录。如果下一个记录是
    ' 一个副本，那么仅添加作者名称。
    ' 否则, 添加新的 Node 及 ListItem。
    Do Until rsTitles.EOF
        intCounter = intCounter + 1 ' 作用于进程栏。
        prgLoad.Value = intCounter  ' 更新进程。

        ' 监察对应于当前 ISDN 的 Key 。 如果它们相同
        ' 那么此记录仅仅因包含不同的作者而不同。
        ' 那么添加作者到当前列表。
        If newNode.Key = rsTitles!ISBN Then
            ' 添加作者到作者列表。
            mItem.ListSubItems("author").Text = _
            mItem.ListSubItems("author").Text & _
            " & " & rsTitles!author
        Else ' 添加新的 Node 和 ListItem
            AddNode newNode, ParentNode, rsTitles
            AddListItem mItem, rsTitles
        End If
        rsTitles.MoveNext
    Loop
    GetTitles = True ' 如果成功则返回 true 
    
    prgLoad.Visible = False
    mCurrentIndex = pubID
    Exit Function
childErr:
        Debug.Print Err.Number, Err.Description
        
        Debug.Print rsTitles!ISBN
        Resume Next
    
    Exit Function
End Function
Private Sub AddNode(ByRef newNode As node, ByRef ParentNode As node, ByRef rs As ADODB.Recordset)
    ' 添加新的节点。newNode 和 ParentNode 都是需要的。
    Set newNode = tvwDB.Nodes.Add(ParentNode, _
    tvwChild, rs!ISBN, rs!TITLE, "smlBook")
    newNode.Tag = "book"
End Sub
Private Sub AddListItem(ByRef xItem As ListItem, ByRef xRec As ADODB.Recordset)
    ' 添加 ListItem 设置它的文本, 图标及小图标。然后
    ' 添加三个 ListSubItems 为它们设置 Key 及 Text 。
    Set xItem = lvwDB.ListItems.Add(Key:=xRec!ISBN, _
    Text:=xRec!TITLE, Icon:="book", SmallIcon:="smlBook")

    xItem.ListSubItems.Add Key:="author", Text:=xRec!author
    If Not IsNull(xRec![Year Published]) Then
        xItem.ListSubItems.Add Key:="year", Text:=xRec![Year Published]
    End If
    xItem.ListSubItems.Add Key:="isbn", Text:=xRec!ISBN
End Sub

Private Sub tvwDB_NodeClick(ByVal node As node)
    ' 为 "Publisher" 和 EventFlag 变量检查标志
    ' 看看是否 ColumnHeaders 已经被创建。
    ' 如果没有创建，那么激活 MakeColumns 过程。
    If node.Tag = "Publisher" And EventFlag <> _
    PUBLISHER Then MakeColumns
    ' 如果标志为 "Publisher" 并且 mItemCurrentIndex
    ' 索引与 Node.key 不相同, 那么
    ' 激活 GetTitles 函数, 它将组织 Node 。
    If node.Tag = "Publisher" And mCurrentIndex <> Val(node.Key) _
    Then GetTitles node, Val(node.Key)
    
    If node.Tag = "Publisher" Then PopStatus node
    node.Sorted = True
        
    ' 如果节点的标志是 "book" 那么确定通过使用 EnsureVisible 
    ' 方法使点击的书目在 ListView 中是可见的
    If node.Tag = "book" Then
        Dim liBook As ListItem
        Set liBook = lvwDB.FindItem(node.Text)
        liBook.EnsureVisible
    End If
    
End Sub
 
Private Sub PopStatus(node As node)
    ' 只需更改状态栏来反映当前的值。
    With sbrDB
        .Panels.Clear
        .Panels.Add , "name", node.Text
        .Panels.Add , "number", node.Children & " titles"
        .Panels(1).AutoSize = sbrContents
        .Panels(2).AutoSize = sbrSpring
    End With
End Sub