📄 ctreeopt.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 = "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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -