加载整盘目录到TreeView,注意逐层展开

''''shuwork 自Programming Microsoft Visual Basic 6.0 收藏

Option Explicit

'''' True if Cancel was pressed to close this form
Public CancelPressed As Boolean

Private m_Path As String

'''' this is used by many routines in the module
Dim FSO As New Scripting.FileSystemObject

Private Sub Form_Load()
    '''' build the subdirectory tree
    DirRefresh
End Sub

Private Sub Form_Resize()
    '''' the distance among controls
    Const DISTANCE = 100
    Dim tvwTop As Single
   
    '''' move the buttons and the label
    lblPath.Move DISTANCE, 0, ScaleWidth, lblPath.Height
    cmdOK.Move ScaleWidth / 2 - DISTANCE - cmdOK.Width, ScaleHeight - DISTANCE - cmdOK.Height
    cmdCancel.Move ScaleWidth / 2 + DISTANCE, cmdOK.Top
    '''' resize the treeview control
    '''' the Top position depends on the visibility of the lblPath label
    If lblPath.Visible Then
        tvwTop = lblPath.Top + lblPath.Height
    Else
        tvwTop = DISTANCE
    End If
    tvwDir.Move DISTANCE, tvwTop, ScaleWidth - DISTANCE * 2, ScaleHeight - tvwTop - cmdOK.Height - DISTANCE * 2
End Sub

Private Sub DirRefresh()
    '''' build the treeview control
    Dim dr As Scripting.Drive
    Dim rootNode As node, nd As node
   
    On Error Resume Next
   
    '''' add the "My Computer" root (expanded)
    Set rootNode = tvwDir.Nodes.Add(, , "\\MyComputer", "My Computer", 1)
    rootNode.Expanded = True
   
    '''' add all the drives, with a plus sign
    For Each dr In FSO.Drives
        If dr.Path <> "A:" Then
        Err.Clear
        Set nd = tvwDir.Nodes.Add(rootNode.Key, tvwChild, dr.Path & "\", dr.Path & " " & dr.VolumeName, 2)
        If Err = 0 Then AddDummyChild nd
        End If
    Next
   
End Sub

Sub AddDummyChild(nd As node)
    '''' add a dummy child node, if necessary
    If nd.Children = 0 Then
        '''' dummy nodes'''' Text property is "***"
        tvwDir.Nodes.Add nd.Index, tvwChild, , "***"
    End If
End Sub

Private Sub tvwDir_Click()
    m_Path = tvwDir.SelectedItem.Key
    lblPath.Caption = tvwDir.SelectedItem.Key
End Sub

Private Sub tvwDir_Expand(ByVal node As ComctlLib.node)
    '''' a node if being expanded
    Dim nd As node
    '''' exit if the node had been already expanded in the past
    If node.Children = 0 Or node.Children > 1 Then Exit Sub
    '''' also exit if it doesn''''t have a dummy child node
    If node.Child.Text <> "***" Then Exit Sub
    '''' remove the dummy child item
    tvwDir.Nodes.Remove node.Child.Index
    '''' add all the subdirs of this Node object
    AddSubdirs node
End Sub

Private Sub AddSubdirs(ByVal node As ComctlLib.node)
    '''' add all the subdirs under a node
    Dim fld As Scripting.Folder
    Dim nd As node

    '''' the path in the node is hold in its key property
    '''' cycle on all its subdirectories
    For Each fld In FSO.GetFolder(node.Key).SubFolders
        Set nd = tvwDir.Nodes.Add(node, tvwChild, fld.Path, fld.Name, 3)
        nd.ExpandedImage = 4
        '''' if this directory has subfolders, add a "+" sign
        If fld.SubFolders.Count Then AddDummyChild nd
    Next
End Sub

Private Sub cmdOK_Click()
    Unload Me
End Sub

Private Sub cmdCancel_Click()
    CancelPressed = True
    Unload Me
End Sub

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18