Die Community zu .NET und Classic VB.
Menü

VB.NET-Tipp 0148: Ordnerstruktur im Treeview anzeigen

 von 

Beschreibung

Eine Baumansicht der Verzeichnisstruktur. Die Dateienliste der Unterknoten werden erst bei Öffnen der Elternknoten nachgeladen. Erforderliche Dateisuchen sind in einen Hintergrund-Thread ausgelagert.

Schwierigkeitsgrad:

Schwierigkeitsgrad 3

Framework-Version(en):

.NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5, .NET Framework 4

.NET-Version(en):

Visual Basic 2005, Visual Basic 2008, Visual Basic 2010

Download:

Download des Beispielprojektes [26,01 KB]

' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' Projektversion:   Visual Studio 2008
' Option Strict:    An
' Option Infer:     An
'
' Referenzen: 
'  - System
'  - System.Core
'  - System.Drawing
'  - System.Windows.Forms
'
' Imports: 
'  - System
'  - System.Collections.Generic
'  - System.Drawing
'  - System.Linq
'  - System.Windows.Forms
'

' ##############################################################################
' ############################### DelegateX.vb #################################
' ##############################################################################
Imports System.Collections.Generic
Imports System.Runtime.CompilerServices

''' <summary> Extensions für Delegaten </summary>
Public Module DelegateX

    <Extension()> _
    Public Function CombineWith(ByVal subj As Action, _
                               ByVal obj As Action) As Action
        Return DirectCast([Delegate].Combine(subj, obj), Action)
    End Function

    <Extension()> _
    Public Function CombineWith(Of T)(ByVal subj As Action(Of T), _
                                     ByVal obj As Action(Of T)) As Action(Of T)
        Return DirectCast([Delegate].Combine(subj, obj), Action(Of T))
    End Function

End Module
' ##############################################################################
' ############################## DisposeLevel.vb ###############################
' ##############################################################################
Imports System

''' <summary>
'''  Wrapped einen frei definierbaren Initialisierung- und einen 
'''   Aufräum-Delegaten, sodass ein Aufruf von "Using DisposeLevel.Enter()" 
'''   sicher initialisiert und aufräumt.
'''  Bei Verschachtelung wird nur beim Betreten/Verlassen des äußeren 
'''   Using-Blocks initialisiert/aufgeräumt 
''' </summary>
Public Class DisposeLevel : Implements IDisposable

    ' Dispose() wird hier "missbraucht", um den Level runterzuzählen, und bei 0
    '  die Aufräum-Aktion aufzurufen. IDisposable ermöglicht die Verwendung der 
    '  sehr sicheren Using-Block-Syntax.

    Protected _enter As Action, _exit As Action
    Protected _level As Integer = 0

    Public Sub New()
    End Sub
    Public Sub New(ByVal enter As Action, ByVal [Exit] As Action)
        Add(enter, [Exit])
    End Sub
    Private Sub EnterCore()
        _level += 1
        If _level = 1 Then _enter()
    End Sub
    Public Function Enter() As IDisposable
        EnterCore()
        Return Me
    End Function
    Private Sub Dispose() Implements IDisposable.Dispose
        _level -= 1
        Select Case _level
            Case -1
                Throw Me.Exception("cannot set Level < 0!")
            Case 0
                _exit()
        End Select
    End Sub
    ''' <summary>
    ''' Hinzufügen weiterer DisposeLevel lässt baumartige Ablauf-Strukturen
    '''  entstehen.
    ''' </summary>
    Public Sub Add(ByVal child As DisposeLevel)
        Add(AddressOf child.EnterCore, AddressOf child.Dispose)
    End Sub
    Public Sub Add(ByVal enter As Action, ByVal [Exit] As Action)
        _enter = If(_enter Is Nothing, enter, _enter.CombineWith(enter))
        _exit = If(_exit Is Nothing, [Exit], [Exit].CombineWith(_exit))
    End Sub
End Class

' ##############################################################################
' ############################## ExceptionOf.vb ################################
' ##############################################################################

