Tipp-Upload: VB.NET 0371: DragnDrop innerhalb der Anwendung
von Spatzenkanonier
Ü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: 16.05.2009 19:11.
Die letzte Aktualisierung erfolgte am 22.05.2009 22:04.
Beschreibung
DragnDrop von einem ListenControl zu einem anderen stellt eine hervorragend intuitive und sichere Eingabe-Möglichkeit dar. Es stellt aber auch eine Reihe von Anforderungen an die programmierte Logik:
Als Datenquelle unzulässige Controls müssen ausgeschlossen werden.
Null-Items müssen ausgeschlossen werden.
Ein Item kann nicht in sich selbst oder direkt hinter sich abgelegt werden - bei Treenodes nicht in seinen Parent-Node.
Modifizier-Tasten (Shift/Control/Alt) müssen differenziert zugelassen, und dann auch richtig interpretiert werden
Der aktuell geltende DropEffect (Kopieren/Verschieben/Verknüpfen) muß jederzeit erkennbar sein
Das Ziel-Item muß gehighlighted werden
Diese Anforderungen gelten in fast jedem Fall, wo DragnDrop innerhalb einer Anwendung unterstützt werden soll.
Die Unterstützung des Frameworks für diese Anforderungen ist erstaunlich mangelhaft. Insbesondere das in den DragEventArgs gelieferte DataObjekt tut sich durch vollkommene Nutzlosigkeit hervor, und verleitet auch erfahrene Programmierer zu suboptimalen Lösungen.
Denn statt der amorphen Daten des Dataobjektes sind genau 4 Informationen für einen Drag-Vorgang von Belang:
- das Start-Control
- Position der Maus über dem StartControl zum Zeitpunkt des DragStarts
- das Ziel-Control
- Position der Maus über dem Ziel-Control zum Zeitpunkt des Droppens
Aus diesen Informationen kann in **jedem** Fall das gezogene Item ermittelt werden, und wo es hinsoll.
Die Umsetzung dessen, was der User mit dem Draggen "gemeint" hat, ist dann wieder Sache der eigentlichen Anwendungslogik, und individuell zu programmieren. Jedenfalls die erforderlichen Daten sind problemlos zu ermitteln, anhand des Zustandes der beteiligten Controls.
Andere Informationen (z.B. Text) zu übermitteln ist tendenziell unsicher, und erfordert weitere Vorkehrungen, denn ich kann Text auch im Editor markieren und auf die Anwendung ziehen.
Offensichtlich ist das Framework v.a. auf Draggen von anderen Anwendungen in die eigene hin konzipiert - hier gelten andere Bedingungen, und auch das DataObject macht einen guten Job.
Gewissermaßen skandalös die Tatsache, daß keine Exceptions verarbeitet werden, wenn während des Draggens (einschließlich Drop) Fehler auftreten! Die Anwendung läuft einfach weiter, und der User muß denken, er habe sich vertan.
Solche Fehler bleiben natürlich auch bei der Entwicklung leicht unbemerkt, und Debuggen wird zur sprichwörtlichen Käfer-Suche im Heuhaufen.
Die hier vorgestellte Unterstützung für anwendungs-internes Draggen löst das folgendermaßen:
Die Drop-Verarbeitung wird nicht im ursprünglichen Drop-Event durchgeführt, sondern danach, wenn der eigentliche Drag-Vorgang vollstängig abgeschlossen ist.
(Außerdem werden natürlich obige Anforderungen erfüllt.)
Die Sample-Application demonstriert Drag-Varianten zwischen Label, Treeview, Listbox und auch auf ein zweites Form, mit verschiedenen DropEffekts, assoziiert mit verschiedenen Modifizier-Tasten.
|
Schwierigkeitsgrad
|
Verwendete API-Aufrufe: |
Download: |
' 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 DragInApp.sln ------------ ' ----------- Anfang Projektdatei DragInApp.vbproj ----------- ' --------------- Anfang Datei DragDropper.vb --------------- ' IDE-Voreinstellungen: ' Option Strict On ' Option Explicit On ' Option Infer On ' Projekt-Voreinstellungen ' Imports System ' Imports System.Drawing ' Imports System.Windows.Forms ' Imports System.Collections.Generic ' Imports System.Linq ''' <summary> ''' kapselt die erforderlichen Funktionen eines DragTargets ''' </summary> Partial Public Class DragDropper ' in diese partial class ist versammelt, was ein DragDropper braucht, um das Drop-Event ' abzusetzen Public Event Drop As EventHandler(Of DropEventArgs) Private Sub OnDrop(ByVal e As DropEventArgs) RaiseEvent Drop(Me, e) End Sub Public Event ValidateDrop As EventHandler(Of ValidateDropEventArgs) Private Sub OnValidateDrop(ByVal e As ValidateDropEventArgs) Try RaiseEvent ValidateDrop(Me, e) Catch X As Exception #If DEBUG Then ' Da die IDE Fehler innerhalb von Dragging nicht fängt, hier ein gecodeter Codestop ' Die gelbe Markierung kann auf ValidateDrop(this, e) umgesetzt werden (Zeile anklicken, ' dann Strg-F9), und der ValidateDrop-Vorgang in Einzelschritten wiederholt System.Diagnostics.Debugger.Break() #End If ' Die Release bekommt eine Msgbox MessageBox.Show(X.ToString()) System.Diagnostics.Debugger.Break() End Try End Sub #Region "Vars" Private _Target As Control Private _AllowedEffects As New Dictionary(Of Control, DragDropEffects())() #End Region #Region "Initialisation" Public Sub New(ByVal DropTarget As Control) If DropTarget Is Nothing Then Throw New ArgumentNullException("DropTarget", "class DragDropper.ctor:" & vbLf & _ "Das zur Initialisierung angegebene Control ist null") End If _Target = DropTarget _Target.AllowDrop = True AddHandler _Target.DragDrop, AddressOf DropTarget_DragDrop AddHandler _Target.DragOver, AddressOf DropTarget_DragOver AddHandler _Target.DragLeave, AddressOf DropTarget_DragLeave End Sub Public Sub AddJob(ByVal Origin As Control, ByVal StandardEffect As DragDropEffects, _ Optional ByVal ShiftKeyEffect As DragDropEffects = DragDropEffects.None, _ Optional ByVal ControlKeyEffect As DragDropEffects = DragDropEffects.None, _ Optional ByVal AltKeyEffect As DragDropEffects = DragDropEffects.None) DragDropper.AddOrigin(Origin) _AllowedEffects.Add(Origin, New DragDropEffects() { StandardEffect, ShiftKeyEffect, _ ControlKeyEffect, ControlKeyEffect Or ShiftKeyEffect, AltKeyEffect, AltKeyEffect _ Or ShiftKeyEffect, AltKeyEffect Or ControlKeyEffect, AltKeyEffect Or _ ShiftKeyEffect Or ControlKeyEffect}) End Sub Public Sub RemoveJob(ByVal Origin As Control) DragDropper.RemoveOrigin(Origin) _AllowedEffects.Remove(Origin) End Sub #End Region #Region "processing DropTarget-Events" Private Sub DropTarget_DragLeave(ByVal sender As Object, ByVal e As EventArgs) Highlighter.Off() _HighlightDelay = Nothing End Sub Private Sub DropTarget_DragOver(ByVal sender As Object, ByVal e As DragEventArgs) If _CurrentOrigin Is Nothing OrElse Not _AllowedEffects.ContainsKey( _ _CurrentOrigin.Control) Then ' Dragging vom falschen Control ablehnen e.Effect = DragDropEffects.None Return End If Dim Index = Control.ModifierKeys >> 16 e.Effect = _AllowedEffects(_CurrentOrigin.Control)(Index) Dim Target As DragControl = Nothing Try Dim BoolDummi As Boolean = SetEffectAdvanced(e, Target, TryCast(sender, _ TreeView)) OrElse SetEffectAdvanced(e, Target, TryCast(sender, ListView)) _ OrElse SetEffectAdvanced(e, Target, TryCast(sender, DataGridView)) OrElse _ SetEffectAdvanced(e, Target, TryCast(sender, ListBox)) OrElse _ SetEffectAdvanced(e, Target, TryCast(sender, Control)) Catch X As Exception #If DEBUG Then ' Da die IDE Fehler innerhalb von Dragging nicht fängt, hier ein gecodeter Codestop ' Die gelbe Markierung kann auf SetEffectAdvanced() umgesetzt werden (Zeile anklicken, ' dann Strg-F9), und der Vorgang in Einzelschritten wiederholt System.Diagnostics.Debugger.Break() #End If ' Der Release spendierenwa im Fehlerfall 'ne Msgbox MessageBox.Show(X.ToString()) System.Diagnostics.Debugger.Break() End Try If e.Effect <> DragDropEffects.None Then _CurrentDrag = New ValidateDropEventArgs(_CurrentOrigin, Target, e.Effect) OnValidateDrop(_CurrentDrag) If _CurrentDrag.Cancel Then e.Effect = DragDropEffects.None End If End Sub Private Sub DropTarget_DragDrop(ByVal sender As Object, ByVal e As DragEventArgs) DropTarget_DragLeave(sender, e) _CurrentDragDropper = Me End Sub #End Region End Class ' partial class DragDropper ' ---------------- Ende Datei DragDropper.vb ---------------- ' --------------- Anfang Datei frmDragInApp.vb --------------- Public Class frmDragInApp Private WithEvents _TreeViewDropper As DragDropper Private WithEvents _ListboxDropper As DragDropper Private _frmDropTarget As New frmDropTarget() Public Sub New() InitializeComponent() Me.Location = Screen.PrimaryScreen.WorkingArea.Location TreeView1.Sorted = True TreeView1.ExpandAll() ' festlegen, von welchem Control mit welchen DropEffects auf welches Zielcontrol ' gezogen werden kann ' ZielControl: TreeView1 _TreeViewDropper = New DragDropper(Me.TreeView1) _TreeViewDropper.AddJob(lbError, DragDropEffects.Move) _TreeViewDropper.AddJob(Label1, DragDropEffects.Copy) ' beachte: DragDropEffects.Copy als 4.Argument assoziiert mittm Strg-Modifier ' (alle anderen DragJobs haben DragDropEffects.Copy auf Shift) _TreeViewDropper.AddJob(TreeView1, DragDropEffects.Move, , DragDropEffects.Copy) ' ZielControl: Listbox1 _ListboxDropper = New DragDropper(Me.Listbox1) _ListboxDropper.AddJob(Label1, DragDropEffects.Copy) _ListboxDropper.AddJob(Listbox1, DragDropEffects.Move, DragDropEffects.Copy) _ListboxDropper.AddJob(TreeView1, DragDropEffects.Move, DragDropEffects.Copy) ' ZielControl: _frmDropTarget _frmDropTarget.DragDropper.AddJob(Me.Label1, DragDropEffects.Move, DragDropEffects.Copy) _frmDropTarget.DragDropper.AddJob(Me.lbError, DragDropEffects.Move, DragDropEffects.Copy) ' statisches Event AddHandler DragDropper.ValidateDragStart, AddressOf DragDropper_ValidateDragStart End Sub Private Sub DragDropper_ValidateDragStart(ByVal e As DragDropper.ValidateDragEventArgs) If e.Origin.Control Is Me.TreeView1 Then ' Besonderheit: für die ersten beiden Nodes soll nur DragDropEffects.Copy möglich sein Dim Indx As Integer = Me.TreeView1.Nodes.IndexOf(Me.TreeView1.GetNodeAt(e.Origin.Mouse)) If Indx >= 0 AndAlso Indx < 2 Then e.Allowed = DragDropEffects.Copy End If End Sub Private Sub ckEnableLBTVDrop_CheckedChanged(ByVal sender As Object, ByVal e As EventArgs) _ Handles ckEnableLBTVDrop.CheckedChanged, ckDropTargetForm.CheckedChanged Dim checked = DirectCast(sender, CheckBox).Checked Select Case True Case sender Is ckEnableLBTVDrop If checked Then _TreeViewDropper.AddJob(Listbox1, DragDropEffects.Move, DragDropEffects.Copy) Else _TreeViewDropper.RemoveJob(Listbox1) End If Case sender Is ckDropTargetForm _frmDropTarget.Visible = checked End Select End Sub Private Sub _ListboxDropper_Drop(ByVal Sender As Object, ByVal e As _ DragDropper.DropEventArgs) Handles _ListboxDropper.Drop If e.Origin.Control Is Listbox1 Then Dim Indx As Integer = e.Origin.Index Listbox1.Items.Insert(e.Target.Index, Listbox1.Items(Indx)) If e.Effect = DragDropEffects.Move Then If e.Target.Index < Indx Then Indx += 1 Listbox1.Items.RemoveAt(Indx) End If ElseIf e.Origin.Control Is Label1 Then Listbox1.Items.Insert(e.Target.Index, Label1.Name) ElseIf e.Origin.Control Is TreeView1 Then Dim ndOrigin As TreeNode = TreeView1.GetNodeAt(e.Origin.Mouse) Listbox1.Items.Insert(e.Target.Index, ndOrigin.Text) If e.Effect = DragDropEffects.Move Then ndOrigin.CutOut() End If End Sub Private Sub _TreeViewDropper_Drop(ByVal Sender As Object, ByVal e As _ DragDropper.DropEventArgs) Handles _TreeViewDropper.Drop Dim ndTarget As TreeNode = TreeView1.GetNodeAt(e.Target.Mouse) Dim Nodes As TreeNodeCollection = If(ndTarget Is Nothing, TreeView1.Nodes, ndTarget.Nodes) If e.Origin.Control Is Listbox1 Then Dim Indx As Integer = e.Origin.Index Nodes.Add(Listbox1.Items(Indx).ToString()) If e.Effect = DragDropEffects.Move Then Listbox1.Items.RemoveAt(Indx) End If ElseIf e.Origin.Control Is Label1 Then Nodes.Add(Label1.Name) ElseIf e.Origin.Control Is lbError Then Nodes.Add(TryCast(DirectCast(lbError, Object), TreeNode)) ElseIf e.Origin.Control Is TreeView1 Then Dim ndOrigin As TreeNode = TreeView1.GetNodeAt(e.Origin.Mouse) If e.Effect = DragDropEffects.Move Then ndOrigin.Remove() Nodes.Add(ndOrigin) Else Nodes.Add(ndOrigin.CloneByText()) End If End If If ndTarget IsNot Nothing Then ndTarget.Expand() End Sub ''' <summary> ''' bei Rechtsklick auf einen Treenode diesen entfernen, Children in den Parent hängen ''' </summary> Private Sub TreeView1_NodeMouseClick(ByVal sender As Object, ByVal e As _ TreeNodeMouseClickEventArgs) Handles TreeView1.NodeMouseClick If e.Button = MouseButtons.Right Then e.Node.CutOut() End Sub End Class ' ---------------- Ende Datei frmDragInApp.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 If Not (TypeOf Target Is TreeView) Then ItemRect.Offset(0, -ItemRect.Height \ 2) ItemRect.Inflate(0, -2) End If 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 HighlightAfter(ByVal Target As Control, ByVal ItemRect As Rectangle) ItemRect.Offset(0, ItemRect.Height) Highlight(Target, ItemRect) End Sub Public Shared Sub HighlightRow(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 ---------------- ' ------------ Anfang Datei DragDropper.Nested.vb ------------ Imports System.Windows.Forms Imports System.Drawing Imports System.ComponentModel Imports System.Collections.Generic Partial Public Class DragDropper ''' <summary> ''' eine spezielle Art von Set: Das erste Incrementieren eines Objekts nimmt es ins Dictionary, ''' weitere Hinzufügungen desselben Objekts (per Increment()) stellen nur einen Zähler hoch. ''' </summary> Private Class CountingSet(Of T) Inherits Dictionary(Of T, Integer) Public Function Increment(ByVal Key As T) As Integer If Not MyBase.ContainsKey(Key) Then MyBase.Add(Key, 1) Return 1 End If Dim RetVal As Integer = Me(Key) + 1 Me(Key) = RetVal Return RetVal End Function Public Function Decrement(ByVal Key As T) As Integer Dim RetVal As Integer = Me(Key) - 1 If RetVal = 0 Then MyBase.Remove(Key) Else Me(Key) = RetVal End If Return RetVal End Function End Class ''' <summary> ''' DragControl ist der Baustein, aus dem die EventArgs aufgebaut sind ''' Es speichert ein Control, die Mausposition darüber, und, bei ''' Listen-Controls Index des Items unter der Maus ''' </summary> Public Class DragControl Public ReadOnly Control As Control Public ReadOnly Mouse As Point Private ReadOnly _Index As Integer Public Sub New(ByVal Control As Control, ByVal Mouse As Point, ByVal Index As Integer) Me.Control = Control Me.Mouse = Mouse Me._Index = Index End Sub Public ReadOnly Property Index() As Integer Get If TypeOf Control Is TreeView Then Throw New NotImplementedException("class DragControl.Index:" & vbLf & _ "Beim TreeView kann der Index nicht sinnvoll angegeben werden") End If Return _Index End Get End Property End Class Public Class DropEventArgs Inherits EventArgs Public ReadOnly Origin As DragControl Public ReadOnly Target As DragControl Public ReadOnly Effect As DragDropEffects Public Sub New(ByVal Origin As DragControl, ByVal Target As DragControl, ByVal Effect _ As DragDropEffects) Me.Origin = Origin Me.Target = Target Me.Effect = Effect End Sub End Class Public Class ValidateDragEventArgs Inherits EventArgs Public ReadOnly Origin As DragControl Public Allowed As DragDropEffects Public Sub New(ByVal Origin As DragControl, ByVal Allowed As DragDropEffects) Me.Origin = Origin Me.Allowed = Allowed End Sub End Class Public Class ValidateDropEventArgs Inherits DropEventArgs Public Cancel As Boolean = False Public Sub New(ByVal Origin As DragControl, ByVal Target As DragControl, ByVal Effect _ As DragDropEffects) MyBase.New(Origin, Target, Effect) End Sub End Class End Class ' ------------- Ende Datei DragDropper.Nested.vb ------------- ' ------ Anfang Datei DragDropper.SetEffectAdvanced.vb ------ Imports System.Collections.Generic Imports System.Drawing Imports System.Windows.Forms Partial Public Class DragDropper ' SetEffectAdvanced enthält in verschiedenen Überladungen für verschiedene Controls die ' Ermittlung der Item, die Festsetzung des aktuell gültigen DropEffekts (abgestimmt mit ' den Modifizier-Tasten), und das Highlighten der Ziel-Items Private _HighlightDelay As Nullable(Of Boolean) Private Function SetEffectAdvanced(ByVal e As DragEventArgs, ByRef Target As DragControl, _ ByVal TV As TreeView) As Boolean If TV Is Nothing Then Return False Dim ptTarget As Point = TV.PointToClient(New Point(e.X, e.Y)) Dim ndTarget As TreeNode = TV.GetNodeAt(ptTarget) If _CurrentOrigin.Control Is TV Then If Not _HighlightDelay.HasValue Then ' Nach dem ersten DragOver gibt es noch einen Zeichnungsvorgang für den ' Drag-Origin-Node. ' Das gäbe aber'n Konflikt mittm Highlighter, der also dieses erste Mal aussetzt. _HighlightDelay = True End If If e.Effect = DragDropEffects.Move Then ' Spezialfall "SelfDrag bei DragEffect.Move": der TreeNode darf nicht in ' seinen Parent, sich selbst oder seine Children abgelegt werden Dim ndOrigin As TreeNode = TV.GetNodeAt(_CurrentOrigin.Mouse) If ndOrigin.Parent Is ndTarget Then e.Effect = DragDropEffects.None Else Dim Nd As TreeNode = ndTarget While Nd IsNot Nothing If ndOrigin Is Nd Then e.Effect = DragDropEffects.None Exit While End If Nd = Nd.Parent End While End If End If End If If _HighlightDelay.HasValue AndAlso _HighlightDelay.Value Then _HighlightDelay = False ElseIf ndTarget IsNot Nothing Then Highlighter.Highlight(TV, ndTarget.Bounds) Else ' Ablage auf oberster Ebene, nicht in einem Treenode Dim Y As Integer = 0 Dim n As Integer = TV.GetNodeCount(False) If n > 0 Then Dim Nd As TreeNode = TV.Nodes(n - 1) While Nd IsNot Nothing Y = Nd.Bounds.Bottom Nd = Nd.NextVisibleNode End While End If Highlighter.HighlightRow(TV, Y, TV.ItemHeight) End If Target = New DragControl(TV, ptTarget, -1) Return True End Function Private Function SetEffectAdvanced(ByVal e As DragEventArgs, ByRef Target As DragControl, _ ByVal LV As ListView) As Boolean If LV Is Nothing Then Return False Dim ptTarget As Point = LV.PointToClient(New Point(e.X, e.Y)) Dim itmTarget As ListViewItem = LV.GetItemAt(ptTarget.X, ptTarget.Y) Dim TargetIndex As Integer = If(itmTarget Is Nothing, LV.Items.Count, itmTarget.Index) If _CurrentOrigin.Control Is LV AndAlso e.Effect = DragDropEffects.Move Then ' Spezialfall "SelfDrag bei DragEffect.Move": Item nicht auf sich selbst oder ' Nachfolger legen Dim DeltaIndex As Integer = _CurrentOrigin.Index - TargetIndex If DeltaIndex = 0 OrElse DeltaIndex = -1 Then e.Effect = DragDropEffects.None End If End If If LV.Items.Count = 0 Then Highlighter.HighlightRow(LV, 0, 16) ElseIf TargetIndex = LV.Items.Count Then Highlighter.HighlightAfter(LV, LV.Items(TargetIndex - 1).Bounds) Else Highlighter.Highlight(LV, itmTarget.Bounds) End If Target = New DragControl(LV, ptTarget, TargetIndex) Return True End Function Private Function SetEffectAdvanced(ByVal e As DragEventArgs, ByRef Target As DragControl, _ ByVal Grid As DataGridView) As Boolean If Grid Is Nothing Then Return False Dim ptTarget As Point = Grid.PointToClient(New Point(e.X, e.Y)) Dim HTI As DataGridView.HitTestInfo = Grid.HitTest(ptTarget.X, ptTarget.Y) Dim TargetIndex As Integer = If(HTI.RowIndex < 0, Grid.RowCount, HTI.RowIndex) If _CurrentOrigin.Control Is Grid AndAlso e.Effect = DragDropEffects.Move Then ' Spezialfall "SelfDrag bei DragEffect.Move": Item nicht auf sich selbst oder ' Nachfolger legen Dim DeltaIndex As Integer = _CurrentOrigin.Index - TargetIndex If DeltaIndex = 0 OrElse DeltaIndex = -1 Then e.Effect = DragDropEffects.None End If End If If 0 = Grid.RowCount Then Highlighter.HighlightRow(Grid, 0, Grid.RowTemplate.Height) ElseIf TargetIndex = Grid.RowCount Then Highlighter.HighlightAfter(Grid, Grid.GetRowDisplayRectangle(TargetIndex - 1, True)) Else Highlighter.Highlight(Grid, Grid.GetRowDisplayRectangle(TargetIndex, True)) End If Target = New DragControl(Grid, ptTarget, TargetIndex) Return True End Function Private Function SetEffectAdvanced(ByVal e As DragEventArgs, ByRef Target As DragControl, _ ByVal Lst As ListBox) As Boolean If Lst Is Nothing Then Return False Dim ptTarget As Point = Lst.PointToClient(New Point(e.X, e.Y)) Dim TargetIndex As Integer = Lst.IndexFromPoint(ptTarget) If TargetIndex < 0 Then TargetIndex = Lst.Items.Count If _CurrentOrigin.Control Is Lst AndAlso e.Effect = DragDropEffects.Move Then ' Spezialfall "SelfDrag bei DragEffect.Move": Item nicht auf sich selbst oder ' Nachfolger legen Dim DeltaIndex As Integer = _CurrentOrigin.Index - TargetIndex If DeltaIndex = 0 OrElse DeltaIndex = -1 Then e.Effect = DragDropEffects.None End If End If If 0 = Lst.Items.Count Then Highlighter.HighlightRow(Lst, 0, Lst.ItemHeight) ElseIf TargetIndex = Lst.Items.Count Then Highlighter.HighlightAfter(Lst, Lst.GetItemRectangle(TargetIndex - 1)) Else Highlighter.Highlight(Lst, Lst.GetItemRectangle(TargetIndex)) End If Target = New DragControl(Lst, ptTarget, TargetIndex) Return True End Function Private Function SetEffectAdvanced(ByVal e As DragEventArgs, ByRef Target As DragControl, _ ByVal Ctl As Control) As Boolean Dim ptTarget As Point = Ctl.PointToClient(New Point(e.X, e.Y)) Target = New DragControl(Ctl, ptTarget, -1) Return True End Function End Class ' ------- Ende Datei DragDropper.SetEffectAdvanced.vb ------- ' ------------ Anfang Datei DragDropper.Shared.vb ------------ Imports System.Drawing Imports System.Collections.Generic Imports System.Windows.Forms Public Delegate Sub SingletonEventHandler(Of T As EventArgs)(ByVal e As T) Partial Public Class DragDropper ' diese partial class enthält nur static Member. Auch das Event ValidateDrag ist public Shared. Public Shared Event ValidateDragStart As SingletonEventHandler(Of ValidateDragEventArgs) Public Const AllAllowed As DragDropEffects = DragDropEffects.Copy Or DragDropEffects.Link _ Or DragDropEffects.Move Or DragDropEffects.Scroll #Region "Vars" Private Shared _Origins As New CountingSet(Of Control)() Private Shared _CurrentDragDropper As DragDropper = Nothing Private Shared _CurrentOrigin As DragControl Private Shared _CurrentDrag As ValidateDropEventArgs Private Shared _MouseDownArgs As MouseEventArgs = Nothing Private Shared _DumData As New DataObject() ' erf. als Dummi-Arg für Origin.DoDragDrop() #End Region Private Shared Sub AddOrigin(ByVal Origin As Control) If _Origins.Increment(Origin) = 1 Then AddHandler Origin.MouseDown, AddressOf Origin_MouseDown AddHandler Origin.MouseMove, AddressOf Origin_MouseMove End If End Sub Private Shared Sub RemoveOrigin(ByVal Origin As Control) If _Origins.Decrement(Origin) = 0 Then RemoveHandler Origin.MouseDown, AddressOf Origin_MouseDown RemoveHandler Origin.MouseMove, AddressOf Origin_MouseMove End If End Sub #Region "processing Origin-Events" Private Shared Sub Origin_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) If e.Button = MouseButtons.Left Then _MouseDownArgs = e End Sub Private Shared Sub Origin_MouseMove(ByVal sender As Object, ByVal [me] As MouseEventArgs) If _MouseDownArgs IsNot Nothing Then If [me].Button = MouseButtons.Left Then ' Mouse-Move mit gedrückter Links-taste: Dragging starten ' für Multi-Item-Controls erstmal checken, ob ein Item unter der Maus ist Dim StartIndex As Integer = 0 Dim pt = _MouseDownArgs.Location If TypeOf sender Is ListBox Then StartIndex = DirectCast(sender, ListBox).IndexFromPoint(pt) ElseIf TypeOf sender Is ListView Then Dim itmOrigin As ListViewItem = DirectCast(sender, ListView).GetItemAt( _ pt.X, pt.Y) StartIndex = If(itmOrigin Is Nothing, -1, itmOrigin.Index) ElseIf TypeOf sender Is TreeView Then Dim ndOrigin As TreeNode = DirectCast(sender, TreeView).GetNodeAt(pt) StartIndex = If(ndOrigin Is Nothing, -1, ndOrigin.Index) ElseIf TypeOf sender Is DataGridView Then StartIndex = DirectCast(sender, DataGridView).HitTest(pt.X, pt.Y).RowIndex End If Dim ctlOrigin As Control = DirectCast(sender, Control) _CurrentOrigin = New DragControl(ctlOrigin, [me].Location, StartIndex) Dim e As New ValidateDragEventArgs(_CurrentOrigin, If(StartIndex < 0, _ DragDropEffects.None, AllAllowed)) RaiseEvent ValidateDragStart(e) If e.Allowed <> DragDropEffects.None Then ctlOrigin.DoDragDrop(_DumData, e.Allowed) If _CurrentDragDropper IsNot Nothing Then _CurrentDragDropper.OnDrop(_CurrentDrag) _CurrentDragDropper = Nothing End If End If _CurrentOrigin = Nothing End If _MouseDownArgs = Nothing End If End Sub #End Region End Class' partial class DragDropper ' ------------- Ende Datei DragDropper.Shared.vb ------------- ' -------------- Anfang Datei frmDropTarget.vb -------------- Public Class frmDropTarget ' den DragDropper public machen, daß man DragJobs adden kann. Public ReadOnly DragDropper As DragDropper Public Sub New() InitializeComponent() Me.DragDropper = New DragDropper(Me) AddHandler DragDropper.Drop, AddressOf DragDropper_Drop End Sub Private Sub DragDropper_Drop(ByVal sender As Object, ByVal e As DragDropper.DropEventArgs) MessageBox.Show(String.Concat("empfange Drag von ", e.Origin.Control.Name, vbLf, _ "Übermittelter DropEffekt: ", e.Effect)) e.Origin.Control.Parent = Me End Sub End Class ' --------------- Ende Datei frmDropTarget.vb --------------- ' ---------------- Anfang Datei TreenodeX.vb ---------------- Imports System.Runtime.CompilerServices Public Module TreenodeX ''' <summary> ''' Node entfernen, seine Childnodes in den Parent verschieben ''' </summary> <Extension()> _ Public Sub CutOut(ByVal Nd As TreeNode) Dim Nodes As TreeNodeCollection = If(Nd.Parent Is Nothing, Nd.TreeView.Nodes, _ Nd.Parent.Nodes) For i = Nd.Nodes.Count - 1 To 0 Step -1 Dim ndChild As TreeNode = Nd.Nodes(i) ndChild.Remove() Nodes.Add(ndChild) Next Nd.Remove() End Sub <Extension()> _ Public Function CloneByText(ByVal Nd As TreeNode) As TreeNode Dim RetVal As New TreeNode(Nd.Text) For Each ndChild As TreeNode In Nd.Nodes RetVal.Nodes.Add(CloneByText(ndChild)) Next RetVal.Expand() Return RetVal End Function End Module ' ----------------- Ende Datei TreenodeX.vb ----------------- ' ------------ Ende Projektdatei DragInApp.vbproj ------------ ' ------------- Ende Projektgruppe DragInApp.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.