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