?? mdltreeview.bas
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -