树形控件在大多数的系统中都会使用到。以其层次鲜明，操作简便的优点得到广大程序员以及使用人员的认可。不过，尽管树形控件操作比较简单，但是当与数据库结合的时候，操作会有一引起麻烦。
笔者将自己在实际应用过程中总结出来的代码编写成类，在以后使用的时候直接使用类就可以了。
作者：崔占民
EMAIL:CUIZM@163.COM
代码如下：
首先，选择菜单－＞工程－＞添加类模块，输入以下代码：
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
添加一窗口，为窗口添加一菜单，菜单项分别为：添加、修改、删除。菜单名分别为：mnuAdd、mnuModify、mnuDelete。
在窗口中添加一个TREEVIEW控件。
窗口代码如下：
Option Explicit
'工程--->引用--->Microsoft ActiveX Data Object 2.x Library（版本号）
Dim cn As ADODB.Connection
Dim m_bolAddFlag As Boolean
Dim m_strKey As String, m_strParentKey As String
Dim m_TreeOpt As New CTreeOpt
Private Sub Command1_Click()
Dim rs As New ADODB.Recordset
TreeView1.Nodes.Clear
rs.Open "SELECT * FROM tbTree", cn, adOpenDynamic, adLockReadOnly
m_TreeOpt.AddTree rs, "ID", "CONTEXT", "PARENTID"
rs.Close
Set rs = Nothing
End Sub
Private Sub Form_Load()
On Error GoTo Errhandle
Set cn = New ADODB.Connection
'连接数据库
cn.ConnectionString = "DBQ=" & App.Path & "\db1.mdb;DefaultDir=" & _
App.Path & ";Driver={Microsoft Access Driver (*.mdb)};" & _
"DriverId=25;FIL=MS Access;ImplicitCommitSync=Yes;" & _
"MaxBufferSize=512;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;" & _
"Threads=3;UID=ADMIN;UserCommitSync=Yes;PWD=admind1234;"
cn.Open
m_TreeOpt.CreateTreeView TreeView1
Command1.Value = True
Exit Sub
Errhandle:
MsgBox Err.Description, vbExclamation
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
cn.Close
Set cn = Nothing
Set m_TreeOpt = Nothing
End Sub
'添加结点
Private Sub mnuAdd_Click()
Dim rs As New ADODB.Recordset
m_bolAddFlag = True
If rs.State = adStateOpen Then rs.Close
rs.Open "SELECT IIF (ISNULL (MAX(ID)), 1, MAX(ID)) AS ID_M FROM tbTree", cn, adOpenStatic, adLockReadOnly
If rs.EOF Then
m_strKey = "1"
Else
m_strKey = CStr(rs!ID_M + 1)
End If
With TreeView1
m_strParentKey = .SelectedItem.Key
.Nodes.Add(m_strParentKey, tvwChild, "key" & m_strKey, "新加结点", 1).Selected = True
.StartLabelEdit
End With
rs.Close
Set rs = Nothing
End Sub
'删除结点
Private Sub mnuDelete_Click()
Dim StrWhere As String
With TreeView1
If .SelectedItem.Key = "key1" Then
MsgBox "对不起,不能删除根点!", vbExclamation
Exit Sub
End If
StrWhere = m_TreeOpt.GetSubNodeKey(.SelectedItem)
cn.Execute "DELETE FROM tbTree WHERE " & StrWhere
.Nodes.Remove .SelectedItem.Key
End With
End Sub
'修改结点
Private Sub mnuModify_Click()
m_bolAddFlag = False
With TreeView1
m_strKey = Mid(.SelectedItem.Key, 4)
.StartLabelEdit
End With
End Sub
Private Sub TreeView1_AfterLabelEdit(Cancel As Integer, NewString As String)
cn.Execute "UPDATE tbTree SET CONTEXT = '" & NewString & "' WHERE ID = " & m_strKey
End Sub
Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
If m_bolAddFlag Then
Dim strSql As String
m_strParentKey = Mid(m_strParentKey, 4)
strSql = "INSERT INTO tbTree (ID, CONTEXT, PARENTID) VALUES (" & m_strKey & ", '新加结点', " & m_strParentKey & ")"
cn.Execute strSql
End If
End Sub
Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then PopupMenu mnuPopup
End Sub
类里提供了将数据库中的数据显示在控件中的方法。删除结点及其下面所有子结点的方法。也可以将类做成DLL，在以后的应用中直接加载DLL就可以了。
