Reference article:
https://zhuanlan.zhihu.com/p/91880547
Juche idea to write the code in accordance with article reference methods, but reference article is drawn using Direct2D, I use GDI + to draw. Add the selected elements when stacked the top of the code
effect:
Mouse Enter
Mouse to select
Dragging and drawing in stacking order
Translation
Zoom to mouse position as a center
Control code
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