Modules/GUIs.ZooFlow/ClassDragDrop.vb
2021-10-26 11:45:10 +02:00

98 lines
3.9 KiB
VB.net

Imports DevExpress.XtraGrid
Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraGrid.Views.Grid.ViewInfo
Imports DigitalData.Modules.Logging
Public Class ClassDragDrop
Inherits Base.BaseClass
Private downHitInfo As GridHitInfo = Nothing
Private _Logger As Logger
Public Sub New(LogConfig As LogConfig)
MyBase.New(LogConfig)
End Sub
Public Sub AddGridView(view As GridView)
AddHandler view.MouseDown, AddressOf View_MouseDown
AddHandler view.MouseMove, AddressOf View_MouseMove
AddHandler view.GridControl.DragOver, AddressOf GridControl_DragOver
End Sub
Private Sub View_MouseDown(sender As Object, e As MouseEventArgs)
Dim view As GridView = sender
downHitInfo = Nothing
Dim hitInfo As GridHitInfo = view.CalcHitInfo(New Point(e.X, e.Y))
If Control.ModifierKeys <> Keys.None Then
Return
End If
If e.Button = MouseButtons.Left And hitInfo.RowHandle >= 0 Then
downHitInfo = hitInfo
End If
End Sub
Private Sub View_MouseMove(sender As Object, e As MouseEventArgs)
Try
Dim view As GridView = sender
Dim hitInfo As GridHitInfo = view.CalcHitInfo(New Point(e.X, e.Y))
If e.Button = MouseButtons.Left And Not IsNothing(downHitInfo) Then
Dim dragSize As Size = SystemInformation.DragSize
Dim dragRect As New Rectangle(New Point(downHitInfo.HitPoint.X - dragSize.Width / 2, downHitInfo.HitPoint.Y - dragSize.Height / 2), dragSize)
' DragRect ist ein kleines Rechteck, dessen Mitte der Punkt ist, wo die Maus geklickt wurde.
' Es soll verhindern, dass durch schnelles Klicken unbeabsichtigt Drag'n'Drop Operationen initiiert werden
' Siehe: https://msdn.microsoft.com/en-us/library/system.windows.forms.systeminformation.dragsize(v=vs.110).aspx
If Not dragRect.Contains(New Point(e.X, e.Y)) Then
' dragDropData enhält eine einzelne Row oder den kompletten View,
' jenachdem, wie die Drag'n'Drop Operation gestartet wurde.
Dim dragDropData As String
' Wenn keine Zeile markiert ist
If downHitInfo.RowHandle < 0 Then
Exit Sub
End If
' Wenn zwar eine Zeile markiert ist, aber keine über die Checkbox angehakt wurde,
' wird die markierte Zeile übergeben.
' Wenn 1 oder n Zeilen über die Checkbox angehakt wurde, werden diese übergeben
Dim row As DataRow = view.GetDataRow(downHitInfo.RowHandle)
Dim source As String = view.GridControl.Name
If Not IsNothing(row) Then
Try
dragDropData = row.Item("GUID") & "|" & source
view.GridControl.DoDragDrop(dragDropData, DragDropEffects.Move)
downHitInfo = Nothing
DevExpress.Utils.DXMouseEventArgs.GetMouseArgs(e).Handled = True
Catch ex As Exception
Logger.Error(ex)
End Try
End If
End If
End If
Catch ex As Exception
Logger.Error(ex)
MsgBox("Error in view_MouseMove: " & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Private Sub GridControl_DragOver(sender As Object, e As DragEventArgs)
If e.Data.GetDataPresent(DataFormats.Text) Then
Dim data As String = e.Data.GetData(DataFormats.Text)
Dim source = data.Split("|")(1)
Dim grid As GridControl = sender
If grid.Name <> source Then
e.Effect = DragDropEffects.Move
End If
Else
e.Effect = DragDropEffects.None
End If
End Sub
End Class