- 日時： 2010/01/10 13:12
- 名前： 魔界の仮面弁士
- ***********************************************************************************
* カテゴリー：[ツリービュー][ファイル][] *
* キーワード：全ファイル,サブフォルダー以下,,,, *
***********************************************************************************
列挙するフォルダ数が多いと、再帰検索に膨大な時間がかかるので、
サブフォルダの読み込み処理を遅延させることで、疑似的に高速化させてみました。
下記では、すべてのドライブを列挙してツリーを構築しています。
Option Explicit
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hWndLock As Long) As Long
Private FSO As Scripting.FileSystemObject
Private IncludFiles As Boolean
Private Sub Form_Initialize()
IncludFiles = True
Set FSO = New Scripting.FileSystemObject
End Sub
Private Sub Form_Load()
Command1.Caption = "表示"
TreeView1.Indentation = 360
TreeView1.LabelEdit = tvwManual
TreeView1.LineStyle = tvwRootLines
End Sub
Private Sub Command1_Click()
If MsgBox("ファイルを含めますか?", vbQuestion Or vbYesNo) = vbYes Then
BuildRootTree TreeView1, True
Else
BuildRootTree TreeView1, False
End If
End Sub
Private Sub TreeView1_Expand(ByVal Node As Node)
If CBool(Node.Tag) Then
Exit Sub
End If
BuildSubTree TreeView1, Node
End Sub
Friend Sub BuildRootTree(ByVal tv As TreeView, ByVal IncludFiles As Boolean)
LockWindowUpdate tv.hWnd
tv.Nodes.Clear
tv.Tag = IncludFiles
Dim drv As Scripting.Drive
Dim rootNode As Node
For Each drv In FSO.Drives
Set rootNode = tv.Nodes.Add(Text:=drv.path & "\")
If drv.IsReady Then
rootNode.Tag = False
tv.Nodes.Add rootNode, tvwChild
Else
rootNode.Tag = True
End If
Next
LockWindowUpdate 0
End Sub
Private Sub BuildSubTree(ByVal tv As TreeView, ByVal location As Node)
If location Is Nothing Then
Exit Sub
ElseIf CBool(location.Tag) Then
'構築済み
Exit Sub
End If
LockWindowUpdate tv.hWnd
Try: On Error GoTo Finally
location.Tag = Empty
tv.Nodes.Remove location.Child.Index
Dim path As String
path = location.FullPath
path = Left(path, 2) & Replace(Mid(path, 3), "\\", "\")
Dim pFolder As Scripting.Folder
Set pFolder = FSO.GetFolder(path)
Dim cFolder As Scripting.Folder
Dim cNode As Node
Dim hasChildren As Boolean
For Each cFolder In pFolder.SubFolders
Set cNode = tv.Nodes.Add(location, tvwChild, , cFolder.Name)
hasChildren = False
On Error Resume Next
hasChildren = CBool(cFolder.SubFolders.Count > 0)
If hasChildren = False And CBool(tv.Tag) Then
hasChildren = CBool(cFolder.Files.Count > 0)
End If
On Error GoTo Finally
If hasChildren Then
tv.Nodes.Add cNode, tvwChild
cNode.Tag = False
Else
cNode.Tag = True
End If
Next
If CBool(tv.Tag) Then
'ファイルも列挙
Dim cFile As Scripting.File
For Each cFile In pFolder.Files
tv.Nodes.Add location, tvwChild, , cFile.Name
Next
End If
Finally:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
location.Tag = True
LockWindowUpdate 0
End Sub
 |
ツリービューにフォルダとファイルを表示する(VB6.0)_1