'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