mdltreeview.bas

<Visual Basic 数据库开发实例精粹（第二版）>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术

Attribute VB_Name = "mdlTreeView"
Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'将对象加入控件的所有函数

'将所有客户类型加入树型图
Public Sub TypeToTreeview(ByRef tvw As TreeView)
  Dim objTypes As New CTypes
  Dim i As Long
  
  '先加入没有上级客户类型的客户类型
  objTypes.Find , 0
  Dim Nd As Node
  '加入原始根节点。“O0”中，第一个为字母O，第二个为数字0
  Set Nd = tvw.Nodes.Add(, , "O0", "所有客户", "group2")
  Nd.Expanded = True
  Nd.Selected = True
  
  For i = 1 To objTypes.Count
    '加入没有上级客户类型的客户类型节点，图形列表ID为“D”
    Set Nd = tvw.Nodes.Add("O0", tvwChild, "A" & objTypes.Item(i).ID, _
                          objTypes.Item(i).TypeName, "group")
    Nd.Expanded = True
    '加载其下级客户类型节点
    LoadSubNodes tvw, Nd, objTypes.Item(i).ID
  Next i
End Sub

'调用递归，显示树型的客户类型结构
Private Sub LoadSubNodes(ByRef tvw As TreeView, Nd As Node, NodeID As Long)
  Dim Nd1 As Node
  Dim objTypes As New CTypes
  Dim i As Long
  objTypes.Find , NodeID      '找到客户类型的所有子客户类型
  For i = 1 To objTypes.Count
    Set Nd1 = tvw.Nodes.Add(Nd, tvwChild, "A" & objTypes.Item(i).ID, _
                            objTypes.Item(i).TypeName, "group")
    Nd1.Expanded = True
    '递归加载下级客户类型.....
    LoadSubNodes tvw, Nd1, objTypes.Item(i).ID
  Next i
End Sub

'将人员加入到树型图，树型图中已有客户类型节点
Public Sub ClientToTreeview(ByRef tvw As TreeView)
  On Error Resume Next '该代码为了防止错误而加入，实际编程中需要做判断，本处为了说明问题。
  Dim objClients As New CClients
  objClients.Find '找到所有的人员
  Dim i As Long
  For i = 1 To objClients.Count
    AddClientToTvw objClients.Item(i), tvw
  Next i
End Sub

'本来ClientToTreeview一个函数就可以完成“加入人员到树型图”，但
'考虑到在单独新增人员时需用到下面的函数，因此将下面的代码单独提取
'出来，做了一个单独的函数。（详见后面的代码）
'将一个人员加入到树型图中，显示到相应的客户类型下面
Public Sub AddClientToTvw(ByVal objClient As CClient, ByRef tvw As TreeView)
'  On Error Resume Next
  Dim ct As String
  If objClient.Sex = Male Then
    ct = "boy"
  Else
    ct = "girl"
  End If
  
  tvw.Nodes.Add "A" & objClient.TypeId, tvwChild, "B" & objClient.ID, objClient.Name, ct
  
End Sub

'将一个客户类型加入到树型图中
Public Sub AddTypeToTvw(ByVal objType As CType, ByRef tvw As TreeView)
  On Error Resume Next
  If objType.SuperId = 0 Then
    '“O0”中，第一个为字母O，第二个为数字0
    tvw.Nodes.Add "O0", tvwChild, "A" & objType.ID, objType.TypeName, "group"
  Else
    tvw.Nodes.Add "A" & objType.SuperId, tvwChild, "A" & objType.ID, _
                  objType.TypeName, "group"
  End If
End Sub
'

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'从树型图中得到客户类型对象
Public Function GetTypeFromTreeview(ByVal tvw As TreeView, _
                                    ByRef objType As CType) As Boolean
  If tvw.SelectedItem Is Nothing Then Exit Function

  Dim objTypes As New CTypes
  '按选择的节点的KEY查找对象
  If objTypes.Find(GetID(tvw.SelectedItem.Key)).Count = 0 Then Exit Function
  On Error Resume Next '为了防止未查找到，因此加入了错误判断语句
  Set objType = objTypes.Item(1)
  GetTypeFromTreeview = (Err.Number = 0)
End Function
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)

End Sub

'得到某个节点或列表项所表示的对象的实际ID，如“A11”，则得到11，“B2”，则得到2
Public Function GetID(strKey As String) As Long
  GetID = Val(Right(strKey, Len(strKey) - 1))
End Function
'
Private Sub RefreshButton()
  '刷新界面上的六个按钮。
  '为什么要这样做呢？比如：
  '你现在选择了一个“人员”节点，此时你可以点击“修改人员”按钮。
  '但如果你将这个人员删除，此时树型图中已没有这个人员节点，而被
  '选择的可能是一个客户类型节点，此时你的“修改人员”按钮应变为不可用
  '状态。因此每当删除人员或客户类型后，都应调用这个函数
'  If tvTreeView.SelectedItem Is Nothing Then Exit Sub
'  tvTreeView_NodeClick tvTreeView.SelectedItem
End Sub