''' <summary> 
'''  Generische Exception mit genauen Daten über das Fehler-werfende Objekt.
''' </summary>
Public Class Exception(Of T) : Inherits System.Exception

    ''' <summary>
    ''' Stellt den Fehler-Werfenden fürs Debuggen zur Verfügung
    ''' </summary>
    Public ReadOnly Sender As T

    Public Sub New(ByVal sender As T, _
                   ByVal innerException As Exception, _
                   ByVal message As String)

        MyBase.New(String.Concat( _
           sender.GetType.Name, "-Exception", _
           If(String.IsNullOrEmpty(message), "", ": " & message)), innerException)
        Me.Sender = sender
    End Sub

End Class

' ##############################################################################
' ########################### FileSystemTreeView.vb ############################
' ##############################################################################
Imports Microsoft.VisualBasic
Imports System.ComponentModel

''' <summary> 
'''  Treeview mit integrierter Imagelist für Drive, Folder, File 
''' </summary>
Public Class FileSystemTreeView : Inherits TreeView
    ' Erweiterungsfähig in Richtung TreeViews, die auch Dateien anzeigen
    '  (was FolderTreeView ja nicht tut)

#Region "GeneratedCode"

    Private Sub InitializeComponent()
        Me.components = New System.ComponentModel.Container
        Dim resources As System.ComponentModel.ComponentResourceManager = _
            New System.ComponentModel.ComponentResourceManager( _
                GetType(FileSystemTreeView) _
            )
        Me.IconList = New System.Windows.Forms.ImageList(Me.components)
        Me.SuspendLayout()
        '
        'IconList
        '
        Me.IconList.ImageStream = CType( _
            resources.GetObject("IconList.ImageStream"),  _
            System.Windows.Forms.ImageListStreamer)
        Me.IconList.TransparentColor = System.Drawing.Color.Transparent
        Me.IconList.Images.SetKeyName(0, "OpenFolder")
        Me.IconList.Images.SetKeyName(1, "ClosedFolder")
        Me.IconList.Images.SetKeyName(2, "File")
        Me.IconList.Images.SetKeyName(3, "Drive")
        '
        'FileSystemTreeView
        '
        Me.HideSelection = False
        Me.ResumeLayout(False)

    End Sub

    <System.Diagnostics.DebuggerNonUserCode()> _
    Protected Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing AndAlso components IsNot Nothing Then
            components.Dispose()
        End If
        MyBase.Dispose(disposing)
    End Sub
    Protected WithEvents IconList As System.Windows.Forms.ImageList

    Private components As IContainer
#End Region 'GeneratedCode

#Region "ShadowAwayIconStuff"
    ' Da bei diesem Treeview die Icons mit drin sind, muss die geerbte
    '  Icon-Funktionalität deaktiviert werden

    <Browsable(False)> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
    Public Shadows ReadOnly Property ImageKey() As String
        Get
            Return MyBase.ImageKey
        End Get
    End Property


    <Browsable(False)> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
    Public Shadows ReadOnly Property ImageList() As ImageList
        Get
            Return MyBase.ImageList
        End Get
    End Property

    <Browsable(False)> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
    Public Shadows ReadOnly Property SelectedImageKey() As String
        Get
            Return MyBase.SelectedImageKey
        End Get
    End Property

    <Browsable(False)> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
    Public Shadows ReadOnly Property ImageIndex() As Integer
        Get
            Return MyBase.ImageIndex
        End Get
    End Property

    <Browsable(False)> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
    Public Shadows ReadOnly Property SelectedImageIndex() As Integer
        Get
            Return MyBase.SelectedImageIndex
        End Get
    End Property

#End Region 'ShadowAwayIconStuff

    Public Enum NodeType
        OpenFolder
        ClosedFolder
        File
        Drive
    End Enum

    Protected Shared ReadOnly _Separator As Char = _
        IO.Path.DirectorySeparatorChar

    Public Sub New()
        InitializeComponent()
        MyBase.PathSeparator = _Separator
        MyBase.ImageIndex = NodeType.ClosedFolder
        MyBase.SelectedImageIndex = NodeType.OpenFolder
        MyBase.ImageList = IconList
    End Sub

End Class

' ##############################################################################
' ############################# FolderTreeview.vb ##############################
' ##############################################################################
Imports Microsoft.VisualBasic
Imports System
Imports System.IO
Imports System.Collections
Imports System.ComponentModel

''' <summary> Zeigt die Ordnerstruktur des Dateisystems an </summary>
Public Class FolderTreeview : Inherits FileSystemTreeView

    Private WithEvents _NodeFiller As New JobWorker

    Protected Overrides Sub OnHandleCreated(ByVal e As System.EventArgs)
        MyBase.OnHandleCreated(e)
        ' Me.DesignMode funktioniert erst bei vorhandenem Control-Handle
        If Me.DesignMode Then Return
        MyBase.Sorted = True 'Simpel-Sortierung reicht hier
        CheckDrives()
    End Sub

