Tipp-Upload: VB.NET 0155: VB2008 - FileDragDrop

Hinweis zum Tippvorschlag  

Dieser Vorschlag wurde noch nicht auf Sinn und Inhalt überprüft und die Zip-Datei wurde noch nicht auf schädlichen Inhalt hin untersucht.
Bitte haben Sie ein wenig Geduld, bis die Freigabe erfolgt.

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Sonstiges

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Extension, Extensions, Lambda, Linq, Xml, Linq to Xml

Der Vorschlag wurde erstellt am: 02.12.2007 10:38.
Die letzte Aktualisierung erfolgte am 03.12.2007 11:14.

Zurück zur Übersicht

Beschreibung  

Ein Treeview als DragnDrop-Clipboard für Dateisystem-Elemente. Man kann aus dem WinExplorer Elemente darauf ziehen, oder auch in Gegenrichtung (bewirkt Kopier-/Verschiebe -Vorgänge im Dateisystem). Außerdem kann die aktuelle Ansicht als Xml gespeichert werden.

Also im Grunde ein Hybrid aus !TU145 und !TU98
Der Tipp soll einige Features aus VB9 vorstellen: Extension-Functions, Lambda-Expressions, Linq-Syntax für Lambda-Expressions, Linq to Xml
Der Konstruktor mit With-Klausel kommt vor, und beide Varianten des neuen Immediate If()

Zum Studium von Linq empfehle ich sehr:
http://www.microsoft.com/downloads/details.aspx?FamilyID=e7fa5e3a-f8b2-4f77-bbcd-b5b978402dd1&displaylang=en

Anmerkungen können Sie hier unterbringen:
http://foren.activevb.de/cgi-bin/foren/view.pl?forum=6&root=58119&msg=58119

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [19,25 KB]

' Dieser Source 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!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ---------- Anfang Projektgruppe FileDragDrop.sln  ----------
' --------- Anfang Projektdatei FileDragDrop.vbproj  ---------
' ------------- Anfang Datei frmFileDragDrop.vb  -------------
' Projekteinstellungen:
' Option Strict On
' Option Explicit On
' Option Infer On
' Imports System.Windows.Forms
' Bibliothek "System.Xml.linq" eingebunden

Imports System.Text
Imports System.Xml
Imports System.Xml.Linq
Imports System.IO

Public Class frmFileDragDrop

    Const _File As String = "FileDragDropData.xml"

#Region "Init"

    Public Sub New()

        InitializeComponent()

        Me.TreeView1.TreeViewNodeSorter = New ComparisonComparer(Of TreeNode)(AddressOf _
            CompareNodes)

    End Sub

    Private Function CompareNodes(ByVal x As TreeNode, ByVal y As TreeNode) As Integer

        ' gruppierender Vergleich: zunächst ImageIndex, dann Alphabet
        ' dummerweise gibt es 2 Möglichkeiten, den ImageIndex festzulegen: per Key oder per Index
        With Me.ImageList1.Images

            CompareNodes = Math.Max(x.ImageIndex, .IndexOfKey(x.ImageKey)) .CompareTo( _
                Math.Max(y.ImageIndex, .IndexOfKey(y.ImageKey)))

            If CompareNodes <> 0 Then Exit Function ' ImageIndex-Vergleich bringt Ergebnis...
        End With

        Return String.Compare(x.Text, y.Text) ' ...sonst Stringvergleich returnen

    End Function

#End Region ' Init

#Region "DragDrop-Empfang"

    ' Im _DragOver muß durch Setzen von e.Effect festgelegt werden, welcher DropEffect
    ' momentan unterstützt wird. Hier: Entweder .None oder .Copy
    ' Bei nicht-festsetzen wird DragDropEffects.None angenommen, und es kommt nie zum Dropping
    Private Sub TreeView1_DragOver( _
                ByVal sender As Object, ByVal e As DragEventArgs) Handles TreeView1.DragOver

        With TryCast(e.Data, DataObject)

            If .IsSomething AndAlso .ContainsFileDropList Then
                e.Effect = DragDropEffects.Copy
            End If

        End With

    End Sub

    ' Im _DragDrop wird nach dem schlußendlich gültigen Drop-Effect verfahren. Dieses
    ' Beispiel braucht aber nicht auf verschiedene DropEffekte abzuprüfen, da nur
    ' DragDropEffects.Copy möglich ist.
    Private Sub TreeView1_DragDrop( _
                ByVal sender As Object, ByVal e As DragEventArgs) _
                Handles TreeView1.DragDrop

        ' Ein Problem bei Fehlern während des Droppens: Die Standard-Fehlerbehandlung der
        ' IDE (Meldung, Codestop) versagt.
        ' Um trotzdem irgendwie debuggen zu können hier ein händischer Codestop, von dem aus
        ' im Einzelschritt sich dem Fehler angenähert werden kann
