ctreeopt.cls

来自「系统功能设计 试卷生成系统是为了对试卷生成实行计算机化的管理」· CLS 代码 · 共 63 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CTreeOpt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_TreeView As TreeView

Public Sub CreateTreeView(aTreeView As Object)
    Set m_TreeView = aTreeView
End Sub

'添加数据到TREEVIEW控件
Public Sub AddTree(rs As Recordset, aID As String, aContext As String, aParentID As String)
    Dim Xnod As Node
    
    Do While Not rs.EOF
        If rs.Fields(aParentID) = 0 Then
            '加入根结点
            Set Xnod = m_TreeView.Nodes.Add(, , "key" & rs.Fields(aID), rs.Fields(aContext), 2)
        Else
            '加入子节点
            Set Xnod = m_TreeView.Nodes.Add("key" & rs.Fields(aParentID), tvwChild, "key" & rs.Fields(aID), rs.Fields(aContext), 1)
        End If
        Xnod.EnsureVisible
        rs.MoveNext
    Loop
End Sub

'取得所有子结点的关键字
Public Function GetSubNodeKey(aNode As Node) As String
    Dim StrWhere As String
    
    GetSubKey aNode, StrWhere
    If Len(StrWhere) > 0 Then
        GetSubNodeKey = "ID = " & Mid(aNode.Key, 4) & " OR " & Left(StrWhere, Len(StrWhere) - 4)
    Else
        GetSubNodeKey = "ID = " & Mid(aNode.Key, 4)
    End If
End Function

Public Sub GetSubKey(aNode As Node, aStrWhere As String)
    Dim NodeSub As Node

    Set NodeSub = aNode.Child
    While Not NodeSub Is Nothing
        aStrWhere = aStrWhere & "ID = " & Mid(NodeSub.Key, 4) & " OR "
        If NodeSub.Children > 0 Then GetSubKey NodeSub, aStrWhere
        
        Set NodeSub = NodeSub.Next
    Wend
End Sub