#Region "Public_Members"

    <Browsable(False)> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
    Public Property SelectedFolder() As String
        Get
            If MyBase.SelectedNode Is Nothing Then Return ""
            Return MyBase.SelectedNode.FullPath
        End Get
        Set(ByVal NewFolder As String)
            If SelectedFolder = NewFolder Then Return
            If Directory.Exists(NewFolder) Then
                GotoDirectory(NewFolder)
            Else
                MessageBox.Show(Me, _
                    String.Format("'{0}' kann nicht gefunden werden", NewFolder), _
                    My.Application.Info.Title, _
                    MessageBoxButtons.OK, _
                    MessageBoxIcon.Information)
            End If
        End Set
    End Property

    ''' <summary>
    '''  Bringt (nur) die zugreifbaren Laufwerke zur Anzeige 
    '''   (ggfs. Wechselmedium einlegen)
    ''' </summary>
    Public Sub CheckDrives()
        NodeFillJob.FillWithDrives(Me.Nodes)
        For Each Nd As TreeNode In Me.Nodes
            Nd.ImageIndex = NodeType.Drive
            Nd.SelectedImageIndex = NodeType.Drive
        Next
    End Sub

#End Region 'Public_Members

#Region "Overrides, Events"

    Protected Overrides Sub OnBeforeSelect(ByVal e As TreeViewCancelEventArgs)
        ' Bei Selektion eines ungültigen Nodes auf den nächsten gültigen 
        '  Parent wechseln
        Dim Nd As TreeNode = GetValidNode(e.Node)
        If Nd IsNot e.Node Then
            e.Cancel = True
            Me.SelectedNode = Nd
            Return
        End If
        MyBase.OnBeforeSelect(e)
    End Sub

    Protected Overrides Sub OnAfterExpand( _
            ByVal e As System.Windows.Forms.TreeViewEventArgs)

        Dim Nd = e.Node
        ' Abbruch, wenn nicht Nd im Dateisystem existiert
        If Nd IsNot GetValidNode(Nd) Then Return

        ' Da wir keinen FilesystemWatcher einsetzen möchte, synchronisieren wir
        '  beim Öffnen eines Nodes jedesmal neu mit dem Dateisystem.
        _NodeFiller.Add(AddressOf (New NodeFillJob(Nd)).GetSubFolders)
        MyBase.OnAfterExpand(e)
    End Sub

    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        ' OnPaint wird nicht aufgerufen, daher testen wir in WndProc auf WM_PAINT
        Const WM_PAINT As Integer = &HF
        MyBase.WndProc(m)
        If m.Msg = WM_PAINT Then
            ' Bei jedem Paint werden alle sichtbaren, noch nicht befüllten Nodes
            '  mit dem Dateisystem synchronisiert. Die Belastung des 
            '  Main-Threads ist jedoch minimal, wg. Einsatz von Threading.
            ' Die Gesamt-Entlastung besteht darin, daß auch bei großem 
            '  Bildschirm kaum jemals mehr als 40 Nodes sichtbar sind.
            Using _NodeFiller.Monitor
                Dim Nd = Me.TopNode
                Do Until Nd Is Nothing OrElse Not Nd.IsVisible
                    If Nd.Tag IsNot Nothing Then
                        ' Die zu befüllenden Nodes sind durch 
                        '  "Nd.Tag <> Nothing" markiert
                        _NodeFiller.Add( _
                            AddressOf (New NodeFillJob(Nd)).GetSubFolders)
                    End If
                    Nd = Nd.NextVisibleNode
                Loop
            End Using
        End If
    End Sub

    Private Sub _NodeFiller_AllDone( _
            ByVal sender As Object, _
            ByVal e As JobWorker.EventArg) Handles _NodeFiller.AllDone

        For Each Job As NodeFillJob In e.DoneJobs
            ' Der Nebenthread hat Dateisuchen durchgeführt und Ordner-Listen 
            '  erstellt. Treenodes einhängen muß leider im Hauptthread erfolgen.
            Job.Synchronize()
        Next
    End Sub

