Dim nodx As Node
Private Sub Form_Load()
'在 ImageList 控件中添加一个图象。
Dim imgX As ListImage
' TreeView1.ImageList = ImageList1 '初始化ImageList。
Set imgX = ImageList1.ListImages.Add(, , _
LoadPicture("c:\my documents\072.bmp"))
TreeView1.ImageList = ImageList1 '初始化ImageList。
TreeView1.LineStyle = tvwRootLines
TreeView1.Style = tvwTreelinesPlusMinusPictureText
Dim DriverCount As Integer
Dim GivePath As String
On Error Resume Next
'创建根节点
Set nodx = TreeView1.Nodes.Add(, , "本人电脑", "本人电脑", 1)
For DriverCount = 0 To Drive1.ListCount - 1
Set nodx = TreeView1.Nodes.Add("本人电脑", tvwChild, _
Drive1.List(DriverCount) + "\", _
Drive1.List(DriverCount), 1)
GivePath = Drive1.List(DriverCount) + "\"
Call SSplitNode(GivePath)
Next DriverCount
End Sub
Sub SSplitNode(GivePath As String) ‘子过程
'把给定目录下的子目录全部加入Node对象中
Dim SDI As Integer
Dim SDCount As Integer
Dim DString(1000) As String
‘以下为展开给定目录的下级子目录
Dir1.Path = GivePath ‘给定目录
SDCount = Dir1.ListCount ‘利用Dir1控件判断是否有下级目录
If SDCount = 0 Then Exit Sub
‘如无同退出子程序,即为递归出口。否则会形成死循环。
For SDI = 0 To SDCount - 1
DString(SDI) = Dir1.List(SDI)
Set nodx = TreeView1.Nodes.Add(GivePath, tvwChild, _
DString(SDI), FOnlyPath(DString(SDI)), 1)
Next SDI
‘调用递归(子程序自己调用自己)
For SDI = 0 To SDCount - 1
Call SSplitNode(DString(SDI))
Next SDI
End Sub
Function FOnlyPath(DString As String) As String
'功能是去掉上级目录，只留下当前目录名
'DString为给定的全路径目录名
If DString = "" Then Exit Function
Dim DLength As Integer
DLength = Len(DString)
Dim DD As Integer
For DD = DLength To 1 Step -1
If Mid(DString, DD, 1) = "\" Then Exit For
Next DD
FOnlyPath = Mid(DString, DD + 1)
End Function |
