This repository has been archived by the owner on Sep 11, 2023. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 0
/
DragHelper.vb
145 lines (122 loc) · 4.81 KB
/
DragHelper.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
' Developer Express Code Central Example:
' How to replace the cursor with a thumbnail image while dragging a row in GridView
'
' This example demonstrates how to replace the standard cursor with a transparent
' image of the dragged row during a drag-and-drop operation in GridView
'
' You can find sample updates and versions for different programming languages here:
' http://www.devexpress.com/example=E2735
Imports Microsoft.VisualBasic
Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports DevExpress.XtraGrid
Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraGrid.Views.Grid.ViewInfo
Imports DevExpress.XtraGrid.Views.Grid.Drawing
Namespace SwapRows
Public Class DragHelper
Private downHitInfo As GridHitInfo = Nothing
Private imageHelper As DragImageHelper
Private _View As GridView
Public Sub New(ByVal view As GridView)
_View = view
SubscribeEvents(view)
imageHelper = New DragImageHelper(view)
End Sub
Private Sub SubscribeEvents(ByVal view As GridView)
AddHandler view.MouseDown, AddressOf view_MouseDown
AddHandler view.MouseMove, AddressOf view_MouseMove
AddHandler view.GridControl.DragOver, AddressOf GridControl_DragOver
AddHandler view.MouseUp, AddressOf view_MouseUp
AddHandler view.GridControl.GiveFeedback, AddressOf GridControl_GiveFeedback
AddHandler view.GridControl.Paint, AddressOf GridControl_Paint
End Sub
Private Sub GridControl_Paint(ByVal sender As Object, ByVal e As PaintEventArgs)
If downHitInfo Is Nothing Then
Return
End If
Dim grid As GridControl = CType(sender, GridControl)
Dim view As GridView = CType(grid.MainView, GridView)
Dim isBottomLine As Boolean = DropTargetRowHandle = view.DataRowCount
Dim viewInfo As GridViewInfo = TryCast(view.GetViewInfo(), GridViewInfo)
Dim rowInfo As GridRowInfo = viewInfo.GetGridRowInfo(If(isBottomLine, DropTargetRowHandle - 1, DropTargetRowHandle))
If rowInfo Is Nothing Then
Return
End If
Dim p1, p2 As Point
If isBottomLine Then
p1 = New Point(rowInfo.Bounds.Left, rowInfo.Bounds.Bottom - 1)
p2 = New Point(rowInfo.Bounds.Right, rowInfo.Bounds.Bottom - 1)
Else
p1 = New Point(rowInfo.Bounds.Left, rowInfo.Bounds.Top - 1)
p2 = New Point(rowInfo.Bounds.Right, rowInfo.Bounds.Top - 1)
End If
Dim pen As New Pen(Color.Blue, 3)
e.Graphics.DrawLine(pen, p1, p2)
End Sub
Private Sub GridControl_GiveFeedback(ByVal sender As Object, ByVal e As GiveFeedbackEventArgs)
If downHitInfo IsNot Nothing Then
e.UseDefaultCursors = False
Cursor.Current =_dragRowCursor
End If
End Sub
Private Sub view_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)
downHitInfo = Nothing
End Sub
Private dropTargetRowHandle_Renamed As Integer
Private Property DropTargetRowHandle() As Integer
Get
Return dropTargetRowHandle_Renamed
End Get
Set(ByVal value As Integer)
dropTargetRowHandle_Renamed = value
_View.Invalidate()
End Set
End Property
Private Sub GridControl_DragOver(ByVal sender As Object, ByVal e As DragEventArgs)
Dim grid As GridControl = CType(sender, GridControl)
Dim pt As New Point(e.X, e.Y)
pt = grid.PointToClient(pt)
Dim view As GridView = TryCast(grid.GetViewAt(pt), GridView)
If view Is Nothing Then
Return
End If
Dim hitInfo As GridHitInfo = view.CalcHitInfo(pt)
If hitInfo.HitTest = GridHitTest.EmptyRow Then
DropTargetRowHandle = view.DataRowCount
Else
DropTargetRowHandle = hitInfo.RowHandle
End If
If DropTargetRowHandle >= 0 AndAlso e.Data.GetDataPresent(GetType(String)) Then
e.Effect = DragDropEffects.Move
Else
e.Effect = DragDropEffects.None
End If
End Sub
Private _dragRowCursor As Cursor
Private Sub view_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
Dim view As GridView = TryCast(sender, GridView)
If e.Button = MouseButtons.Left AndAlso downHitInfo IsNot Nothing 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)
If (Not dragRect.Contains(New Point(e.X, e.Y))) Then
_dragRowCursor = imageHelper.GetDragCursor(downHitInfo.RowHandle, e.Location)
view.GridControl.DoDragDrop(downHitInfo, DragDropEffects.All)
downHitInfo = Nothing
End If
End If
End Sub
Private Sub view_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
Dim view As GridView = TryCast(sender, GridView)
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 AndAlso hitInfo.InRow AndAlso hitInfo.RowHandle <> GridControl.NewItemRowHandle Then
downHitInfo = hitInfo
End If
End Sub
End Class
End Namespace