#End Region 'Overrides, Events

#Region "Privates"

    Private Function GetValidNode(ByVal Nd As TreeNode) As TreeNode
        If Directory.Exists(Nd.FullPath) Then Return Nd
        Do Until Directory.Exists(Nd.FullPath)
            Nd = Nd.Parent
        Loop
        _NodeFiller.Add(AddressOf (New NodeFillJob(Nd)).GetSubFolders)
        Return Nd
    End Function


    Private Sub Kanonisize(ByRef sFullPath As String)
        ' Ein Gemurkel mit Microsoft.VisualBasic.FileSystem.Dir(), um die 
        '  Groß/Klein-Schreibweise zu ermitteln, die im Dateisystem 
        '  hinterlegt ist.
        Dim Segments = sFullPath.Split(_Separator)
        With New System.Text.StringBuilder(Segments(0))
            For I = 1 To Segments.Length - 1
                .Append(_Separator).Append( _
                    Dir(.ToString & Segments(I), FileAttribute.Directory))
            Next
            sFullPath = .ToString
        End With
    End Sub

    Private Sub GotoDirectory(ByVal sFullPath As String)
        ' Es wird der sFullPath nächste übergeordnete Treenode gesucht, und von 
        '  dem aus ein Ketten-Abschnitt von Nodes erstellt, sodass die 
        '  Gesamt-Kette sFullPath korrekt darstellt. EnsureVisible auf das 
        '  unterste Kettenglied angewandt expandiert alle darüber liegenden 
        '  Nodes und löst damit die Befüllung derselben in OnAfterExpand() aus.
        Kanonisize(sFullPath)
        With Me.Approach(sFullPath)
            Dim Nd = .Node
            If Not .IsFullMatch Then
                For I = .StepsDone To .Segments.Count - 1
                    Nd = Nd.Nodes.Add(.Segments(I))
                    NodeFillJob.Fill(Nd)
                Next
            End If
            Using _NodeFiller.Monitor
                Nd.EnsureVisibleX(StringAlignment.Center, True)
            End Using
            Me.SelectedNode = Nd
        End With
    End Sub

#End Region 'Privates

End Class
' ##############################################################################
' ################################# Form1.vb ###################################
' ##############################################################################
Imports System.IO

Public Class Form1

    Private _PathToDrop As String

    Private Sub Form_Load(ByVal sender As Object, _
                          ByVal e As System.EventArgs) Handles Me.Load
        Me.FolderTreeview1.SelectedFolder = Environment.CurrentDirectory
    End Sub

    ' FolderTreeview navigiert zum vom Explorer auf ihn gezogenes Verzeichnis.
    Private Sub FolderTreeview1_DragOver(ByVal sender As Object, _
            ByVal e As DragEventArgs) Handles FolderTreeview1.DragOver

        Dim DTO = TryCast(e.Data, DataObject)
        If DTO Is Nothing OrElse Not DTO.ContainsFileDropList Then Return
        _PathToDrop = DTO.GetFileDropList()(0)
        If Not Directory.Exists(_PathToDrop) Then
            _PathToDrop = Path.GetDirectoryName(_PathToDrop)
        End If
        e.Effect = e.AllowedEffect
    End Sub

    Private Sub FolderTreeview1_DragDrop(ByVal sender As Object, _
            ByVal e As DragEventArgs) Handles FolderTreeview1.DragDrop
        FolderTreeview1.SelectedFolder = _PathToDrop
    End Sub
