form1.frm

vb控件vb控件vb控件vb控件vb控件vb控件vb控件

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "TreeView"
   ClientHeight    =   9915
   ClientLeft      =   45
   ClientTop       =   225
   ClientWidth     =   10695
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   9915
   ScaleWidth      =   10695
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "导出(&T)"
      Height          =   420
      Left            =   8355
      TabIndex        =   2
      Top             =   9360
      Width           =   2280
   End
   Begin VB.TextBox Text1 
      Height          =   9225
      Left            =   3615
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   1
      Text            =   "Form1.frx":0000
      Top             =   45
      Width           =   7020
   End
   Begin MSComctlLib.ImageList Imalist 
      Left            =   615
      Top             =   3960
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   16777215
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":0006
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":011A
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":056E
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":0682
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.TreeView trv 
      Height          =   9195
      Left            =   75
      TabIndex        =   0
      Top             =   60
      Width           =   3405
      _ExtentX        =   6006
      _ExtentY        =   16219
      _Version        =   393217
      Indentation     =   706
      Style           =   7
      ImageList       =   "Imalist"
      Appearance      =   1
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim FSO As New FileSystemObject

Private Sub DirRefresh()
    Dim dr As Scripting.Drive
    Dim rootNode As Node, nd As Node
    On Error Resume Next
    Set rootNode = trv.Nodes.Add(, , "\\MyComputer", "My Computer", 1)
    rootNode.Expanded = True
    For Each dr In FSO.Drives
        If dr.Path <> "A:" Then
            Err.Clear
            '添加磁盘驱动器节点
            Set nd = trv.Nodes.Add(rootNode.Key, tvwChild, dr.Path & "\", dr.Path & " " & dr.VolumeName, 2)
            If Err = 0 Then AddDummyChild nd
        End If
    Next
End Sub

Private Sub Command1_Click()
    Text1.Text = TreeViewToString(trv)
End Sub

Private Sub Form_Load()
    DirRefresh
End Sub

Sub AddDummyChild(nd As Node)

    ' 如果需要添加一个哑元子节点
    If nd.Children = 0 Then
    
        ' 哑元子节点的Text特性为"***"
        trv.Nodes.Add nd.Index, tvwChild, , "***"
    End If
End Sub

Private Sub trv_Expand(ByVal Node As MSComctlLib.Node)
    Dim fil As File
    For Each fil In FSO.GetFolder(Node.Key).Files
    Next
    If Node.Children = 0 Or Node.Children > 1 Then Exit Sub
    If Node.Child.Text <> "***" Then Exit Sub
    trv.Nodes.Remove Node.Child.Index
    Addsubdirs Node
End Sub

Private Sub Addsubdirs(ByVal Node As MSComctlLib.Node)
    Dim fld As Folder
    Dim nd As Node
    '搜索所有子目录，包括系统和隐藏子目录
    For Each fld In FSO.GetFolder(Node.Key).SubFolders
        Set nd = trv.Nodes.Add(Node, tvwChild, fld.Path, fld.Name, 3)
        nd.ExpandedImage = 4
        If fld.SubFolders.Count Then AddDummyChild nd
    Next
End Sub

Function TreeViewToString(Tv As TreeView, Optional StartNode As Node, Optional OnlyVisible As Boolean) As String
    Dim nd As Node, childNd As Node
    Dim res As String, i As Long
    Static Level As Integer
    If Tv.Nodes.Count = 0 Then Exit Function
    If StartNode Is Nothing Then
        Set nd = Tv.Nodes(1).Root.FirstSibling
    Else
        Set nd = StartNode
    End If
    res = String$(Level, vbTab) & nd.Text & vbCrLf
    If nd.Children And (nd.Expanded Or OnlyVisible = False) Then
        Level = Level + 1
        Set childNd = nd.Child
        For i = 1 To nd.Children
            res = res & TreeViewToString(Tv, childNd, OnlyVisible)
            Set childNd = childNd.Next
        Next
        Level = Level - 1
    End If
    If StartNode Is Nothing Then
        Set nd = nd.Next
        Do Until nd Is Nothing
            res = res & TreeViewToString(Tv, nd, OnlyVisible)
            Set nd = nd.Next
        Loop
    End If
    TreeViewToString = res
End Function