Vor kurzem haben wir Ihnen einen Code vorgestellt, mit dem sich schnell alle Ordner eines Laufwerks in einem TreeView-Control anzeigen lassen. Dieser Tipp wurde nun nochmals überarbeitet und ist jetzt nocht effizienter und schneller. Ab sofort werden "Dummys" eingesetzt, die nur dafür da sind, damit das '+'-Zeichen erscheint. Dadurch wird das öffnen des Ordner beschleunigt, da man diesmal wirklich nur das laden muss, was man auch sehen kann. Zusätzlich gibt es im Beispiel eine Fehlerroutine, die einen Ordner aus dem TreeView löscht, der angezeigt wird, aber nicht mehr vorhanden ist. Durch diese Verbesserungen ähnelt die Methode noch stärker dem Microsoft Explorer! Hier die einzelnen Funktionen mit kurzen Beschreibungen:
Fügen Sie nachfolgenden Code in ein Modul ein: ' Diese Funktion lädt die erste Ebene eines ' Verzeichnisses und gibt die Nodes als Collectionen ' zurück Function LoadWithFolders(oTreeView As TreeView, _ sDirectory As String, _ sImage As String, _ sExpandedImage As String) As Collection Dim vFolder As Variant Dim oNode As Node Dim coNodes As New Collection Dim coFolders As New Collection ' Unterordner holen Set coFolders = GetSubFolders(sDirectory) For Each vFolder In coFolders ' jeden Ordner mit Bild dem TreeView hinzufügen Set oNode = oTreeView.Nodes.Add(, tvwLast, , vFolder, sImage) ' Icon setzen, wenn es aufgeklappt wird oNode.ExpandedImage = sExpandedImage Call coNodes.Add(oNode) Next vFolder Set LoadWithFolders = coNodes End Function ' Diese Funktion fügt ein namenloses Dummynode-Objekt ' hinzu, das nur den Zweck hat, das '+'-Zeichen anzuzeigen. ' Die Funktion gibt zurück, ob ein Dummy erstellt worden ist Function AddChildDummy(oTreeView As TreeView, _ oParentNode As Node, _ sDirectory As String) As Boolean Dim oDummyNode As Node ' wenn nicht schon geladen wurde und ' Unterordner vorhanden sind If (oParentNode.Children = 0) And (AreSubFolder(sDirectory)) Then ' wenn Dummynode nicht vorhanden ist On Error Resume Next With oTreeView Set oDummyNode = .Nodes.Item(oParentNode.FullPath & "\Dummy") If Err = 35601 Then ' soll sie hinzugefügt werden .Nodes.Add oParentNode, tvwChild, oParentNode.FullPath & "\Dummy" AddChildDummy = True End If On Error GoTo 0 End With End If End Function ' Diese Funktion überprüft, ob es Unterornder ' in dem angegebenen Verzeichnis gibt Function AreSubFolder(sDir As String) As Boolean Dim sItem As String ' ersten Ordner sItem = Dir$(sDir & "\*", vbDirectory) Do If Left$(sItem, 1) <> "." Then If ExistDir(sDir & "\" & sItem) Then AreSubFolder = True Exit Do End If End If sItem = Dir$ Loop Until sItem = vbNullString End Function ' Diese Funktion entfernt das Dummynode-Objekt ' und gibt als Ergebnis zurück, ob sie gelöscht wurde Function RemoveChildDummy(oTreeView As TreeView, _ oParentNode As Node) As Boolean Dim oDummyNode As Node ' wenn das Objekt existiert wird es gelöscht On Error Resume Next With oTreeView.Nodes Set oDummyNode = .Item(oParentNode.FullPath & "\Dummy") If Err = 0 Then .Remove oParentNode.FullPath & "\Dummy" RemoveChildDummy = True End If On Error GoTo 0 End With End Function ' Diese Funktion fügt alle Unterordner (inklusive ' Dummynode-Objekte)eines Verzeichnisses hinzu und ' gibt sie als Collection zurück Function AddSubFolders(oTreeView As TreeView, _ oParentNode As Node, _ sDirectory As String, _ sImage As String, _ sExpandedImage As String) As Collection Dim vSubFolder As Variant Dim oNode As Node Dim coSubFolders As Collection Dim coChildNodes As New Collection ' wenn Unterordner vorhanden sind If (AreSubFolder(sDirectory)) Then ' Dummynode entfernen RemoveChildDummy oTreeView, oParentNode ' Unterordner holen Set coSubFolders = GetSubFolders(sDirectory) ' Alle Unterordner inkl. Dummynodes hinzufügen For Each vSubFolder In coSubFolders With oTreeView Set oNode = .Nodes.Add(oParentNode, tvwChild, , vSubFolder, sImage) oNode.ExpandedImage = sExpandedImage AddChildDummy oTreeView, oNode, sDirectory & "\" & oNode.Text ' Childnode der Collection hinzufügen coChildNodes.Add oNode End With Next vSubFolder ' Collection zurückgeben Set AddSubFolders = coChildNodes End If End Function ' Diese Funktion löscht alle Childnodes ' eines Node-Objekts Sub DeleteChildNodes(oTreeView As TreeView, _ oNode As Node, _ sDirectory As String) Dim x As Long Dim oChildNode As Node Dim oNextNode As Node ' 1. Childnode Set oChildNode = oNode.Child For x = 1 To oNode.Children ' Nächstes Childnode "merken" Set oNextNode = oChildNode.Next ' Childnode löschen oTreeView.Nodes.Remove oChildNode.Index ' Gehe zu nächstem Childnode Set oChildNode = oNextNode Next x ' Dummynode hinzufügen Call AddChildDummy(oTreeView, oNode, sDirectory) End Sub ' Diese Funktion ermittelt die Unterordner ' eines Verzeichnisses und gibt deren Namen in ' einer Collection zurück Function GetSubFolders(sDirectory As String) As Collection Dim sFolder As String Dim coSubFolders As New Collection If ExistDir(sDirectory) Then sFolder = Dir(sDirectory & "\*", vbDirectory) Do While sFolder <> vbNullString ' aus den alten DOS Zeiten, gibt es noch die ' Ordner, die einfach nur "." und ".." heißen. ' Diese werden hier aussortiert. If Left$(sFolder, 1) <> "." And _ ExistDir(sDirectory & "\" & sFolder) Then coSubFolders.Add sFolder End If ' nächsten Ordner sFolder = Dir Loop Set GetSubFolders = coSubFolders End If End Function ' Diese Funktion überprüft, ob es sich bei dem ' übergebenen Verzeichnis um einen existierenden ' Ordner handelt Function ExistDir(sDir As String) As Boolean ' Falls Verzeichnis nicht vorhanden ist On Error Resume Next ExistDir = ((GetAttr(sDir) And vbDirectory)) And (Err = 0) On Error GoTo 0 End Function Beispiel: Option Explicit Private sDirectory As String Private Sub Form_Load() ' ImageList zuordnen Set TreeView1.ImageList = ImageList1 ' Startordner sDirectory = "c:" ' Alle Ordner in C: anzeigen LoadWithFolders TreeView1, sDirectory, _ "OrdnerZu", "OrdnerOffen" End Sub Private Sub TreeView1_Collapse(ByVal Node As MSComctlLib.Node) ' Beim Schließen alle Unterordner löschen DeleteChildNodes TreeView1, Node, _ sDirectory & "\" & Node.FullPath End Sub Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node) ' wenn Unterordner vorhanden sind: ' + Dummy löschen ' + Alle Unterordner hinzufügen AddSubFolders TreeView1, Node, _ sDirectory & "\" & Node.FullPath, _ "OrdnerZu", "OrdnerOffen" End Sub Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node) ' wenn Verzeichnis noch vorhanden ist If ExistDir(sDirectory & "\" & Node.FullPath) Then ' wenn Unterordner vorhanden sind: ' einen Dummy erstellen, damit das '+'-Zeichen sichbar ist AddChildDummy TreeView1, Node, sDirectory & "\" & Node.FullPath Else ' wenn nicht, dann wird es aus TreeView gelöscht TreeView1.Nodes.Remove Node.Index End If End Sub Dieser Tipp wurde bereits 29.967 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
Neu! sevPopUp 2.0 Dynamische Kontextmenüs! Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
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. |