作者：未知 来源：月光软件站 加入时间：2005-2-28　月光软件站

'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

相关软件：