Private Sub form_load()
With Toolbar1
.AllowCustomize = False '双击不显示工具栏
.Style = tbrFlat
.ImageList = Ils_Command '连接的图标
.TextAlignment = tbrTextAlignBottom '图标显示的方式
End With
With Toolbar1.Buttons
.Add(1, , "").Style = tbrPlaceholder
.Add(2, , , , 1).Caption = "添加类别"
.Add(3, , , , 6).Caption = "修改类别"
.Add(4, , , , 4).Caption = "删除类别"
.Add(5, , "").Style = tbrPlaceholder
.Add(6, , , , 3).Caption = "添加子类"
.Add(7, , , , 8).Caption = "修改子类"
.Add(8, , , , 7).Caption = "删除子类"
.Add(9, , "").Style = tbrPlaceholder
.Add(10, , , , 2).Caption = "添加代码"
.Add(11, , , , 5).Caption = "删除代码"
End With
With Lsv_Code_Info
.Font = "Tahoma"
.View = lvwReport
.GridLines = True
.FullRowSelect = True
.LabelEdit = tvwManual '首列内容不可修改
.ColumnHeaderIcons = Ils_Command '行首关联图标
.SmallIcons = Ils_Command '列标头关联图标
.ColumnHeaders.Add , , "代码编码", 1500, , 2
.ColumnHeaders.Add , , "代码标题", 3000, , 2
.ListItems.Add , , "123456789", , 3
.ListItems(1).SubItems(1) = "阿拉伯数字"
End With
'提取分类信息
If GetClassInfo(Trv_Code_Class) Then
Trv_Code_Class.Nodes.Item(1).Expanded = True
End If
End Sub

Public Function GetClassInfo(ByVal Trv As TreeView, Optional ByVal sTitle As String = "代码管理系统") As Boolean

Dim ADO_Rset As New ADODB.Recordset
Dim CONN_STRING As String
Dim sKey As String

CONN_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=DATABASE_NAME"

On Error GoTo GetClassInfoErr

With ADO_Rset
.ActiveConnection = CONN_STRING
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockReadOnly

.Source = "Select Class_ID,Class_Name from Class_Info"
.Open

sKey = "daphacode_"
'增加根
Trv.Nodes.Clear
Trv.Nodes.Add , , sKey, sTitle, 1

If .EOF Or .BOF Then

Else
.MoveFirst
'开始增加大类
Do While (Not .EOF And Not .BOF)
Trv.Nodes.Add sKey, 4, "Class_" & .Fields(0).Value, .Fields(1).Value, 2
.MoveNext
Loop
.Close

.Source = "Select Class_ID,SmallClass_ID,SmallClass_Name,Code_Num from SmallClass_Info order by Class_ID"
.Open

If .EOF Or .BOF Then

Else
.MoveFirst
'开始增加子类
Do While (Not .EOF And Not .BOF)
Trv.Nodes.Add "Class_" & .Fields(0).Value, 4, "SmallClass_" & .Fields(1).Value, _
.Fields(2).Value & "[" & .Fields(3).Value & "]", 3
.MoveNext
Loop
End If
.Close
End If
End With
Set ADO_Rset = Nothing
GetClassInfo = True
Exit Function

GetClassInfoErr:
GetClassInfo = False
If Err.Number = -2147217865 Then
MsgBox "数据库不正确!请重新设置", vbQuestion
Err.Clear
End If
End Function

[此贴子已经被作者于2007-10-26 9:31:20编辑过]