vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevDataGrid - Gönnen Sie Ihrem SQL-Kommando diesen krönenden Abschluß!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Dateisystem · Ordner & Verzeichnisse   |   VB-Versionen: VB4, VB5, VB626.07.01
Folder-TreeView im Eigenbau

Ein Beispiel zum Darstellen aller Ordner und Unterordner eines Laufwerks in Form einer Baumstruktur.

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  39.844 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Sie kenn sicherlich das Dir-Steuerelement in VB zum Darstellen und Auswählen eines Ordners. Leider sieht das optisch nicht so ansprechend aus, wie z.B. die Ordnerauswahl im Explorer.

Also, liegt es nahe, die Ordnerauswahl des Explorers nachzubauen. Alles, was Sie hierfür benötigen, sind eine unsichtbare Listbox, mit der Eigenschaft Sorted = True, ein TreeView-Steuerelement und eine Abbildungsliste (ImageList). Fügen Sie der Abbildungsliste drei Bildsymbole hinzu (Format 16x16), und zwar:

  • 1. Symbol "Ordner geschlossen"
  • 2. Symbol "Ordner geöffnet"
  • 3. Symbol "Laufwerk"

Anmerkung
Die Listbox wird benötigt, um alle über die Dir-Funktion ermittelten Ordner und Unterordner automatisch sortieren zu lassen. Das TreeView-Control wird dann mit den ListBox-Einträgen gefüllt.

Und hier der Code:

