树形控件在大多数的系统中都会使用到。以其层次鲜明,操作简便的优点得到广大程序员以及使用人员的认可。不过,尽管树形控件操作比较简单,但是当与数据库结合的时候,操作会有一引起麻烦。
笔者将自己在实际应用过程中总结出来的代码编写成类,在以后使用的时候直接使用类就可以了。
作者:崔占民
EMAIL:[email protected]
代码如下:
首先,选择菜单->工程->添加类模块,输入以下代码:
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就可以了。 
|