Die Community zu .NET und Classic VB.
Menü

Tipp-Upload: VB.NET 0372: DragnDrop bei Multi-Selection

 von 

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

  • Listensteuerelemente
  • Steuerelemente

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
drag

Der Vorschlag wurde erstellt am: 21.05.2009 10:22.
Die letzte Aktualisierung erfolgte am 26.05.2009 13:36.

Zurück zur Übersicht

Beschreibung  

Manchmal will man mehrere Items gleichzeitig draggen. Bei Listbox oder DataGridView stößt man auf das Problem, daß die Multi-Selection in eine Einzel-Selektion umspringt, sobald die Maus gedrückt wird, um den Ziehvorgang zu beginnen.
(Beim ListView dagegen ist es einfach, dort springt die Selektion erst beim MouseUp um.)
Hier der WorkAround: Wann immer sich die Selektion ändert, werden die selektierten Items gespeichert, und zu Beginn des DragVorgangs wird die Multi-Selektion eben wieder hergestellt.
Für komplexere Drag-Szenarien siehe auch  Tippvorschlag 371

Schwierigkeitsgrad

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

Download:

Download des Beispielprojektes [14,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 MultiDrag.sln ------------
' ----------- Anfang Projektdatei MultiDrag.vbproj -----------
' --------------- Anfang Datei frmMultiDrag.vb ---------------
' IDE-Voreinstellungen:
' Option Strict On
' Option Explicit On
' Option Infer On

' Projekt-Voreinstellungen
' Imports System
' Imports System.Drawing
' Imports System.Windows.Forms

Public Class frmMultiDrag

    ' Draggen innerhalb einer Anwendung ist ohne DataObject einfacher und sicherer
    ' Aber Control.DoDragDrop() verlangt eines
    Private Shared _dumData As New DataObject

    ' im Grunde kann bei .DoDragDrop() nur AllEffects angegeben werden, denn beim Drag-Start kann
    ' der AllowedEffekt nicht eingeschränkt werden: Derselbe Ziehvorgang kann auf dem einen
    ' ZielControl ausschließlich .Copy erfordern, und auf dem anderen ausschließlich .Move.
    ' Es gibt zwar einen DragDropEffects.All, aber wenn man den verwendet, kann
    ' DragDropEffects.Link nicht eingestellt werden.
    Private Shared _allEffects As DragDropEffects = DragDropEffects.Move Or _
        DragDropEffects.Copy Or DragDropEffects.Link Or DragDropEffects.Scroll

    Private _src, _dest As ListBox
    Private _indxs(-1) As Integer

    Public Sub New()

        InitializeComponent()
        Me.Location = Screen.PrimaryScreen.WorkingArea.Location

    End Sub

    Private Sub ListBox_SelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs) _
        Handles ListBox1.SelectedIndexChanged, ListBox2.SelectedIndexChanged, _
        ListBox3.SelectedIndexChanged

        If _src IsNot Nothing Then Return
        SaveIndicees(DirectCast(sender, ListBox))

    End Sub

    ' ggfs. Dragvorgang starten, und Ergebnis umsetzen (Das _Drop-Event ist für die Umsetzung der
    ' gemeinten Drag-Aktion ungeeignet, da auftretende Fehler nicht gemeldet werden.)
    Private Sub ListBox_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
              Handles ListBox1.MouseMove, ListBox2.MouseMove, ListBox3.MouseMove

        If e.Button <> Windows.Forms.MouseButtons.Left Then Return
        _src = DirectCast(sender, ListBox)

        ' die durch das MouseDown verlorengegangene MultiSelektion wieder herstellen
        For Each i In _indxs
            _src.SetSelected(i, True)
        Next

        ' vereinfachtes Szenario: Drag-Source von vornherein als Drag-Ziel ausschließen
        _src.AllowDrop = False

        Try

            Dim effect = _src.DoDragDrop(_dumData, _allEffects)

            If effect = DragDropEffects.None Then Return

            Dim iDest = _dest.IndexFromPoint(_dest.PointToClient(Control.MousePosition))

            If iDest < 0 Then iDest = _dest.Items.Count

            For i = _src.SelectedIndices.Count - 1 To 0 Step -1

                Select Case effect

                    Case DragDropEffects.Move
                        _dest.Items.Insert(iDest, _src.SelectedItems(i))
                        _src.Items.RemoveAt(_src.SelectedIndices(i))

                    Case DragDropEffects.Copy
                        _dest.Items.Insert(iDest, _src.SelectedItems(i))

                    Case DragDropEffects.Link

                        _dest.Items.Insert(iDest, String.Concat("linked with: ", _
                            _src.SelectedItems(i)))

                End Select

            Next

        Finally

            ' Aufräum-Arbeiten
            _src.AllowDrop = True
            Highlighter.Off()
            SaveIndicees(_src)
            _src = Nothing

        End Try

    End Sub

    ' Hier wird der DropEffect gesetzt. Dazu zähle ich auch das Highlighten des Ziel-Items
    Private Sub ListBox_DragOver(ByVal sender As Object, ByVal e As DragEventArgs) _
              Handles ListBox1.DragOver, ListBox2.DragOver, ListBox3.DragOver

        If _src Is Nothing Then Return ' Dragvorgänge fremder Anwendungen ablehnen
        _dest = DirectCast(sender, ListBox)

        Select Case Control.ModifierKeys

            Case Keys.None
                e.Effect = DragDropEffects.Move

            Case Keys.Shift
                e.Effect = DragDropEffects.Copy

            Case Keys.Control
                e.Effect = DragDropEffects.Link

            Case Else
                e.Effect = DragDropEffects.None
                Return

        End Select

        Dim pt = New Point(e.X, e.Y)

        If _dest.Items.Count = 0 Then
            Highlighter.FullWidth(_dest, 0, _dest.ItemHeight)

        Else

            Dim i = _dest.IndexFromPoint(_dest.PointToClient(pt))

            If i < 0 Then
                Highlighter.After(_dest, _dest.GetItemRectangle(_dest.Items.Count - 1))

            Else

                Highlighter.Before(_dest, _dest.GetItemRectangle(i))
            End If
        End If

    End Sub

    Private Sub ListBox_DragLeave(ByVal sender As Object, ByVal e As EventArgs) _
              Handles ListBox1.DragLeave, ListBox2.DragLeave, ListBox3.DragLeave

        Highlighter.Off()

    End Sub

    Private Sub SaveIndicees(ByVal lst As ListBox)

        ReDim _indxs(lst.SelectedIndices.Count - 1)
        lst.SelectedIndices.CopyTo(_indxs, 0)

    End Sub

