如何正确显示树型结构?

Question

数据库里的表如下: 
                      科目编码             名称                 上级科目编码 
                            a1                     aa                       R 
                        a2                     bb                       R 
                        a3                     cc                       a1 
                        a4                     dd                       a1 
                        a5                     ee                       a3 
                        a6                     ff                       a5 
                        ...... 
                  也许子节点下面还有子节点,也许没有,怎么样用treeview控件循环显示出正确数据? 

Answer 1

Public Sub tree_change()  '定义添加树状列表的函数
  Dim key As String, text As String  'String 为字符型。
  Dim Node1 As Node, Node2 As Node, Node3 As Node  '定义一个节点变量。
  Adodc1.RecordSource = "select * from spzl where lbbs='是' order by lbbh asc"     '返回一个记录集的查询。
  Adodc1.Refresh
  'Refresh 方法(ADO)：更新集合中的对象以便反映来自并特定于提供者的对象。Refresh 方法根据从中调用的不同集合而完成不同的任务。
  TreeView1.Nodes.Clear  '使TreeView控件里面的内容清空。不先清空的话，第2遍执行以下代码时就会警告“集合中的关键字不唯一”。
  If Adodc1.Recordset.RecordCount > 0 Then       'RecordCount 属性(ADO)：指示 Recordset 对象中记录的当前数目。返回长整型值。
     Adodc1.Recordset.MoveFirst      '使用 MoveFirst 方法将当前记录位置移动到 Recordset 中的第一个记录。
     Do While Adodc1.Recordset.EOF = False
     '如果当前记录位于 Recordset 对象的最后一个记录之后，EOF 属性将返回 True，而当前记录为 Recordset 对象的最后一个记录或位于其前，则将返回 False。
        If Len(Trim(Adodc1.Recordset.Fields("lbbh"))) = 2 Then  '类别编号
        'Len 函数：返回 Long 长整型，其中包含字符串内字符的数目，或是存储一变量所需的字节数。
        'LTrim、RTrim与Trim函数：返回Variant变体型(String字符型)，其中包含指定字符串的拷贝，没有前导空白(LTrim)、尾随空白(RTrim)或前导和尾随空白(Trim)。
        'Fields 集合(ADO)：Fields 集合包含 Recordset 对象的所有 Field 对象。每个 Field 对象对应 Recordset 中的一列。
           key = "ID" & Trim(Adodc1.Recordset.Fields("spzlID"))  '商品资料ID
           text = Trim(Adodc1.Recordset.Fields("lbbh")) & " " & Trim(Adodc1.Recordset.Fields("mc"))  '类别编号,名称
           '& 运算符：用来强制两个表达式作字符串连接。str(
               '语法：result = expression1 & expression2
               'result 部分：必需的；任何 String字符型 或 Variant变体型 变量。expression1与expression2部分：必需的；任何表达式。
           Set Node1 = TreeView1.Nodes.Add(, , key, text, 1, 2) 'Key值不能用数字开头，不然会弹出警告“无效的关键字”。
           'Set 语句：将对象引用赋给变量或属性。
 'Add 方法（Nodes 集合）：在 Treeview 控件的 Nodes 集合中添加一个 Node 对象。
     '语法：object.Add(relative, relationship, key, text, image, selectedimage)
          'object：必需的。对象表达式，其值是“应用于”列表中的一个对象。
          'relative：可选的。已存在的 Node 对象的索引号或键值。新节点与已存在的节点间的关系，可在下一个参数 relationship 中找到。
          'relationship：可选的。指定的 Node 对象的相对位置，如设置值中所述。
          'key：可选的。唯一的字符串，可用于用 Item 方法检索 Node。
          'text：必需的。在 Node 中出现的字符串。
          'image：可选的。在关联的 ImageList 控件中的图像的索引。
          'selectedimage：可选的。在关联的 ImageList 控件中的图像的索引，在 Node 被选中时显示。
        End If
        If Len(Trim(Adodc1.Recordset.Fields("lbbh"))) = 4 Then
           key = "ID" & Trim(Adodc1.Recordset.Fields("spzlID"))
           text = Trim(Adodc1.Recordset.Fields("lbbh")) & " " & Trim(Adodc1.Recordset.Fields("mc"))
           Set Node2 = TreeView1.Nodes.Add(Node1.Index, tvwChild, key, text, 1, 2)
           'Index 属性（Split 对象）：返回对选定拆分的索引。
           'tvwChild 常数：（缺省）子节点。该 Node 成为在 relative 中被命名的节点的子节点。
        End If
        If Len(Trim(Adodc1.Recordset.Fields("lbbh"))) = 6 Then
           key = "ID" & Trim(Adodc1.Recordset.Fields("spzlID"))
           text = Trim(Adodc1.Recordset.Fields("lbbh")) & " " & Trim(Adodc1.Recordset.Fields("mc"))
           Set Node3 = TreeView1.Nodes.Add(Node2.Index, tvwChild, key, text, 1, 2)
        End If
        Adodc1.Recordset.MoveNext
     Loop
  End If
End Sub

Answer 2

正在学习用treeview，发个正在做的代码，应该有用。
Private Sub Form_Load()
  Call LoadTree