End Class
' ##############################################################################
' ############################### JobWorker.vb #################################
' ##############################################################################

''' <summary>
'''  Kapselt einen Queue Of Action-Delegaten, welcher im Nebenthread 
'''   abgearbeitet werden
''' </summary>
''' <remarks> 
'''  Während der Bearbeitung können weitere "Jobs" hinzugefügt werden 
''' </remarks>
Public Class JobWorker
    Public Class EventArg : Inherits EventArgs
        ''' <summary> 
        '''  Liste der Objekte, deren Objekt-Funktion abgearbeitet wurde 
        ''' </summary>
        Public ReadOnly DoneJobs As New List(Of Object)
    End Class

    Public Event AllDone As EventHandler(Of EventArg)
    Private _EA As New EventArg

    Private ReadOnly _Monitor As New DisposeLevel(AddressOf EnterMonitor, _
                                                  AddressOf ExitMonitor)
    Private ReadOnly _ToDo As New Queue(Of Action)
    Private _DoWork As Action = AddressOf DoWork
    Private _DoWorkCallback As AsyncCallback = AddressOf _DoWork.EndInvoke
    Private _WorkCompleted As Action = AddressOf WorkCompleted
    Private _IsBusy As Boolean

    Private Sub EnterMonitor()
        System.Threading.Monitor.Enter(_Monitor)
    End Sub
    Private Sub ExitMonitor()
        System.Threading.Monitor.Exit(_Monitor)
    End Sub

    ''' <summary>
    '''  Using JobWorker.Monitor reserviert die Queue des JobWorkers für den 
    '''  aktuellen Thread. So können mehrere Jobs zugefügt werden, ohne dass 
    '''  der JobWorker "dazwischenfunkt", indem er die Abarbeitung beginnt. 
    '''  Bei verschachtelten Blöcken wird die Queue erst beim Verlassen des 
    '''  äußeren Using-Blocks freigegeben.
    ''' </summary>
    Public ReadOnly Property Monitor() As IDisposable
        Get
            Return _Monitor.Enter
        End Get
    End Property

    ''' <summary>
    ''' Fügt einen Action - Delegaten hinzu, der abzuarbeiten ist. Startet 
    '''  gegebenenfalls den NebenThread.
    ''' </summary>
    Public Sub Add(ByVal Method As Action)
        ' SyncLock/Monitor.Enter sichert Zugriffe auf die Queue dagegen ab, dass
        '  gleichzeitig aus dem anderen Thread zugegriffen wird.
        Using _Monitor.Enter
            _ToDo.Enqueue(Method)
        End Using
        If Not _IsBusy Then
            _IsBusy = True
            _DoWork.BeginInvoke(_DoWorkCallback, Nothing)
        End If
    End Sub

    Private Sub DoWork()
        'Arbeiten im NebenThread
        While True
            Dim Method As Action = Nothing
            ' Falls der HauptThread grade Jobs hinzufügt, so lange warten
            SyncLock _Monitor
                If _ToDo.Count = 0 Then Exit While
                Method = _ToDo.Dequeue
            End SyncLock
            Method()
            ' Die Targets der Delegaten sind diejenigen NodeFillJobs, deren 
            '  .FillChildNames()-Funktion der Delegat aufruft. Die NodeFillJobs 
            '  sollen später im Hauptthread zum Abschluss gebracht werden. Sie 
            '  werden schonmal ins EventArg eingespeichert, welches später 
            '  verwendet wird.
            _EA.DoneJobs.Add(Method.Target)
        End While
        Application.OpenForms(0).BeginInvoke(_WorkCompleted)
    End Sub

    Private Sub WorkCompleted()
        If _ToDo.Count > 0 Then
            ' Mögliche Race-Condition: 
            '  während Application.OpenForms(0).BeginInvoke(_WorkCompleted) 
            '  "unterwegs" zum GuiThread ist, können weitere Jobs aufgelaufen 
            '  sein.
            _DoWork.BeginInvoke(_DoWorkCallback, Nothing)
            Return
        End If

        ' Eventuell können innerhalb der Behandlung von _AllDone neue Jobs 
        '  hinzugefügt werden, daher ein neues _EA anlegen.
        Dim OldEA As EventArg = _EA
        _EA = New EventArg
        _IsBusy = False
        RaiseEvent AllDone(Me, OldEA)
    End Sub

End Class

' ##############################################################################
' ############################### modHelpers.vb ################################
' ##############################################################################
Imports System.Runtime.CompilerServices
Imports System
Imports System.Diagnostics
Imports System.Collections

Public Module modHelpers

    ''' <summary>Einfache Debug-Ausgabe, nimmt alles, unkaputtbar</summary>
    Public Sub Dbg(ByVal ParamArray Args As Object())
        Dim Args2(Args.Length * 2 - 1) As Object
        For i As Integer = 0 To Args.Length - 1
            Args2(i * 2) = If(Args(i), "##-Null-##")
            Args2(i * 2 + 1) = " "
        Next
        Console.WriteLine(String.Concat(Args2))
    End Sub

