Tree controls are used in most systems. With distinctive levels, the advantages of easy operation are recognized by the majority of programmers and users. However, although the tree control operation is relatively simple, the operation will have trouble when combined with the database.
The author writes the code summed up in the actual application process, and the class can be used directly when used.
The program source code can go to the people's website to download: http://www.j2soft.cn/
Author: Cui Zhanmin
Email: cuizm@163.com
code show as below:
First, select the menu -> Project -> Add Class Module, enter the following code:
Option expedition
Private M_TreeView as treeView
Public Sub CreateTreeView (atreeView as object) set m_treeview = atreeViewend Sub
'Add Data to TreeView Control 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' Join root knots Point set xnot = m_treeview.nodes.add (, "key" & rs.fields (aid), rs.fields (acontext), 2) Else 'joining child node 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 Loopend Sub
'Get all child nodes keyword 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 - 4) Else getSubnodeKey = "id =" & mid (anode.key, 4) End ifend function
Public Sub getSubkey (anode as node, astring) 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 WendEnd Sub Add a window to add a menu for the window, the menu items are: added, modified, deleted. The menu name is: Mnuadd, Mnumodify, Mnudelete.
Add a TreeView control in the window.
The window code is as follows:
Option expedition
'Project ---> Quote ---> Microsoft ActiveX Data Object 2.x Library (version number)
DIM CN As Adodb.ConnectionDim M_Boladdflag As Booleandim M_STRKEY AS STRING, M_STRPARENTKEY AS STRINGDIM 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 = Nothingend Sub
Private Sub Form_Load () on error goto errhandle set cn = new adodb.connection 'connection database 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 SubErrhandle: MsgBox Err.Description, vbExclamationEnd Sub
Private Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer) On Error Resume Next cn.Close Set cn = Nothing Set m_TreeOpt = NothingEnd Sub 'add nodes Private Sub mnuAdd_Click () Dim rs As New ADODB.Recordset m_bolAddFlag = True If rs. State = adservationenin "SELECT IIF (ISNULL (ID)), 1, Max (ID)) AS ID_M from TBTree", CN, AdopenStatic, AdlickReadonly if xi = "1" Else M_StrKey = CSTR (RS! ID_M 1) end if with treey = .selectedItem.key .nodes.add (m_strparentKey, TVWchild, "Key" & m_strkey, "new junction", 1) .selected = true. Startlabeledit End with rs.close set = nothingend sub
'Delete node Private Sub mnuDelete_Click () Dim StrWhere As String With TreeView1 If .SelectedItem.Key = "key1" Then MsgBox "Sorry, could not delete the root point!", VbExclamation Exit Sub End If StrWhere = m_TreeOpt.GetSubNodeKey (.SelectedItem) Cn.execute "delete from tbtree where" & strwhere .nodes.remove .selecteditedItem.key End Withend Sub
'Modify Node Private Sub MnumodiFy_Click () m_boladdflag = false with treeview1 m_strkey = mid (.selectedItem.key, 4) .startlabeledit End Withend Sub
Private Sub TreeView1_afterlabeledit (Cancel As Integer, Newstring) Cn.execute "Update TBTree Set Context = '" & Newstring & "' Where id =" & m_strkeynd 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 & ", 'new add node' , "& m_strParentKey &") "cn.Execute strSql End IfEnd SubPrivate Sub TreeView1_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbRightButton Then PopupMenu mnuPopupEnd Sub
The category provides a way to display data in the database in the control. Delete the node and the method of all the sub-nodes thereof. You can also make the class into a DLL, and you can load the DLL directly in future applications.
