参考文章:
https://zhuanlan.zhihu.com/p/91880547
代码主体思想按照参考文章里的方法写的,不过参考文章是用Direct2D绘制的,我使用GDI+绘制的. 添加了层叠时选中最高层元素的代码
效果:
鼠标进入
鼠标选中
拖拽及按照层叠顺序绘制
平移
以鼠标位置为中心缩放
控件代码
1 Imports System.Drawing.Drawing2D
2
3 Public Class BOMAttributeList
4 Inherits Control
5
6 Private Shared SizeWidth = 100
7 Private Shared SizeHeight = 100
8
9 Public Property DataSource As List(Of String)
10 Get
11 Return (From item In DrawItems
12 Select item.Name).ToList
13 End Get
14 Set
15 DrawItems.Clear()
16 DrawItems.AddRange(From item In Value
17 Select New RenderingAttribute() With {
18 .Name = item,
19 .Locantion = New Point((SizeHeight + 0) * (Value.IndexOf(item) Mod 32),
20 (SizeWidth + 0) * (Value.IndexOf(item) \ 32)
21 ),
22 .Size = New Size(SizeWidth, SizeHeight),
23 .LayerIndex = 0
24 })
25 End Set
26 End Property
27
28 Private DrawItems As New List(Of RenderingAttribute)
29
30 Public Sub New()
31 Me.Dock = DockStyle.Fill
32 Me.BackColor = Color.FromArgb(215, 215, 215)
33 Me.DoubleBuffered = True
34 End Sub
35
36 Private SelectDrawItem As RenderingAttribute
37
38 Private Shared ReadOnly BorderPen = New Pen(Color.FromArgb(51, 51, 51))
39 Private Shared ReadOnly ContainsBorderPen = New Pen(Color.FromArgb(221, 101, 114), 2)
40 Private Shared ReadOnly BackgroundSolidBrush = New SolidBrush(Color.FromArgb(84, 89, 98))
41 Private Shared ReadOnly ContainsBackgroundSolidBrush = New SolidBrush(Color.Green)
42 Private Shared ReadOnly FontSolidBrush = New SolidBrush(Color.FromArgb(215, 215, 215))
43
44 Private Sub BOMAttributeList_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
45 e.Graphics.Transform = WorldTransform
46
47 Dim TopDrawItem As RenderingAttribute = Nothing
48
49 For Each item In DrawItems.OrderBy(Function(value As RenderingAttribute) As Integer
50 Return value.LayerIndex
51 End Function)
52
53 If item.Contains(MousePoint) AndAlso
54 (TopDrawItem Is Nothing OrElse TopDrawItem.LayerIndex < item.LayerIndex) Then
55
56 TopDrawItem = item
57 End If
58
59 Next
60
61 For Each item In DrawItems.OrderBy(Function(value As RenderingAttribute) As Integer
62 Return value.LayerIndex
63 End Function)
64
65 If item IsNot SelectDrawItem Then
66 e.Graphics.FillRectangle(BackgroundSolidBrush, item.Locantion.X, item.Locantion.Y, item.Size.Width, item.Size.Height)
67 Else
68 e.Graphics.FillRectangle(ContainsBackgroundSolidBrush, item.Locantion.X, item.Locantion.Y, item.Size.Width, item.Size.Height)
69 End If
70
71 If TopDrawItem Is item Then
72 e.Graphics.DrawRectangle(ContainsBorderPen,
73 item.Locantion.X + 1,
74 item.Locantion.Y + 1,
75 item.Size.Width - 2,
76 item.Size.Height - 2)
77 Else
78 e.Graphics.DrawRectangle(BorderPen,
79 item.Locantion.X,
80 item.Locantion.Y,
81 item.Size.Width - 1,
82 item.Size.Height - 1)
83 End If
84
85
86 e.Graphics.DrawString($"{item.Name}
87 位置:{item.Locantion.X},{item.Locantion.Y}", Me.Font, FontSolidBrush, item.Locantion.X + 2, item.Locantion.Y + 2)
88
89 If item.Contains(MousePoint) AndAlso
90 (TopDrawItem Is Nothing OrElse TopDrawItem.LayerIndex < item.LayerIndex) Then
91
92 TopDrawItem = item
93 End If
94
95 Next
96
97 End Sub
98
99 Private WorldTransform As Matrix = New Matrix
100 Private TransformScale As Double = 1.0
101
102 Private Sub BOMAttributeList_MouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel
103 If (TransformScale < 0.1 AndAlso e.Delta < 0) OrElse
104 (TransformScale > 20 AndAlso e.Delta > 0) Then
105
106 Exit Sub
107 End If
108
109 Dim Scale = Math.Pow(1.1F, e.Delta / 120.0F)
110 TransformScale *= Scale
111
112 If Scale < 1 Then
113 '缩小
114 WorldTransform.Translate((e.X - WorldTransform.OffsetX) * (1 - Scale),
115 (e.Y - WorldTransform.OffsetY) * (1 - Scale),
116 MatrixOrder.Append)
117 Else
118 '放大
119 WorldTransform.Translate(-(e.X - WorldTransform.OffsetX) * (Scale - 1),
120 -(e.Y - WorldTransform.OffsetY) * (Scale - 1),
121 MatrixOrder.Append)
122 End If
123
124 WorldTransform.Scale(Scale, Scale)
125
126 Me.Refresh()
127
128 End Sub
129
130 Private MousePoint As Point
131 Private TranslateMousePoint As Point
132
133 Private Sub BOMAttributeList_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
134 If e.Button = MouseButtons.Left Then
135
136 Dim tmpMousePoint As New Point((e.Location.X - WorldTransform.OffsetX) / TransformScale,
137 (e.Location.Y - WorldTransform.OffsetY) / TransformScale)
138
139 Dim TopDrawItem As RenderingAttribute = Nothing
140 For Each item In DrawItems
141 If item.Contains(tmpMousePoint) Then
142 If TopDrawItem Is Nothing OrElse
143 TopDrawItem.LayerIndex < item.LayerIndex Then
144
145 TopDrawItem = item
146 End If
147 End If
148 Next
149
150 If TopDrawItem Is Nothing Then
151 Exit Sub
152 End If
153
154 SelectDrawItem = TopDrawItem
155 TopDrawItem.LayerIndex = DrawItems.Max(Function(value As RenderingAttribute) As Integer
156 Return value.LayerIndex
157 End Function) + 1
158
159 For Each item In DrawItems
160 item.MousePoint = Nothing
161 Next
162
163 SelectDrawItem.MousePoint = tmpMousePoint
164 SelectDrawItem.OriginLocantion = SelectDrawItem.Locantion
165
166 ElseIf e.Button = MouseButtons.Right Then
167 TranslateMousePoint = e.Location
168 End If
169
170 End Sub
171
172 Private Sub BOMAttributeList_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
173 MousePoint.X = (e.Location.X - WorldTransform.OffsetX) / TransformScale
174 MousePoint.Y = (e.Location.Y - WorldTransform.OffsetY) / TransformScale
175
176 For Each item In DrawItems
177 If item.MousePoint <> Nothing Then
178 item.Locantion = item.OriginLocantion + MousePoint - item.MousePoint
179 Exit For
180 End If
181 Next
182
183 If e.Button = MouseButtons.Right Then
184 WorldTransform.Translate(e.Location.X - TranslateMousePoint.X,
185 e.Location.Y - TranslateMousePoint.Y,
186 MatrixOrder.Append)
187
188 TranslateMousePoint = e.Location
189
190 End If
191
192 Me.Refresh()
193 End Sub
194
195 Private Sub BOMAttributeList_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
196 For Each item In DrawItems
197 item.MousePoint = Nothing
198 Next
199 End Sub
200
201 Private Sub BOMAttributeList_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
202 If e.KeyCode = Keys.Space Then
203 WorldTransform.Reset()
204 TransformScale = 1
205 Me.Refresh()
206 End If
207 End Sub
208
209 #Region "键盘移动"
210 Protected Overrides Function ProcessCmdKey(ByRef msg As Message, keyData As Keys) As Boolean
211 If SelectDrawItem IsNot Nothing Then
212 Select Case keyData
213 Case Keys.Up
214 SelectDrawItem.Locantion.Y -= 1
215 Me.Refresh()
216 Return True
217 Case Keys.Down
218 SelectDrawItem.Locantion.Y += 1
219 Me.Refresh()
220 Return True
221 Case Keys.Left
222 SelectDrawItem.Locantion.X -= 1
223 Me.Refresh()
224 Return True
225 Case Keys.Right
226 SelectDrawItem.Locantion.X += 1
227 Me.Refresh()
228 Return True
229 End Select
230 End If
231
232 Return MyBase.ProcessCmdKey(msg, keyData)
233
234 End Function
235 #End Region
236
237 End Class
来源：https://www.cnblogs.com/707wk/p/12180323.html