End Module

' ##############################################################################
' ############################## NodeFillJob.vb ################################
' ##############################################################################
Imports System.IO

Public Class NodeFillJob
    ' Die Objekt-Methoden GetSubFolders() und Synchronize() trennen die 
    '  Befüllung eines Treenodes mit Directories in 2 Schritte auf: 
    '   GetSubFolders ermittelt nur die DirectoryNames. Das ist zeitaufwändig, 
    '    aber kann im NebenThread geschehen. 
    '   Synchronize() füllt dann den Node mit Subnodes diesen Names. Das muss
    '    im Gui-Thread erfolgen, geht dafür recht flott.
    ' Die Public Shared Methoden befüllen den Node direkt, ohne ein 
    '  NodeFillJob-Objekt zu erstellen und ohne Threading.

    ' Es gibt gewisse Ähnlichkeiten zum command-pattern
    ' (s.a.: "http://de.wikipedia.org/wiki/Kommando_%28Entwurfsmuster%29")

    Private ReadOnly _Node As TreeNode
    Private _SubFolders As List(Of String)

    Public Sub New(ByVal Node As TreeNode)
        _Node = Node
    End Sub

    Public Sub GetSubFolders()
        ' Für Aufruf aus den Nebenthread, da GetSubFolders zeitaufwändig ist.
        _SubFolders = GetSubFolders(_Node.FullPath)
    End Sub

    Private Shared Function GetSubFolders( _
            ByVal ParentPath As String) As List(Of String)

        Try
            Dim Dirs = Directory.GetDirectories(ParentPath & _
                                                 Path.DirectorySeparatorChar)
            Return Dirs.Select(Function(Dir As String) _
                                   Path.GetFileName(Dir)).ToList
        Catch ex As System.UnauthorizedAccessException
            ' Bei bestimmten Directories wirft das Betriebssystem diese 
            '  Exception, wenn ihr Inhalt eingesehen werden soll.
            Return New List(Of String) ' gib leere Liste zurück
        End Try
    End Function

    Public Sub Synchronize()
        ' Für Aufruf nach Rückkehr aus dem Nebenthread, da auf die TreeNodes 
        '  nicht im NebenThread zugegriffen werden kann.
        Synchronize(_Node.Nodes, _SubFolders)
        _Node.Tag = Nothing ' als synchronisiert markieren
    End Sub

    Private Shared Sub Synchronize(ByVal Nodes As TreeNodeCollection, _
                                     ByVal Names As List(Of String))
        ' Sind schon Nodes vorhanden, gibt es 2 Möglichkeiten: Entweder der 
        '  Node ist "richtig" (Übereinstimmung mit dem Dateisystem), und damit 
        '  nicht erneut hinzuzufügen. Oder er ist "falsch", und muss entfernt 
        '  werden.
        For INode As Integer = Nodes.Count - 1 To 0 Step -1
            Dim IName As Integer = Names.IndexOf(Nodes(INode).Text)
            If IName >= 0 Then
                ' "Richtigen" Node vom Hinzufügen ausnehmen
                Names.RemoveAt(IName)
            Else
                ' Ungültigen Node entfernen
                Nodes.RemoveAt(INode)
            End If
        Next

        ' Aus allen anderen Names Treenodes erzeugen und hinzufügen
        For Each sDir As String In Names
            ' Der neue Node ist als unsynchronisiert markiert, indem .Tag 
            '  irgendetwas zugewiesen ist
            Nodes.Add(New TreeNode(sDir) With {.Tag = 1})
        Next
    End Sub

    Public Shared Sub Fill(ByVal Node As TreeNode)
        ' Befüllung ohne Threading
        Synchronize(Node.Nodes, GetSubFolders(Node.FullPath))
        Node.Tag = Nothing ' als synchronisiert markieren
    End Sub

    Public Shared Sub FillWithDrives(ByVal Nodes As TreeNodeCollection)
        ' Befüllung ohne Threading, mit Laufwerken statt Verzeichnissen
        Dim SubFolders = From Info In DriveInfo.GetDrives _
                          Where Info.IsReady _
                          Select Info.Name.TrimEnd(Path.DirectorySeparatorChar)
        Synchronize(Nodes, SubFolders.ToList)
    End Sub

