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