618 lines
19 KiB
VB.net
618 lines
19 KiB
VB.net
Imports System.ComponentModel
|
|
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
|
|
|
|
<Serializable> 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
|
|
<JsonIgnore> 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 Event MovingBeforePositionUpdated(sender As PaintingObject, e As CancelEventArgs)
|
|
|
|
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
|
|
Friend Sub RaiseMovingBeforePositionUpdated(e As EventArgs)
|
|
RaiseEvent MovingBeforePositionUpdated(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
|
|
|
|
<JsonIgnore> 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
|
|
|
|
<JsonIgnore> 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
|
|
|
|
<JsonIgnore> Public Property SizeDirect As SizeF
|
|
Get
|
|
Return _Size
|
|
End Get
|
|
Set(value As SizeF)
|
|
_Size = value
|
|
ResetImageBuffer()
|
|
End Set
|
|
End Property
|
|
|
|
<JsonIgnore> Public Property AutoAlignToGrid As Boolean
|
|
Get
|
|
Return _AutoAlignToGrid
|
|
End Get
|
|
Set(value As Boolean)
|
|
_AutoAlignToGrid = value
|
|
If value Then ArrangeToGrid()
|
|
End Set
|
|
End Property
|
|
|
|
<JsonIgnore> Public ReadOnly Property IsResizing As Boolean
|
|
Get
|
|
If resizeEngine Is Nothing Then
|
|
Return False
|
|
Else
|
|
Return resizeEngine?.IsResizing
|
|
End If
|
|
End Get
|
|
End Property
|
|
|
|
<JsonIgnore> 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
|
|
|
|
<JsonIgnore> 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
|
|
|
|
<JsonIgnore> 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
|
|
|
|
<JsonIgnore> 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
|
|
<JsonIgnore> 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
|
|
|
|
<JsonIgnore> 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
|
|
<JsonIgnore> 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
|
|
|
|
<JsonIgnore> 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
|
|
|
|
<JsonIgnore> 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
|
|
|
|
<JsonIgnore> 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
|
|
|
|
<JsonIgnore> Public Property Left As Integer
|
|
Get
|
|
Return X
|
|
End Get
|
|
Set(value As Integer)
|
|
X = value
|
|
End Set
|
|
End Property
|
|
|
|
<JsonIgnore> Public Property Top() As Integer
|
|
Get
|
|
Return Y
|
|
End Get
|
|
Set(value As Integer)
|
|
Y = value
|
|
End Set
|
|
End Property
|
|
|
|
<JsonIgnore> Public Property Right As Integer
|
|
Get
|
|
Return X + Width
|
|
End Get
|
|
Set(value As Integer)
|
|
X = value - Width
|
|
End Set
|
|
End Property
|
|
|
|
<JsonIgnore> 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, True)
|
|
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
|
|
|
|
<Obsolete("Use Layering.BringToTop() instead!")>
|
|
Public Sub BringToFront()
|
|
Layering.BringToTop()
|
|
End Sub
|
|
|
|
<Obsolete("Use Layering.SendToBack() instead!")>
|
|
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
|