' TreeView mit allen Ordnern eines Laufwerks füllen
Public Sub FillTreeView(ByVal StartPath As String)
  Dim DirName As String
  Dim I As Integer
  Dim sPos As Integer
  Dim Ordner As String
  Dim MainOrdner As String
 
  ' TreeView löschen
  With TreeView1
    .Nodes.Clear
 
    ' Verzeichnisse ermitteln
    If Right$(StartPath, 1) = ":" Then _
      StartPath = StartPath + "\"
    GetAllFolders StartPath
 
    ' Erster Eintrag: Laufwerk selbst
    .Nodes.Add , , StartPath, StartPath, 3, 3
 
    ' Verzeichnisse
    While List1.ListCount > 0
      DirName = List1.List(0)
      List1.RemoveItem 0
 
      sPos = InStrRev(DirName, "\")
      Ordner = Mid$(DirName, sPos + 1)
      MainOrdner = Left$(DirName, sPos - 1)
      If InStr(MainOrdner, "\") = 0 Then _
        MainOrdner = MainOrdner + "\"
 
      .Nodes.Add MainOrdner, tvwChild, DirName, Ordner, 1, 2
    Wend
 
    ' Root öffnen
    .Nodes(1).Expanded = True
 
  End With
End Sub
 
' Rekursive Prozedur zum Ermitteln aller Verzeichnisse
Private Sub GetAllFolders(ByVal Pfad As String)
  Dim Count As Long
  Dim I As Long
  Dim DirName() As String
 
  On Local Error Resume Next
  Count = GetAllSubDir(Pfad, DirName())
  I = 1
  Do Until I > Count
    List1.AddItem Pfad + DirName(I)
    GetAllFolders Pfad + DirName(I) + "\"
    I = I + 1
  Loop
  On Local Error GoTo 0
End Sub
 
' Unterverzeichnisse eines Ordners ermitteln
Private Function GetAllSubDir(Path As String, _
  D() As String) As Integer
 
  Dim DirName As String
  Dim Count As Integer
 
  If Right$(Path, 1) <> "\" Then Path = Path + "\"
  DirName = Dir(Path, vbDirectory)
  Count = 0
  Do While DirName <> ""
    If DirName <> "." And DirName <> ".." Then
      If (GetAttr(Path + DirName) And vbDirectory) = _
        vbDirectory Then
        If (Count Mod 10) = 0 Then
          ReDim Preserve D(Count + 10) As String
        End If
        Count = Count + 1
        D(Count) = DirName
      End If
    End If
    DirName = Dir
  Loop
  GetAllSubDir = Count
End Function

Aufgerufen wird die Funktion dann so:

Private Sub Command1_Click()
  Screen.MousePointer = 11
  ' aktuelles Laufwerk
  FillTreeView Left$(CurDir$, 2)
  Screen.MousePointer = 0
End Sub

Anmerkungen
Es sei angemerkt, daß es sich bei diesem Code nicht gerade um die schnellste Vorgehensweise handelt. Hie und da liesse sich noch sehr viel optimieren. Ideal wäre es in jedem Fall, wenn man das TreeView-Steuerelement zunächst erst einmal mit den Ordnern der ersten Ebene füllt - und die weiteren Unterordner erst dann ermittelt, wenn ein Ordner geöffnet wird.

Aber das möchten wir mal Ihnen selber überlassen - vielleicht jedoch, finden Sie hier demnächst schon eine wesentlich verbesserte Routine (vor allen Dingen in Bezug auf die Geschwindigkeit!) oder Sie schicken uns Ihre verbesserte Routine zu...
 

16.10.07: Update von Timo Schreiber
Modifzierung des Quelltextes ohne ListBox zum Zwischenspeichern der Einträge. Dadurch wird das TreeView um einiges schneller gefüllt. Desweiteren werden jetzt zusätzlich noch die Dateien einbezogen. Hierfür wurde ein weiteres Icon implementiert ((1=folder_closed 2=file 3=folder_open 4=drive).

' TreeView mit allen Ordnern eines Laufwerks füllen
Public Sub FillTreeView(ByVal StartPath As String)
  If Right$(StartPath, 1) = ":" Then StartPath = StartPath & "\"
 
  With TreeView1
    ' TreeView löschen
    .Nodes.Clear
    ' Erster Eintrag: Laufwerk selbst
    .Nodes.Add , , StartPath, StartPath, 4, 4
    ' Verzeichnisse ermitteln
    GetAllFolders StartPath
    ' Root öffnen
    .Nodes(1).Expanded = True
  End With
End Sub
' Rekursive Prozedur zum Ermitteln aller Verzeichnisse
Private Sub GetAllFolders(ByVal Pfad As String)
  Dim Count As Long
  Dim I As Long
  Dim DirName() As String
  Dim sPos As Integer
  Dim Ordner As String
  Dim MainOrdner As String
  Dim MainPath As String
 
  On Error Resume Next
  Count = GetAllSubDir(Pfad, DirName())
  I = 1
 
  Do Until I > Count
    MainPath = Pfad & DirName(I)
 
    ' Verzeichnisse
    sPos = InStrRev(MainPath, "\")
    Ordner = Mid$(MainPath, sPos + 1)
    MainOrdner = Left$(MainPath, sPos - 1)
    If InStr(MainOrdner, "\") = 0 Then MainOrdner = MainOrdner + "\"
 
    If (GetAttr(MainPath) And vbDirectory) = vbDirectory Then
      TreeView1.Nodes.Add MainOrdner, tvwChild, MainPath, Ordner, 1, 3
    Else
      TreeView1.Nodes.Add MainOrdner, tvwChild, MainPath, Ordner, 2, 2
    End If
 
    GetAllFolders Pfad & DirName(I) & "\"
    I = I + 1
  Loop
  On Error GoTo 0
End Sub
' Unterverzeichnisse eines Ordners ermitteln
Private Function GetAllSubDir(Path As String, _
  D() As String) As Integer
 
  Dim DirName As String
  Dim Count As Integer
 
  If Right$(Path, 1) <> "\" Then Path = Path & "\"
  DirName = Dir(Path, vbDirectory)
  Count = 0
  Do While DirName <> ""
    If DirName <> "." And DirName <> ".." Then
      If (Count Mod 10) = 0 Then
        ReDim Preserve D(Count + 10) As String
      End If
      Count = Count + 1
      D(Count) = DirName
    End If
    DirName = Dir
  Loop
  GetAllSubDir = Count
End Function

Dieser Tipp wurde bereits 39.844 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel