VB.NET-Tipp 0148: Ordnerstruktur im Treeview anzeigen
von Spatzenkanonier
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: | 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: |
' 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.