Imports System.Drawing Imports System.Drawing.Drawing2D Imports System.Reflection Imports System.Runtime.CompilerServices Imports System.Runtime.InteropServices Imports System.Runtime.Serialization Imports System.Windows.Forms Imports Newtonsoft.Json Public Class PaintingObject Implements ICloneable, IPaintingObjectContainer Private resizeEngine As PaintingObjectResizing = Nothing Private _Selected As Boolean = False Private _Parent As PaintingControl = Nothing Public Property FillColor As Color = Color.Blue Public Property OutlineColor As Color = Color.DarkBlue Public Property OutlineThicknes As Single = 1 Public Property OutlineDashStyle As DashStyle = DashStyle.Solid Private _Text As String = "" Public Property TextPosition As TextPosition = TextPosition.FullCenter Public Property VerticalTextAlignment As StringAlignment = StringAlignment.Center Public Property HorizontalTextAlignment As StringAlignment = StringAlignment.Center Public Property TextFont As New Font(FontFamily.GenericSansSerif, 8.25) Public Property TextColor As Color = Color.Black Private _Location As New PointF(50, 50) Private _Size As New SizeF(50, 80) Public Property EnableFill As Boolean = True Public Property EnableOutline As Boolean = True Public Property SelectionColor As Color = Color.CornflowerBlue Public Property SelectionDashStyle As DashStyle = DashStyle.Dot Private _EnableSelection As Boolean = True Public Property Image As Image = Nothing Public Property BufferedImage As Image = Nothing Public Property ImageSizeMode As ImageSizeMode Public Property ImageProperties As New PaintingObjectImageProperties Public Property Tag As String = Nothing Public Property Name As String = "" Public ReadOnly Property PinnedObjects As New List(Of PaintingObject) Public ReadOnly Property DrawMethodes As New List(Of DelegateDrawPaintingObjectMethode) Public ReadOnly Property DrawSelectionMethode As DelegateDrawPaintingObjectMethode = AddressOf DefaultDrawMethodes.DrawSelection Public Property Cursor As Cursor = Cursors.Default Public Property HardcodedSize As Boolean = False Private _Visible As Boolean = True Private _AutoAlignToGrid As Boolean = False Public Property MouseTransparency As Boolean = False Public ReadOnly Property Layering As New PaintingObjectLayering(Me) Public ReadOnly Property PaintingObjects As New PaintingObjectList(_Parent) With {.EnableRaisingEvents = False} Public ReadOnly Property ErrorsAtDrawing As ULong = 0 Public Event MouseClick(sender As PaintingObject, e As MouseEventArgs) Public Event MouseDown(sender As PaintingObject, e As MouseEventArgs) Public Event MouseUp(sender As PaintingObject, e As MouseEventArgs) Public Event MouseMove(sender As PaintingObject, e As MouseEventArgs) Public Event SelectedChanged(sender As PaintingObject, e As EventArgs) Public Event Paint(sender As PaintingObject, e As PaintEventArgs) Public Event ParentChanged(sender As PaintingObject, e As EventArgs) Public Event VisibleChanged(sender As PaintingObject, e As EventArgs) Public Event Moved(sender As PaintingObject, e As EventArgs) Public Event Moving(sender As PaintingObject, e As EventArgs) Public Sub New() End Sub Public Sub New(type As PaintingObjectType) Me.Type = type End Sub Public Sub New(type As PaintingObjectType, drawMethodes As DelegateDrawPaintingObjectMethode()) Me.New(type) Me.DrawMethodes.AddRange(drawMethodes) End Sub Friend Sub RaiseMouseClick(e As MouseEventArgs) RaiseEvent MouseClick(Me, e) End Sub Friend Sub RaiseMouseDown(e As MouseEventArgs) RaiseEvent MouseDown(Me, e) End Sub Friend Sub RaiseMouseUp(e As MouseEventArgs) RaiseEvent MouseUp(Me, e) End Sub Friend Sub RaiseMouseMove(e As MouseEventArgs) RaiseEvent MouseMove(Me, e) End Sub Private Sub RaisePaint(e As PaintEventArgs) RaiseEvent Paint(Me, e) End Sub Friend Sub RaiseMoved(e As EventArgs) RaiseEvent Moved(Me, e) End Sub Friend Sub RaiseMoving(e As EventArgs) RaiseEvent Moving(Me, e) End Sub Public Property Type As PaintingObjectType Get Dim tt As PaintingObjectType = PaintingObjectType.Custom For Each d As DelegateDrawPaintingObjectMethode In DrawMethodes If d.Method.DeclaringType Is GetType(DefaultDrawMethodes) Then Select Case d.Method.Name Case "DrawPicture" tt = tt Or PaintingObjectType.Picture Case "DrawText" tt = tt Or PaintingObjectType.Text Case "DrawRectangle" tt = tt Or PaintingObjectType.Rectangle Case "DrawEllipse" tt = tt Or PaintingObjectType.Elipse Case "DrawTriangle" tt = tt Or PaintingObjectType.Triangle Case "DrawLine" tt = tt Or PaintingObjectType.Line End Select End If Next Return tt End Get Set(value As PaintingObjectType) DrawMethodes.Clear() If (value And PaintingObjectType.Picture) = PaintingObjectType.Picture Then DrawMethodes.Add(AddressOf DefaultDrawMethodes.DrawPicture) End If If (value And PaintingObjectType.Rectangle) = PaintingObjectType.Rectangle Then DrawMethodes.Add(AddressOf DefaultDrawMethodes.DrawRectangle) End If If (value And PaintingObjectType.Elipse) = PaintingObjectType.Elipse Then DrawMethodes.Add(AddressOf DefaultDrawMethodes.DrawEllipse) End If If (value And PaintingObjectType.Triangle) = PaintingObjectType.Triangle Then DrawMethodes.Add(AddressOf DefaultDrawMethodes.DrawTriangle) End If If (value And PaintingObjectType.Line) = PaintingObjectType.Line Then DrawMethodes.Add(AddressOf DefaultDrawMethodes.DrawLine) End If If (value And PaintingObjectType.Text) = PaintingObjectType.Text Then DrawMethodes.Add(AddressOf DefaultDrawMethodes.DrawText) End If End Set End Property Public Property Location As PointF Get If Parent IsNot Nothing Then Return New PointF(_Location.X * Parent.ZoomFactor.Width, _Location.Y * Parent.ZoomFactor.Height) Else Return _Location End If End Get Set(value As PointF) If Parent IsNot Nothing Then _Location = New PointF(value.X / Parent.ZoomFactor.Width, value.Y / Parent.ZoomFactor.Height) Else _Location = value End If End Set End Property Public Property Size As SizeF Get If Parent IsNot Nothing Then Return New SizeF(_Size.Width * Parent.ZoomFactor.Width, _Size.Height * Parent.ZoomFactor.Height) Else Return _Size End If End Get Set(value As SizeF) If Parent IsNot Nothing Then _Size = New SizeF(value.Width / Parent.ZoomFactor.Width, value.Height / Parent.ZoomFactor.Height) Else _Size = value End If ResetImageBuffer() End Set End Property Public Property SizeDirect As SizeF Get Return _Size End Get Set(value As SizeF) _Size = value ResetImageBuffer() End Set End Property Public Property AutoAlignToGrid As Boolean Get Return _AutoAlignToGrid End Get Set(value As Boolean) _AutoAlignToGrid = value If value Then ArrangeToGrid() End Set End Property Public ReadOnly Property IsResizing As Boolean Get If resizeEngine Is Nothing Then Return False Else Return resizeEngine?.IsResizing End If End Get End Property Public Property Parent As PaintingControl Get Return _Parent End Get Set(value As PaintingControl) Dim re As Boolean = value IsNot _Parent _Parent = value If re Then RaiseEvent ParentChanged(Me, New EventArgs) End Set End Property Public Property Visible As Boolean Get Return _Visible End Get Set(value As Boolean) If value <> _Visible Then _Visible = value If Not value AndAlso Not _EnableSelection Then EnableResize = False RaiseEvent VisibleChanged(Me, New EventArgs) End If End Set End Property Public Property Selected As Boolean Get Return _Selected End Get Set(value As Boolean) SetSelection(value, True) End Set End Property Public Property SelectedDirect As Boolean Get Return Selected End Get Set(value As Boolean) SetSelection(value, False) End Set End Property Private Sub SetSelection(value As Boolean, raiseEventOnParent As Boolean) If EnableSelection Then If _Selected <> value Then _Selected = value RaiseEvent SelectedChanged(Me, New EventArgs) If raiseEventOnParent Then Parent.RaiseSelectionChanged() End If End If Else _Selected = False End If End Sub Public Property Width As Single Get Return Size.Width End Get Set(value As Single) Size = New SizeF(value, Size.Height) End Set End Property Public Property Height As Single Get Return Size.Height End Get Set(value As Single) Size = New SizeF(Size.Width, value) End Set End Property Public Property X As Single Get Return Location.X End Get Set(value As Single) Location = New PointF(value, Location.Y) End Set End Property Public Property Y As Single Get Return Location.Y End Get Set(value As Single) Location = New PointF(Location.X, value) End Set End Property Public Property Text As String Get Return _Text End Get Set(value As String) _Text = value End Set End Property Public Property Rectangle As RectangleF Get Return New RectangleF(Location, Size) End Get Set(value As RectangleF) Location = value.Location Size = value.Size End Set End Property Public Property EnableSelection As Boolean Get Return _EnableSelection End Get Set(value As Boolean) _EnableSelection = value If Not value AndAlso Not _Visible Then EnableResize = False If Not value Then Selected = False End Set End Property Public Property RectangleExtended As Rectangle Get Return New Rectangle(X - 12, Y - 12, Width + 12 + 12, Height + 12 + 12) End Get Set(value As Rectangle) X = value.X + 12 Y = value.Y + 12 Width = value.Width - 12 - 12 Height = value.Height - 12 - 12 End Set End Property Public Sub FitSizeToText() If Parent Is Nothing Then Throw New Exception("You have to put that PaintingObject to a PaintingControl before.") End If Dim g As Graphics = Parent.CreateGraphics() Dim newSize As SizeF = g.MeasureString(Text, TextFont) SizeDirect = newSize + New SizeF(1, 0) End Sub Public Sub SetBounds(x As Integer, y As Integer, width As Integer, height As Integer) Location = New Point(x, y) Size = New Size(width, height) End Sub Public Property Left As Integer Get Return X End Get Set(value As Integer) X = value End Set End Property Public Property Top() As Integer Get Return Y End Get Set(value As Integer) Y = value End Set End Property Public Property Right As Integer Get Return X + Width End Get Set(value As Integer) X = value - Width End Set End Property Public Property Bottom() As Integer Get Return Y + Height End Get Set(value As Integer) Y = value - Height End Set End Property Public Property EnableResize As Boolean Get If resizeEngine Is Nothing Then Return False Else Return resizeEngine.Enabled End If End Get Set(value As Boolean) If resizeEngine Is Nothing AndAlso value Then resizeEngine = New PaintingObjectResizing(Me) ElseIf resizeEngine IsNot Nothing Then resizeEngine.Enabled = value End If End Set End Property Public Sub Remove() Parent?.PaintingObjects.Remove(Me) End Sub Public Sub AutoArrangeToGrid() If Parent?.GridEnabled AndAlso AutoAlignToGrid Then ArrangeToGrid() End If End Sub Public Sub ArrangeToGrid() If Parent IsNot Nothing Then Parent.ArrangeToGrid(Me) If Not Parent.StopDrawing Then Parent.Refresh() End If End Sub Public Sub Draw(e As PaintEventArgs) Draw(e, PointF.Empty) End Sub Public Sub Draw(e As PaintEventArgs, offset As PointF) Draw(e.Graphics, offset) If Visible Then RaisePaint(e) End If End Sub Public Sub Draw(g As Graphics, offset As PointF) If Visible Then Dim poevargs As New PaintingObjectPaintEventArgs(Me, g, offset) For Each dm As DelegateDrawPaintingObjectMethode In DrawMethodes Try dm?.Invoke(poevargs) Catch ex As Exception _ErrorsAtDrawing += 1 End Try Next If Selected AndAlso DrawSelectionMethode IsNot Nothing Then DrawSelectionMethode?.Invoke(poevargs) End If End If End Sub Public Function Clone() As Object Implements ICloneable.Clone Return Clone(True) End Function Public Function Clone(includePinnedObject As Boolean) As Object Dim obj As New PaintingObject Dim metype As Type = Me.GetType Dim blackField As String() = { NameOf(_PinnedObjects), NameOf(resizeEngine), NameOf(_Parent), NameOf(BufferedImage), NameOf(_ImageProperties) } Dim copyFields = Sub(source As Object, dest As Object, blackFields As String(), t As Type) Dim fields As New List(Of FieldInfo)(t.GetFields(BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.IgnoreCase Or BindingFlags.Instance)) For Each field As FieldInfo In fields If Not blackFields.Contains(field.Name) Then field.SetValue(dest, field.GetValue(source)) End If Next End Sub copyFields(Me, obj, blackField, metype) copyfields(ImageProperties, obj.ImageProperties, {}, ImageProperties.GetType) If includePinnedObject Then obj.PinnedObjects.AddRange(PinnedObjects) End If obj.EnableResize = EnableResize Return obj End Function Public Sub BringToFront() Layering.BringToTop() End Sub Public Sub SendToBack() Layering.SendToBack() End Sub Public Sub ResetImageBuffer() BufferedImage = Nothing End Sub End Class Public Class PaintingObjectList Inherits List(Of PaintingObject) Friend ReadOnly Property MyParent As PaintingControl Friend Property EnableRaisingEvents As Boolean = True Public ReadOnly Property Layering As New PaintingObjectListLayering(Me) Public Sub New() Me.New(Nothing) End Sub Public Sub New(parent As PaintingControl) MyParent = parent End Sub Public Overloads Sub Add(item As PaintingObject) item.Parent = myParent MyBase.Add(item) item.AutoArrangeToGrid() If EnableRaisingEvents Then MyParent?.RaisePaintingObjectAdded(New PaintingObjectEventArgs({item})) End If End Sub Public Overloads Sub AddRange(items As PaintingObject()) For Each item As PaintingObject In items item.Parent = myParent Next MyBase.AddRange(items) For Each item As PaintingObject In items item.AutoArrangeToGrid() Next If EnableRaisingEvents Then MyParent?.RaisePaintingObjectAdded(New PaintingObjectEventArgs(items)) End If End Sub Public Overloads Sub Insert(index As Integer, item As PaintingObject) item.Parent = myParent MyBase.Insert(index, item) myParent?.AutoArrangeToGrid() If EnableRaisingEvents Then MyParent?.RaisePaintingObjectAdded(New PaintingObjectEventArgs({item})) End If End Sub Public Overloads Sub Remove(item As PaintingObject) item.Parent = Nothing MyBase.Remove(item) If EnableRaisingEvents Then MyParent?.RaisePaintingObjectRemoved(New PaintingObjectEventArgs({item})) End If End Sub Public Overloads Sub RemoveAt(index As Integer) Me(index).Parent = Nothing Dim item As PaintingObject = Me(index) MyBase.RemoveAt(index) If EnableRaisingEvents Then MyParent?.RaisePaintingObjectRemoved(New PaintingObjectEventArgs({item})) End If End Sub End Class Public Enum PaintingObjectType Custom = 0 Text = 1 Picture = 2 Line = 4 Triangle = 8 Rectangle = 16 Elipse = 32 End Enum Public Enum ImageSizeMode Fit Zoom Original End Enum Public Enum TextPosition HLeft = &H1 HRight = &H2 HCenter = &H4 VUp = &H10 VDown = &H20 VCenter = &H40 FullCenter = HCenter Or VCenter End Enum