#If DEBUG Then

        For I = 0 To 1

            Try

                ExecDragDrop(e)
                Return

            Catch ex As Exception

                ' Fehler aufgetreten. Im Debug-Mode kann der Vorgang im Einzelschrittmodus
                ' nochmal durchgangen werden
                Stop

            End Try

        Next

#Else

        Try

            ExecDragDrop(e)

        Catch ex As Exception

            MessageBox.Show(ex.ToString, "Fehler bei der Verarbeitung von " & _
                "TreeView1_DragDrop", MessageBoxButtons.OK, MessageBoxIcon.Error)

        End Try

#End If

    End Sub ' TreeView1_DragDrop

    Private Sub ExecDragDrop(ByVal e As DragEventArgs)

        ' e.Data.GetFileDropList() konvertieren zu: Items As IEnumerable(of String)
        Dim Items = DirectCast(e.Data, DataObject).GetFileDropList.Cast(Of String)()

        ' Pro Itm einen Treenode ermitteln oder erzeugen; den letzten davon sichtbar machen
        Items.Select(Function(Itm) FindOrCreateNode(Itm)).Last.EnsureVisible()

        ' 'Hm - meist finde ich die Lambda-Schreibweise der Linq-Syntax überlegen:
        ' Call (From Itm In Items Select FindOrCreateNode(Itm)).Last.EnsureVisible()
    End Sub

    ''' <summary>
    ''' sucht in TreeView1 nach dem durch FullPath bezeichneten TreeNode.
    ''' bei Nichtfinden einen erstellen, incl. der ihm übergeordneten Nodes
    ''' </summary>
    Private Function FindOrCreateNode(ByVal DroppedFullPath As String) As TreeNode

        Dim Segments = DroppedFullPath.TrimEnd("\"c, " "c).Split("\"c)
        Dim Approach = TreeView1.Nodes.Approach(Segments)

        If Approach.StepsDone = Segments.Length Then Return Approach.Node

        Dim CurrentNodes = If(Approach.Node Is Nothing, TreeView1.Nodes, Approach.Node.Nodes)

        ' HandledPath - Diese Nodes existieren schon
        Dim HandledPath = "\".Between(Segments.Take(Approach.StepsDone))

        Dim NewNode As TreeNode = Nothing

        For Each Segment As String In Segments.Skip(Approach.StepsDone) ' diese Nodes noch erzeugen
            HandledPath &= If(HandledPath.Length > 0, "\" & Segment, Segment)
            NewNode = CreateNode(HandledPath)

            ' eine Treenode-Ebene tiefer steigen
            CurrentNodes.Add(NewNode)
            CurrentNodes = NewNode.Nodes
        Next

        Return NewNode

    End Function ' EnsureFileSystemItem

#End Region ' DragDrop-Empfang

#Region "DragDrop-'Senden'"

    Private Sub TreeView1_ItemDrag( _
                ByVal sender As Object, ByVal e As ItemDragEventArgs) _
                Handles TreeView1.ItemDrag

        Dim Nd = DirectCast(e.Item, TreeNode)
        Dim DTO As New DataObject
        Dim Lst As New System.Collections.Specialized.StringCollection
        Dim FullPath = Nd.FullPath

        Lst.Add(FullPath)
        DTO.SetFileDropList(Lst)
        TreeView1.AllowDrop = False ' nicht auf sich selber droppen

        ' DoDragDrop ist eine blockierende Function - kehrt also erst zurück, wenn die
        ' Maustaste losgelassen wurde
        Dim Executed As DragDropEffects = TreeView1.DoDragDrop(DTO, DragDropEffects.All)

        TreeView1.AllowDrop = True

        Select Case Executed

            Case DragDropEffects.Copy

                ' nix tun, kopieren muß die Anwendung, auf die gedropt wurde

            Case DragDropEffects.Move

                ' Dieses funktioniert leider nicht.
                ' Bei DropEffekt.Move bekomme ich DropEffekt.None zurück
                Nd.Remove()

            Case DragDropEffects.None

                ' Also gucken wir, ob das FilesystemItem gelöscht wurde
                If (Not File.Exists(FullPath)) AndAlso (Not Directory.Exists(FullPath)) Then
                    Nd.Remove()
                End If

        End Select

    End Sub

#End Region ' DragDrop-'Senden'

#Region "TreeViewToXml"

    Private Sub BuildTreeNodes(ByVal Xel As XElement, ByVal Nodes As TreeNodeCollection)

        ' aufsteigende Achse umkehren, Root überspringen, Namen sammeln
        Dim Names = Xel.AncestorsAndSelf.Reverse.Skip(1).Select(Function(X) X.@Name)

        ' mit "\" zusammenfügen, daraus einen Treenode erstellen und adden
        Dim Nd = CreateNode("\".Between(Names)).AddTo(Nodes)

        For Each Child In Xel.Elements
            BuildTreeNodes(Child, Nd.Nodes)
        Next

        If Boolean.Parse(Xel.@IsExpanded) Then Nd.Expand()

    End Sub

    Private Sub BuildXml(ByVal Nodes As TreeNodeCollection, ByVal Xel As XElement)

        For Each Nd As TreeNode In Nodes

            ' Linq to Xml: ASP - ähnliche Syntax
            Dim Child = <Node Name=<%= Nd.Text %> IsExpanded=<%= Nd.IsExpanded %>/>

            Xel.Add(Child)
            BuildXml(Nd.Nodes, Child)
        Next

    End Sub

#End Region ' TreeViewToXml

    ''' <summary>bei RechtsKlick auf einen Node diesen entfernen</summary>
    Private Sub TreeView1_MouseDown( _
                ByVal sender As Object, ByVal e As MouseEventArgs) _
                Handles TreeView1.MouseDown

        If e.Button = Windows.Forms.MouseButtons.Right Then

            With TreeView1.GetNodeAt(e.Location)

                If .IsSomething Then .Remove()
            End With

        End If

    End Sub

    Private Sub MenuItem_Click(ByVal sender As Object, ByVal e As EventArgs) Handles _
                DeleteToolStripMenuItem.Click, _
                ReLoadToolStripMenuItem.Click, _
                SaveToolStripMenuItem.Click

        Select Case True

            Case sender Is DeleteToolStripMenuItem
                File.Delete(_File)

            Case sender Is ReLoadToolStripMenuItem

                Dim FullPath = Path.GetFullPath(_File)

                If Not File.Exists(FullPath) Then
                    MsgBox("'".ConcatWith(FullPath, "'", Lf, Lf, "could not be found"))
                    Return
                End If

                Dim Root = XElement.Load(FullPath)

                Me.TreeView1.Nodes.Clear()

                For Each Child In Root.Elements
                    BuildTreeNodes(Child, Me.TreeView1.Nodes)
                Next

            Case sender Is SaveToolStripMenuItem

                Dim Root = <Root/>

                BuildXml(TreeView1.Nodes, Root)
                Root.Save(_File)

        End Select

    End Sub

    Private Function CreateNode(ByVal FullPath As String) As TreeNode

        Dim NodeName = Path.GetFileName(FullPath)
        Dim sIcon As String

        If NodeName.Length = 0 Then
            NodeName = FullPath
            sIcon = "Drive.Ico"

        ElseIf Directory.Exists(FullPath) Then

            sIcon = "ClsdFold.Ico"

        ElseIf File.Exists(FullPath) Then

            sIcon = "File.Ico"

        Else

            Throw New ArgumentException(FullPath.ConcatWith(Lf, " existiert nicht!"))
        End If

        ' VB9: Instanzierung mit With-Klausel ist wesentlich flexibler und leserlicher als
        ' die Verwendung (mannigfach) überladener Konstruktoren
        ' Dumm nur, daß nur Properties angesprochen werden können, keine Public Fields
        Return New TreeNode() With { .Text = NodeName, .Name = NodeName, .ImageKey = sIcon, _
            .SelectedImageKey = sIcon}

    End Function

End Class

' -------------- Ende Datei frmFileDragDrop.vb  --------------
' ------------ Anfang Datei GenericExtensions.vb  ------------
Imports System.Runtime.CompilerServices
Imports System.Collections

Public Module GenericExtensions

    <Extension()> _
        Public Function IsSomething(Of T As Class)(ByVal Subj As T) As Boolean

        Return Subj IsNot Nothing

    End Function

    <Extension()> _
        Public Function IsNothing(Of T As Class)(ByVal Subj As T) As Boolean

        Return Subj Is Nothing

    End Function

    <Extension()> _
        Public Function AddTo(Of T)(ByVal Subj As T, ByVal Collection As IList) As T

        ' statt: Collection.Add(Obj)
        ' implementiere ich: Subj.AddTo(Collection)
        ' ermöglicht verkettete Aufrufe: Subj.AddTo(Col1).AddTo(Col2)
        Collection.Add(Subj)
        Return Subj

    End Function

    ''' <summary>
    ''' konvertiert eine Comparison in ein IComparer-implementierendes Objekt
    ''' </summary>
    ''' <remarks>selbst einen Delegaten kann man also erweitern</remarks>
    <Extension()> Public Function ToComparer(Of T)(ByVal Subj As Comparison(Of T)) As _
        ComparisonComparer(Of T)

        Return New ComparisonComparer(Of T)(Subj)

    End Function

    ''' <summary>IComparer-implementierender Wrapper um eine Comparison </summary>
    Public Class ComparisonComparer(Of T)

        Inherits Comparer(Of T)

        Private _Comparison As Comparison(Of T)

        Public Sub New(ByVal Comparison As Comparison(Of T))

            _Comparison = Comparison

        End Sub

        Public Overrides Function Compare(ByVal x As T, ByVal y As T) As Integer

            Return _Comparison(x, y)

        End Function

    End Class

End Module

' ------------- Ende Datei GenericExtensions.vb  -------------
' ----------------- Anfang Datei StringX.vb  -----------------
Imports System.Runtime.CompilerServices
Imports System.Collections

Public Module StringX

    Private _SB As New System.Text.StringBuilder

    <Extension()> Public Function ConcatWith(ByVal Subj As Object, ByVal ParamArray Args() As _
        Object) As String

        ' Quasi-Umbau von Shared String.Concat() in eine Object-Function
        Return Subj.ToString & String.Concat(Args)

    End Function

    <Extension()> Public Function Between(ByVal Delimiter As String, ByVal ParamArray Args() _
        As Object) As String

        Return Args.Join(Delimiter)

    End Function

    <Extension()> _
        Public Function Between(ByVal Delimiter As String, ByVal Args As IEnumerable) As String

        Return Args.Join(Delimiter)

    End Function

    ''' <summary>
    ''' entspricht in etwa String.Join(Sources(), Delimiter), mit dem Unterschied, dasses für 
    ''' alle Auflistungen anwendbar ist
    ''' </summary>
    <Extension()> _
        Private Function Join(ByVal Subj As IEnumerable, ByVal Delimiter As String) As String

        _SB.Remove(0, _SB.Length)

        With Subj.GetEnumerator

            If .MoveNext Then
                _SB.Append(If(.Current, "").ToString)

                While .MoveNext
                    _SB.Append(Delimiter).Append(If(.Current, "").ToString)

                End While

            Else

                Return ""
            End If

        End With

        Return _SB.ToString

    End Function

End Module

' ------------------ Ende Datei StringX.vb  ------------------
' ---------------- Anfang Datei TreeNodeX.vb  ----------------
Imports System.Runtime.CompilerServices

Public Module TreeNodeX

    Public Structure ApproachResult
        Public ReadOnly Node As TreeNode
        Public ReadOnly StepsDone As Integer

        Public Sub New(ByVal Node As TreeNode, ByVal StepsDone As Integer)

            Me.Node = Node
            Me.StepsDone = StepsDone

        End Sub

    End Structure

    ''' <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 
    ''' <seealso cref="ApproachResult"> ApproachResult, 
    ''' das den gefundenen Node enthält, und die Anzahl abgearbeiteter Segmente
    ''' </seealso>
    ''' </returns>
    <Extension()> Public Function Approach(ByVal Nodes As TreeNodeCollection, ByVal _
        PathSegments As IList(Of String)) As ApproachResult

        Dim Nd As TreeNode = Nothing

        For I = 0 To PathSegments.Count - 1

            If Nodes.ContainsKey(PathSegments(I)) Then
                Nd = Nodes(PathSegments(I)) ' Node per String-Key referenzieren.
                Nodes = Nd.Nodes

            Else

                Return New ApproachResult(Nd, I)
            End If

        Next

        Return New ApproachResult(Nd, PathSegments.Count)

    End Function

End Module

' ----------------- Ende Datei TreeNodeX.vb  -----------------
' ---------- Ende Projektdatei FileDragDrop.vbproj  ----------
' ----------- Ende Projektgruppe FileDragDrop.sln  -----------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.