End Sub
Private Function Readtext(ByVal TxtFile As String) As String
    Dim txtstr As String
  Open TxtFile For Input As #1
  Dim txttemp As String
  txtstr = ""
  Do While Not EOF(1)   ' 循环至文件尾。
    Line Input #1, txttemp  ' 将数据读入变量。
    txtstr = txtstr & txttemp & Chr(13) & Chr(10)
  Loop
  Close #1
  Readtext = txtstr
End Function
Private Sub LoadTree()
    Dim myNod As Node
    Dim aaa As String
    Dim i, j, k As Integer
    Dim arrayTemp() As String
    Dim arraystr() As String
    TreeView1.Nodes.Clear
    Set myNod = TreeView1.Nodes.Add(, , "tuopu", "网络拓扑图")
    aaa = Readtext("LoadtreeV.txt")
    arrayTemp = Split(aaa, vbCrLf)
    i = UBound(arrayTemp) - 1
    For j = 0 To i
        arraystr = Split(arrayTemp(j), "|")
        Set myNod = TreeView1.Nodes.Add(arraystr(0), tvwChild, arraystr(1), arraystr(2))
    Next j
    TreeView1.Nodes(1).Expanded = True
End Sub
LoadtreeV.txt文本文件内容:
a1|aa|R   
a2|bb|R   
a3|cc|a1   
a4|dd|a1   
a5|ee|a3   
a6|ff|a5  

Answer 3

完整示例代码'类clsSubject代码
Private m_ParentSubject As clsSubject
Private m_SubjectID As String
Private m_SubjectName As String
Public Property Get ParentSubject() As clsSubject
    Set ParentSubject = m_ParentSubject
End PropertyPublic Property Let ParentSubject(ByVal value As clsSubject)
    
    Set m_ParentSubject = value
End Property
Public Property Get SubjectID() As String
    SubjectID = m_SubjectID
End PropertyPublic Property Let SubjectID(ByVal value As String)
     m_SubjectID = value
End Property
Public Property Get SubjectName() As String
    SubjectName = m_SubjectName
End PropertyPublic Property Let SubjectName(ByVal value As String)
     m_SubjectName = value
End Property

Answer 4

'集合类clsSubjects，注意NewEnum的过程标识符须设置成-4
Option Explicit
Private m_Collection As Collection
Public Function Add(ByVal id As String, ByVal name As String, ByVal parent As clsSubject) As clsSubject    Dim tempSubject As New clsSubject
    On Error GoTo ObjectErr
    If Trim(name) = "" Or Trim(id) = "" Then
        Set Add = Nothing
        Exit Function
    End If
    '增加新的Subject
    tempSubject.SubjectID = id
    tempSubject.SubjectName = name
    tempSubject.ParentSubject = parent
    m_Collection.Add tempSubject, id
    
    Set Add = tempSubject
    Exit Function
ObjectErr:
    Set Add = Nothing
End Function
Public Property Get Count() As Long
   Count = m_Collection.Count
End Property
Public Sub Clear()
    Dim i As Integer
    For i = 1 To m_Collection.Count
        m_Collection.Remove i
    Next
End Sub
Public Sub Remove(ByVal Index As Variant)
    On Error Resume Next
    m_Collection.Remove Index
End Sub
Public Property Get Item(ByVal Index As Variant) As clsSubject
    On Error GoTo ItemErr
   Set Item = m_Collection.Item(Index)
   Exit Property
ItemErr:
   Set Item = Nothing
End Property
Public Property Get NewEnum() As IUnknown
    Set NewEnum = m_Collection.[_NewEnum]
End PropertyPrivate Sub Class_Initialize()
    Set m_Collection = New Collection
End SubPrivate Sub Class_Terminate()
    Set m_Collection = Nothing
End Sub

Answer 5

'窗体代码Dim mSubjects As clsSubjectsPrivate Sub Command1_Click()
'显示树
        
 Dim tempSubject As clsSubject
 
 If mSubjects.Count <> 0 Then
 
 TreeView1.Nodes.Clear
 
 For Each tempSubject In mSubjects
    
    Call AddSubjectToTree(tempSubject)
 Next
 
End If
End SubPrivate Function AddSubjectToTree(ByVal subject As clsSubject) As Node    '判断是否已添加
    
    Dim nd As Node
    On Error Resume Next
    Set nd = TreeView1.Nodes.Item(subject.SubjectID)
    If nd Is Nothing Then
        '判断是否有父科目
        If Not (subject.ParentSubject Is Nothing) Then
            
            Set nd = AddSubjectToTree(subject.ParentSubject) '递归调用添加父目录
            Set nd = TreeView1.Nodes.Add(nd.Key, tvwChild, subject.SubjectID, subject.SubjectName)
        Else
            Set nd = TreeView1.Nodes.Add(, , subject.SubjectID, subject.SubjectName)
        End If
    End If
     Set AddSubjectToTree = nd
End Function
Private Sub Form_Load()
    
    Set mSubjects = New clsSubjects
    
'
'a1       aa         R
'a2       bb         R
'a3       cc         a1
'a4       dd         a1
'a5       ee         a3
'a6       ff         a5'添加科目mSubjects.Add "a1", "aa", Nothing
mSubjects.Add "a2", "bb", Nothing
mSubjects.Add "a3", "cc", mSubjects("a1")
mSubjects.Add "a4", "dd", mSubjects("a1")
mSubjects.Add "a5", "ee", mSubjects("a3")
mSubjects.Add "a6", "ff", mSubjects("a5")
End Sub