End Class

' ##############################################################################
' ################################ ObjectX.vb ##################################
' ##############################################################################
Imports System.Runtime.CompilerServices

''' <summary> Extensions für alle Klassen </summary>
Public Module ObjectX

    <Extension()> _
    Public Function Exception(Of T)(ByVal sender As T, _
            ByVal firstMsgSegment As Object, _
            ByVal ParamArray msgSegments As Object()) As Exception(Of T)

        Return Exception(Of T)(sender, _
                               Nothing, _
                               firstMsgSegment, _
                               String.Concat(msgSegments))
    End Function

    <Extension()> _
    Public Function Exception(Of T)(
            ByVal sender As T, _
            ByVal innerException As Exception, _
            ByVal ParamArray msgSegments As Object()) As Exception(Of T)

        Return New Exception(Of T)(sender, innerException, String.Concat(msgSegments))
    End Function

    <Extension()> _
    Public Function Exception(Of T)(ByVal sender As T) As Exception(Of T)
        Return Exception(Of T)(sender, Nothing)
    End Function


    ''' <summary> 
    '''  Testet vor einer Zuweisung, ob der neue Wert überhaupt eine Änderung 
    '''   bringt.
    ''' </summary>
    ''' <remarks>
    '''  Nützlich bei Zuweisungen an rechenintensive Eigenschaften, 
    '''   oder wenn auf Änderungen reagiert werden muss.
    ''' </remarks>
    <Extension()> _
    Public Function Assign(Of T, T2 As T)(ByRef Dest As T, _
                                          ByVal Src As T2) As Boolean
        If Object.Equals(Dest, Src) Then Return False
        Dest = Src
        Return True
    End Function

End Module

' ##############################################################################
' ############################### TreeNodeX.vb #################################
' ##############################################################################
Imports System.Runtime.CompilerServices
Imports System.Drawing
Imports System.Windows.Forms

''' <summary> TreeNode-Extensions </summary>
Public Module TreeNodeX

    Public Structure ApproachResult
        Public ReadOnly Node As TreeNode
        Public ReadOnly StepsDone As Integer
        Public ReadOnly Segments As IList(Of String)

        Public Sub New( _
              ByVal Node As TreeNode, _
              ByVal Segments As IList(Of String), _
              ByVal StepsDone As Integer)
            Me.Node = Node
            Me.Segments = Segments
            Me.StepsDone = StepsDone
        End Sub

        Public ReadOnly Property IsFullMatch() As Boolean
            Get
                Return Segments.Count = StepsDone
            End Get
        End Property
    End Structure 'ApproachResult

    ''' <summary>
    '''  Sucht in Nodes und SubNodes anhand eines Pfades nach dem bezeichneten 
    '''   Node. Bei Nichtexistenz des ZielNode den übergeordneten, in den der 
    '''   ZielNode zu erstellen wäre.
    ''' </summary>
    ''' <param name="PathSegments">Die Segmente des Pfades</param>
    ''' <returns>
    '''  Ein <see cref="ApproachResult">ApproachResult</see>, 
    '''   das den gefundenen Node und die Anzahl abgearbeiteter Segmente enthält.
    ''' </returns>
    <Extension()> _
    Public Function Approach(ByVal Nodes As TreeNodeCollection, _
         ByVal PathSegments As IList(Of String)) As ApproachResult
        Dim Nd As TreeNode = Nothing, I As Integer
        For I = 0 To PathSegments.Count - 1
            Dim tmp = Nodes.ByText(PathSegments(I))
            If tmp Is Nothing Then Exit For
            Nd = tmp
            Nodes = Nd.Nodes
        Next
        Return New ApproachResult(Nd, PathSegments, I)
    End Function

    <Extension()> _
    Public Function ByText(ByVal Nodes As TreeNodeCollection, _
                           ByVal text As String) As TreeNode
        For Each nd As TreeNode In Nodes
            If String.Compare(nd.Text, text, True) = 0 Then Return nd
        Next
        Return Nothing
    End Function

    <Extension()> _
    Public Function Approach(ByVal TV As TreeView, _
                             ByVal NodePath As String) As ApproachResult
        Return TV.Nodes.Approach( _
            NodePath.Split(New String() {TV.PathSeparator}, _
                StringSplitOptions.None))
    End Function

    <Extension()> _
    Public Function ParentNodes(ByVal Nd As TreeNode) As TreeNodeCollection
        Dim Parent = Nd.Parent
        Return If(Parent Is Nothing, Nd.TreeView.Nodes, Parent.Nodes)
    End Function

    <Extension()> _
    Public Sub Delete(ByVal Nd As TreeNode, _
                      Optional ByVal Recursive As Boolean = False)

        Dim ParentNodes = Nd.ParentNodes
        If Not Recursive Then
            ' Nur diese Instanz ausschneiden, Children an meinen Parent hängen
            Dim Nodes = Nd.Nodes
            For I = Nodes.Count - 1 To 0 Step -1
                Dim Nd2 = Nodes(I)
                Nodes.RemoveAt(I)
                ParentNodes.Add(Nd2)
            Next
        End If
        Nd.Remove()
    End Sub

    <Extension()> _
    Public Sub EnsureVisibleX( _
            ByVal Nd As TreeNode, _
            ByVal Align As StringAlignment, _
            Optional ByVal Forced As Boolean = False)

        If Nd.IsVisible AndAlso Not Forced Then Return
        ' Zeigt den sichtbar zu machenden Node Oben / Unten / Mitten 
        '  im Treeview an.
        Dim TV = Nd.TreeView
        Select Case Align
            Case StringAlignment.Near
                TV.TopNode = Nd

            Case StringAlignment.Far
                TV.TopNode = TV.Nodes(0)
                Nd.EnsureVisible()

            Case StringAlignment.Center
                Nd.EnsureVisibleX(StringAlignment.Far)
                With Nd.Bounds
                    Dim Nd2 As TreeNode = _
                        TV.GetNodeAt(1, .Bottom + .Height - TV.Height \ 2)
                    If Nd2 IsNot Nothing Then TV.TopNode = Nd2
                End With
        End Select
    End Sub

End Module

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.