End Class

' ---------------- Ende Datei frmMultiDrag.vb ----------------
' --------------- Anfang Datei Highlighter.vb  ---------------
Imports System.Drawing
Imports System.Windows.Forms

'''<summary> Zum Highlighten von Treenodes, ListviewItems etc. </summary>
Public Class Highlighter

    ' Das Highlighten erfolgt durch Farb-Inversion des Target-Rectangles. Ausschalten
    ' des Highlights durch wiederholte Inversion desselben Rectangles. Fehl-Highlighting
    ' ergibt sich also, wenn zwischen Highlight() und Off() das Rectangle anderweitig
    ' übermalt wurde.

    Protected Shared _HighlightedRect As Rectangle = Rectangle.Empty

    ' Farb-Inversion ist eine Art "Spiegelung" über eine Farb-Achse.
    ' Dieses komische Rot ergibt (bisher) immer deutliche "Spiegel-Farben"
    Private Shared ReadOnly _AxisColor As Color = Color.FromArgb(255, 0, 127)

    Public Shared Sub Highlight(ByVal Target As Control, ByVal ItemRect As Rectangle)

        If ItemRect.IsEmpty Then
            Highlighter.Off()

        Else

            ItemRect.Intersect(Target.ClientRectangle)

            ' FillReversibleRectangle verwendet bildschirmbezogene Koordinaten, daher muß ItemRect
            ' um die Bildschirmposition des Controls verschoben werden
            ItemRect.Offset(Target.PointToScreen(Point.Empty))

            If ItemRect.IntersectsWith(_HighlightedRect) Then Return

            ' ist schon highlighted
            If Not _HighlightedRect.IsEmpty Then

                ' altes Highlight löschen
                ControlPaint.FillReversibleRectangle(_HighlightedRect, _AxisColor)
            End If

            _HighlightedRect = ItemRect

            ' neues Highlight setzen
            ControlPaint.FillReversibleRectangle(ItemRect, _AxisColor)
        End If

    End Sub

    Public Shared Sub Before(ByVal Target As Control, ByVal ItemRect As Rectangle)

        ItemRect.Offset(0, -ItemRect.Height \ 2)
        ItemRect.Inflate(0, -2)
        Highlight(Target, ItemRect)

    End Sub

    Public Shared Sub After(ByVal Target As Control, ByVal ItemRect As Rectangle)

        ItemRect.Offset(0, ItemRect.Height)
        Before(Target, ItemRect)

    End Sub

    Public Shared Sub FullWidth(ByVal Target As Control, ByVal Y As Integer, ByVal Height As _
        Integer)

        Highlighter.Highlight(Target, New Rectangle(0, Y, Target.Width, Height))

    End Sub

    Public Shared Sub Off()

        If _HighlightedRect.IsEmpty Then Return
        ControlPaint.FillReversibleRectangle(_HighlightedRect, _AxisColor)
        _HighlightedRect = Rectangle.Empty

    End Sub

End Class

' ---------------- Ende Datei Highlighter.vb  ----------------
' ------------ Ende Projektdatei MultiDrag.vbproj ------------
' ------------- Ende Projektgruppe MultiDrag.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.