687 lines
24 KiB
VB.net
687 lines
24 KiB
VB.net
Imports System.ComponentModel
|
|
Imports System.Drawing
|
|
Imports System.Drawing.Drawing2D
|
|
Imports System.Runtime.CompilerServices
|
|
Imports System.Windows.Forms
|
|
Imports Pilz.Drawing
|
|
|
|
Public Class PaintingControl
|
|
Inherits UserControl
|
|
Implements IPaintingObjectContainer
|
|
|
|
Private curObjMouseDown As PaintingObject = Nothing
|
|
Private bgColor As Color = Color.White
|
|
Private startMousePos As Point = Nothing
|
|
Private lastMousePos As Point = Nothing
|
|
Private lastHashCode As Integer = 0
|
|
Private calcOffset_MouseOnTab As Point = Point.Empty
|
|
Private calcOffset_IsActive As Boolean = False
|
|
Private calcOffset_LastOffset As PointF = PointF.Empty
|
|
|
|
Private Overloads Property ForeColor As Color
|
|
Private Overloads Property Font As Font
|
|
Private Overloads Property Text As String
|
|
|
|
Public Property Offset As PointF = PointF.Empty
|
|
Public ReadOnly Property PaintingObjects As New PaintingObjectList(Me)
|
|
'Public Property EnableRealTransparency As Boolean = False
|
|
Public Property VisibleForMouseEvents As Boolean = True
|
|
Public Property AutoAreaSelection As Boolean = True
|
|
Public Property AutoSingleSelection As Boolean = True
|
|
Public Property AutoMultiselection As Boolean = True
|
|
Public Property AutoRemoveSelection As Boolean = True
|
|
Public Property AreaSelectionDashStyle As DashStyle = DashStyle.DashDot
|
|
Public Property AreaSelectionColor As Color = Color.CornflowerBlue
|
|
Public Property AutoMoveObjects As Boolean = True
|
|
Private _IsAreaSelecting As Boolean = False
|
|
Public ReadOnly Property IsMovingObjects As Boolean = False
|
|
Public Property GridEnabled As Boolean = True
|
|
Public Property GridVisible As Boolean = False
|
|
Public Property GridChunkSize As New Size(20, 20)
|
|
Public Property GridColor As Color = Color.LightGray
|
|
Public Property DrawGridMethode As DelegateDrawPaintingControlGridMethode = AddressOf DefaultDrawMethodes.DrawGrid
|
|
Public Property DrawAreaSelectionMethode As DelegateDrawPaintingControlAreaSelectionMethode = AddressOf DefaultDrawMethodes.DrawAreaSelection
|
|
Private _ZoomFactor As New SizeF(1, 1)
|
|
|
|
Private _stopDrawing As Integer = -1
|
|
Private bufferedImg As Image = Nothing
|
|
|
|
Private pressedShift As Boolean = False
|
|
Private pressedControl As Boolean = False
|
|
Private pressedAlt As Boolean = False
|
|
|
|
'Friend WithEvents HScrollBarAdv1 As DevComponents.DotNetBar.ScrollBar.HScrollBarAdv
|
|
'Friend WithEvents VScrollBarAdv1 As DevComponents.DotNetBar.VScrollBarAdv
|
|
|
|
Private savedPos As New Dictionary(Of PaintingObject, PointF)
|
|
|
|
Public Event SelectionChanged(sender As Object, e As PaintingObjectEventArgs)
|
|
Public Event PaintingObjectAdded(sender As Object, e As PaintingObjectEventArgs)
|
|
Public Event PaintingObjectRemoved(sender As Object, e As PaintingObjectEventArgs)
|
|
Public Event AfterScrollingDone(sender As Object, e As EventArgs)
|
|
Public Event ZoomFactorChanged(sender As Object, e As EventArgs)
|
|
|
|
Public ReadOnly Property SelectedObjects As PaintingObject()
|
|
Get
|
|
Dim objs As New List(Of PaintingObject)
|
|
|
|
For Each obj As PaintingObject In PaintingObjects
|
|
If obj.Selected Then
|
|
objs.Add(obj)
|
|
End If
|
|
Next
|
|
|
|
Return objs.ToArray
|
|
End Get
|
|
End Property
|
|
|
|
Public ReadOnly Property IsLayoutSuspended As Boolean
|
|
Get
|
|
Return CInt(Me.GetType.GetField("layoutSuspendCount", Reflection.BindingFlags.Instance Or Reflection.BindingFlags.NonPublic).GetValue(Me)) <> 0
|
|
End Get
|
|
End Property
|
|
|
|
Public ReadOnly Property StopDrawing As Boolean
|
|
Get
|
|
Return _stopDrawing > -1
|
|
End Get
|
|
End Property
|
|
|
|
Public Overrides Property BackColor As Color
|
|
Get
|
|
Return bgColor
|
|
End Get
|
|
Set(value As Color)
|
|
bgColor = value
|
|
MyBase.BackColor = value
|
|
'If value <> Color.Transparent Then
|
|
' MyBase.BackColor = value
|
|
'End If
|
|
End Set
|
|
End Property
|
|
Public ReadOnly Property IsAreaSelecting As Boolean
|
|
Get
|
|
Return _IsAreaSelecting AndAlso startMousePos <> lastMousePos
|
|
End Get
|
|
End Property
|
|
Public Property ZoomFactor As SizeF
|
|
Get
|
|
Return _ZoomFactor
|
|
End Get
|
|
Set
|
|
If _ZoomFactor <> Value Then
|
|
_ZoomFactor = Value
|
|
ResetAllBufferedImages()
|
|
RaiseEvent ZoomFactorChanged(Me, New EventArgs)
|
|
End If
|
|
End Set
|
|
End Property
|
|
|
|
Public Sub New()
|
|
'SetStyle(ControlStyles.Opaque, True) 'For real transparency
|
|
DoubleBuffered = True
|
|
End Sub
|
|
|
|
Private Sub ResetAllBufferedImages()
|
|
For Each ob As PaintingObject In PaintingObjects
|
|
ob.ResetImageBuffer()
|
|
Next
|
|
Refresh()
|
|
End Sub
|
|
|
|
Private Sub CheckKeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
|
|
If e.Shift Then pressedShift = True
|
|
If e.Control Then pressedControl = True
|
|
If e.Alt Then pressedAlt = True
|
|
End Sub
|
|
|
|
Private Sub CheckKeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
|
|
If e.Shift Then pressedShift = False
|
|
If e.Control Then pressedControl = False
|
|
If e.Alt Then pressedAlt = False
|
|
End Sub
|
|
|
|
Friend ReadOnly Property AreaSelectionRectangle As RectangleF
|
|
Get
|
|
Return HelpfulDrawingFunctions.GetRectangle(startMousePos, lastMousePos)
|
|
End Get
|
|
End Property
|
|
|
|
Private Sub CheckMouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick
|
|
For Each obj As PaintingObject In GetObjects(New Point(e.X + Offset.X, e.Y + Offset.Y))
|
|
If Not obj.MouseTransparency Then
|
|
obj.RaiseMouseClick(GetMouseEventArgs(e, obj))
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Private Sub CheckMouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
|
|
lastMousePos = New Point(e.X + Offset.X, e.Y + Offset.Y)
|
|
|
|
curObjMouseDown = GetObjects(lastMousePos).Where(Function(n) Not n.MouseTransparency).LastOrDefault
|
|
curObjMouseDown?.RaiseMouseDown(GetMouseEventArgs(e, curObjMouseDown))
|
|
|
|
If curObjMouseDown Is Nothing OrElse Not curObjMouseDown.Selected OrElse pressedControl Then
|
|
Dim hasMovedObjects As Boolean = False
|
|
If _IsMovingObjects Then
|
|
For Each obj As PaintingObject In GetSelectedObjects()
|
|
If HelpfulDrawingFunctions.IsPointInRectangle(lastMousePos, obj.Rectangle) Then
|
|
hasMovedObjects = True
|
|
Exit For
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
If (Not hasMovedObjects) AndAlso (Not _IsAreaSelecting) Then
|
|
Dim selChanged As New List(Of PaintingObject)
|
|
|
|
If AutoRemoveSelection AndAlso Not pressedControl Then
|
|
For Each obj As PaintingObject In PaintingObjects
|
|
If obj.Selected Then
|
|
obj.SelectedDirect = False
|
|
If Not selChanged.Contains(obj) Then
|
|
selChanged.Add(obj)
|
|
End If
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
If AutoSingleSelection AndAlso curObjMouseDown IsNot Nothing Then
|
|
Dim objtosel As PaintingObject = curObjMouseDown
|
|
If objtosel.EnableSelection Then
|
|
objtosel.SelectedDirect = Not objtosel.Selected
|
|
If Not selChanged.Contains(objtosel) Then
|
|
selChanged.Add(objtosel)
|
|
Else
|
|
selChanged.Remove(objtosel)
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
RaiseEvent SelectionChanged(Me, New PaintingObjectEventArgs(selChanged.ToArray))
|
|
End If
|
|
End If
|
|
|
|
If pressedAlt Then
|
|
|
|
calcOffset_MouseOnTab = New Point(e.X, e.Y)
|
|
calcOffset_LastOffset = Offset
|
|
calcOffset_IsActive = True
|
|
Cursor = Cursors.Arrow
|
|
|
|
Else
|
|
|
|
Select Case e.Button
|
|
Case MouseButtons.Left
|
|
savedPos.Clear()
|
|
If AutoMoveObjects Then
|
|
SaveObjectPositions(e, GetSelectedObjects)
|
|
End If
|
|
If savedPos.Count > 0 Then
|
|
_IsMovingObjects = True
|
|
ElseIf AutoAreaSelection Then
|
|
startMousePos = New Point(e.X + Offset.X, e.Y + Offset.Y)
|
|
lastMousePos = startMousePos 'New Point(e.X - Offset.X, e.Y - Offset.Y)
|
|
_IsAreaSelecting = True
|
|
End If
|
|
End Select
|
|
|
|
End If
|
|
End Sub
|
|
Public Sub RaiseSelectionChanged()
|
|
RaiseEvent SelectionChanged(Me, New PaintingObjectEventArgs(SelectedObjects))
|
|
End Sub
|
|
Private Sub CheckMouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
|
|
If _IsAreaSelecting Then
|
|
_IsAreaSelecting = False
|
|
End If
|
|
|
|
If _IsMovingObjects Then
|
|
_IsMovingObjects = False
|
|
For Each obj As PaintingObject In GetSelectedObjects()
|
|
obj.RaiseMoved(New EventArgs)
|
|
Next
|
|
AutoArrangeToGrid()
|
|
End If
|
|
|
|
If curObjMouseDown IsNot Nothing Then
|
|
If Not curObjMouseDown.MouseTransparency Then
|
|
curObjMouseDown.RaiseMouseUp(GetMouseEventArgs(e, curObjMouseDown))
|
|
End If
|
|
curObjMouseDown = Nothing
|
|
End If
|
|
|
|
If calcOffset_IsActive Then
|
|
calcOffset_IsActive = False
|
|
Cursor = Cursors.Default
|
|
CalcNewOffset(e.Location)
|
|
RaiseEvent AfterScrollingDone(Me, New EventArgs)
|
|
End If
|
|
End Sub
|
|
Private Sub CheckMouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
|
|
If _IsAreaSelecting OrElse _IsMovingObjects Then
|
|
lastMousePos = New Point(e.X + Offset.X, e.Y + Offset.Y)
|
|
End If
|
|
|
|
If _IsAreaSelecting Then
|
|
SelectControlsInArea()
|
|
End If
|
|
|
|
If _IsMovingObjects Then
|
|
UpdateObjectPositions(e)
|
|
End If
|
|
|
|
For Each obj As PaintingObject In GetObjects(New Point(e.X + Offset.X, e.Y + Offset.Y))
|
|
If Not obj.MouseTransparency Then
|
|
obj.RaiseMouseMove(GetMouseEventArgs(e, obj))
|
|
End If
|
|
Next
|
|
|
|
Dim topObj As PaintingObject = GetObject(New Point(e.X + Offset.X, e.Y + Offset.Y), True)
|
|
If topObj IsNot Nothing Then
|
|
Cursor = topObj.Cursor
|
|
ElseIf calcOffset_IsActive Then
|
|
Cursor = Cursors.Arrow
|
|
Else
|
|
Cursor = Cursors.Default
|
|
End If
|
|
|
|
If calcOffset_IsActive Then
|
|
If pressedAlt Then
|
|
CalcNewOffset(e.Location)
|
|
Else
|
|
calcOffset_IsActive = False
|
|
End If
|
|
End If
|
|
|
|
Refresh()
|
|
End Sub
|
|
|
|
Private Sub CalcNewOffset(newMousePos As Point)
|
|
Offset = New PointF(calcOffset_LastOffset.X - (newMousePos.X - calcOffset_MouseOnTab.X),
|
|
calcOffset_LastOffset.Y - (newMousePos.Y - calcOffset_MouseOnTab.Y))
|
|
If Offset.X < 0 Then
|
|
Offset = New PointF(0, Offset.Y)
|
|
End If
|
|
If Offset.Y < 0 Then
|
|
Offset = New PointF(Offset.X, 0)
|
|
End If
|
|
End Sub
|
|
|
|
Private Function GetSelectedObjects() As PaintingObject()
|
|
Dim objs As New List(Of PaintingObject)
|
|
|
|
For Each obj As PaintingObject In PaintingObjects
|
|
If obj.Selected Then objs.Add(obj)
|
|
Next
|
|
|
|
Return objs.ToArray
|
|
End Function
|
|
|
|
Private Sub SaveObjectPositions(e As MouseEventArgs, objs As IList)
|
|
For Each obj As PaintingObject In objs
|
|
If Not obj.HardcodedLocation AndAlso Not savedPos.ContainsKey(obj) Then
|
|
savedPos.Add(obj, New PointF(e.X - obj.Location.X + Offset.X, e.Y - obj.Location.Y + Offset.Y))
|
|
SaveObjectPositions(e, obj.PinnedObjects)
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Private Sub UpdateObjectPositions(e As MouseEventArgs)
|
|
UpdateObjectPositions(e, GetSelectedObjects)
|
|
End Sub
|
|
|
|
Private Sub UpdateObjectPositions(e As MouseEventArgs, objs As IList(Of PaintingObject), Optional movedObjs As List(Of PaintingObject) = Nothing)
|
|
If IsResizingObjs(objs) Then Return
|
|
If movedObjs Is Nothing Then movedObjs = New List(Of PaintingObject)
|
|
|
|
SuspendDrawing()
|
|
|
|
For Each obj As PaintingObject In objs
|
|
Dim sp As PointF = savedPos(obj)
|
|
|
|
If Not movedObjs.Contains(obj) Then
|
|
If UpdateObjectPosition(e, obj, sp) Then
|
|
movedObjs.Add(obj)
|
|
End If
|
|
End If
|
|
|
|
If obj.PinnedObjects.Count > 0 Then
|
|
UpdateObjectPositions(e, obj.PinnedObjects, movedObjs)
|
|
movedObjs.AddRange(obj.PinnedObjects.ToArray)
|
|
End If
|
|
Next
|
|
|
|
ResumeDrawing(False)
|
|
End Sub
|
|
|
|
Private Function UpdateObjectPosition(e As MouseEventArgs, obj As PaintingObject, sp As PointF) As Boolean
|
|
Dim moved As Boolean = False
|
|
Dim cancel As New CancelEventArgs(False)
|
|
obj.RaiseMovingBeforePositionUpdated(cancel)
|
|
|
|
If Not cancel.Cancel Then
|
|
obj.Location = New Point(e.X - sp.X + Offset.X,
|
|
e.Y - sp.Y + Offset.Y)
|
|
obj.RaiseMoving(New EventArgs)
|
|
moved = True
|
|
End If
|
|
|
|
Return moved
|
|
End Function
|
|
|
|
Private Function IsResizingObjs(objs As IList(Of PaintingObject)) As Boolean
|
|
For Each obj As PaintingObject In objs
|
|
If obj.IsResizing Then Return True
|
|
Next
|
|
Return False
|
|
End Function
|
|
|
|
Private Function GetMouseEventArgs(e As MouseEventArgs, obj As PaintingObject) As MouseEventArgs
|
|
Return New MouseEventArgs(e.Button, e.Clicks, e.X - obj.X + Offset.X, e.Y - obj.Y + Offset.Y, e.Delta)
|
|
End Function
|
|
|
|
Public Function GetObject(p As PointF, Optional UseExtRect As Boolean = False) As PaintingObject
|
|
Dim val As PaintingObject = Nothing
|
|
|
|
For i As Integer = PaintingObjects.Count - 1 To 0 Step -1
|
|
Dim obj As PaintingObject = PaintingObjects(i)
|
|
|
|
If val Is Nothing Then
|
|
If UseExtRect Then
|
|
If HelpfulDrawingFunctions.IsPointInRectangle(p, obj.RectangleExtended) Then
|
|
val = obj
|
|
End If
|
|
Else
|
|
If HelpfulDrawingFunctions.IsPointInRectangle(p, obj.Rectangle) Then
|
|
val = obj
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
Return val
|
|
End Function
|
|
|
|
Public Function GetObjects(p As Point) As PaintingObject()
|
|
Dim objs As New List(Of PaintingObject)
|
|
|
|
For Each obj As PaintingObject In PaintingObjects
|
|
If HelpfulDrawingFunctions.IsPointInRectangle(p, obj.RectangleExtended) Then
|
|
objs.Add(obj)
|
|
End If
|
|
Next
|
|
|
|
Return objs.ToArray
|
|
End Function
|
|
|
|
Public Function GetObjects(startPoint As Point, endPoint As Point) As PaintingObject()
|
|
Return GetObjects(New Rectangle(startPoint, CType(endPoint - startPoint, Size)))
|
|
End Function
|
|
|
|
Public Function GetObjects(rect As Rectangle) As PaintingObject()
|
|
Dim objs As New List(Of PaintingObject)
|
|
|
|
For Each obj As PaintingObject In PaintingObjects
|
|
Dim objRect As RectangleF = obj.Rectangle
|
|
If HelpfulDrawingFunctions.IsPointInRectangle(objRect.Location, rect) OrElse
|
|
HelpfulDrawingFunctions.IsPointInRectangle(objRect.Location + objRect.Size, rect) OrElse
|
|
HelpfulDrawingFunctions.IsPointInRectangle(New PointF(objRect.Left, objRect.Bottom), rect) OrElse
|
|
HelpfulDrawingFunctions.IsPointInRectangle(New PointF(objRect.Right, objRect.Top), rect) Then
|
|
objs.Add(obj)
|
|
End If
|
|
Next
|
|
|
|
Return objs.ToArray
|
|
End Function
|
|
|
|
Protected Overrides ReadOnly Property CreateParams As CreateParams
|
|
Get
|
|
Dim cp = MyBase.CreateParams
|
|
|
|
'If EnableRealTransparency Then
|
|
' cp.ExStyle = cp.ExStyle Or &H20 'WS_EX_TRANSPARENT
|
|
'End If
|
|
|
|
Return cp
|
|
End Get
|
|
End Property
|
|
|
|
''' <summary>
|
|
''' Sorg dafür, dass Events durch dieses Control durchdringen zum Parnet-Control.
|
|
''' </summary>
|
|
''' <param name="m"></param>
|
|
Protected Overrides Sub WndProc(ByRef m As Message)
|
|
Const WM_NCHITTEST As Integer = &H84
|
|
Const HTTRANSPARENT As Integer = -1
|
|
|
|
If Not VisibleForMouseEvents AndAlso m.Msg = WM_NCHITTEST Then
|
|
m.Result = CType(HTTRANSPARENT, IntPtr)
|
|
Else
|
|
MyBase.WndProc(m)
|
|
End If
|
|
End Sub
|
|
|
|
Protected Overrides Sub OnPaintBackground(e As PaintEventArgs)
|
|
'Stop Drawing directly to the parent
|
|
Me.SuspendLayout()
|
|
|
|
'Draw Background
|
|
'If Not EnableRealTransparency Then
|
|
MyBase.OnPaintBackground(e)
|
|
'End If
|
|
End Sub
|
|
|
|
Protected Overrides Sub OnPaint(e As PaintEventArgs)
|
|
'Draw PaintingObjects stuff
|
|
If StopDrawing Then
|
|
e.Graphics.DrawImage(bufferedImg, Point.Empty)
|
|
Else
|
|
With e.Graphics
|
|
.SmoothingMode = SmoothingMode.HighQuality
|
|
.PixelOffsetMode = PixelOffsetMode.HighQuality
|
|
.PageUnit = GraphicsUnit.Pixel
|
|
.InterpolationMode = InterpolationMode.HighQualityBicubic
|
|
End With
|
|
|
|
If GridVisible Then
|
|
DrawGridMethode?.Invoke(e, Me, Offset)
|
|
End If
|
|
|
|
Dim baserect As RectangleF = New RectangleF(Offset, Size)
|
|
|
|
For Each obj As PaintingObject In PaintingObjects
|
|
If obj.Visible AndAlso HelpfulDrawingFunctions.OverlapsTwoRectangles(obj.Rectangle, baserect) Then
|
|
obj.Draw(e, Offset)
|
|
End If
|
|
Next
|
|
|
|
If _IsAreaSelecting Then
|
|
DrawAreaSelectionMethode?.Invoke(e, Me, New PointF(startMousePos.X - Offset.X, startMousePos.Y - Offset.Y), New PointF(lastMousePos.X - Offset.X, lastMousePos.Y - Offset.Y))
|
|
End If
|
|
End If
|
|
|
|
'Do default Drawing Methode
|
|
MyBase.OnPaint(e)
|
|
|
|
'Start Drawing directly to the Form
|
|
ResumeLayout(False)
|
|
End Sub
|
|
|
|
Public Overloads Function CreateGraphics() As Graphics
|
|
Return MyBase.CreateGraphics
|
|
End Function
|
|
|
|
Public Sub PaintFullView(g As Graphics)
|
|
For Each obj As PaintingObject In PaintingObjects
|
|
If obj.Visible Then
|
|
obj.Draw(g, PointF.Empty)
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Private Function CalcTextSize(obj As PaintingObject) As SizeF
|
|
Return CalcTextSize(obj, Parent.CreateGraphics)
|
|
End Function
|
|
|
|
Private Function CalcTextSize(obj As PaintingObject, g As Graphics) As SizeF
|
|
Return g.MeasureString(obj.Text, obj.TextFont, obj.Width)
|
|
End Function
|
|
|
|
Private Sub SelectControlsInArea()
|
|
Dim rect As RectangleF = GetRectangle(startMousePos, lastMousePos)
|
|
For Each obj As PaintingObject In PaintingObjects
|
|
obj.Selected = If(startMousePos.X >= lastMousePos.X,
|
|
OverlapsTwoRectangles(obj.Rectangle, rect),
|
|
RectangleContainsRectangle(rect, obj.Rectangle))
|
|
Next
|
|
End Sub
|
|
|
|
Public Sub ArrangeToGrid(obj As PaintingObject, snapPinnedObjects As Boolean)
|
|
If snapPinnedObjects OrElse Not IsPinnedObject(obj) Then
|
|
Dim zoomedGridChunkSize As New SizeF(GridChunkSize.Width * ZoomFactor.Width, Me.GridChunkSize.Height * ZoomFactor.Height)
|
|
|
|
Dim modTop As Integer = obj.Y Mod zoomedGridChunkSize.Height
|
|
Dim modLeft As Integer = obj.X Mod zoomedGridChunkSize.Width
|
|
|
|
Dim halfHeight As Integer = zoomedGridChunkSize.Height / 2
|
|
Dim halfWidth As Integer = zoomedGridChunkSize.Width / 2
|
|
|
|
Dim zoomLocation =
|
|
Sub(obj2 As PaintingObject)
|
|
If modTop > halfHeight Then
|
|
obj2.Y += (zoomedGridChunkSize.Height - modTop)
|
|
Else
|
|
obj2.Y -= modTop
|
|
End If
|
|
|
|
If modLeft > halfWidth Then
|
|
obj2.X += (zoomedGridChunkSize.Width - modLeft)
|
|
Else
|
|
obj2.X -= modLeft
|
|
End If
|
|
End Sub
|
|
|
|
zoomLocation(obj)
|
|
|
|
For Each pinned As PaintingObject In obj.PinnedObjects
|
|
zoomLocation(pinned)
|
|
Next
|
|
|
|
Dim modH As Integer = obj.Height Mod zoomedGridChunkSize.Height
|
|
Dim modW As Integer = obj.Width Mod zoomedGridChunkSize.Width
|
|
|
|
Dim zoomSize =
|
|
Sub(obj2 As PaintingObject)
|
|
If obj2.EnableResize AndAlso Not obj2.HardcodedSize Then
|
|
If modH > halfHeight Then
|
|
obj2.Height += (zoomedGridChunkSize.Height - modH)
|
|
Else
|
|
obj2.Height -= modH
|
|
End If
|
|
|
|
If modW > halfWidth Then
|
|
obj2.Width += (zoomedGridChunkSize.Width - modW)
|
|
Else
|
|
obj2.Width -= modW
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
zoomSize(obj)
|
|
|
|
For Each pinned As PaintingObject In obj.PinnedObjects
|
|
zoomSize(pinned)
|
|
Next
|
|
End If
|
|
End Sub
|
|
|
|
Public Function IsPinnedObject(o As PaintingObject) As Boolean
|
|
For Each obj As PaintingObject In PaintingObjects
|
|
If obj.PinnedObjects.Contains(o) Then
|
|
Return True
|
|
End If
|
|
Next
|
|
Return False
|
|
End Function
|
|
|
|
Public Sub AutoArrangeToGrid()
|
|
If GridEnabled Then
|
|
For Each obj As PaintingObject In GetSelectedObjects()
|
|
If obj.AutoAlignToGrid Then
|
|
ArrangeToGrid(obj, False)
|
|
End If
|
|
Next
|
|
If Not StopDrawing Then Refresh()
|
|
End If
|
|
End Sub
|
|
|
|
Public Function GetFullSize() As SizeF
|
|
Return GetFullSize(PaintingObjects)
|
|
End Function
|
|
|
|
Public Shared Function GetFullSize(objects As IEnumerable(Of PaintingObject)) As SizeF
|
|
Dim curX As Single = 0
|
|
Dim curY As Single = 0
|
|
|
|
For Each po As PaintingObject In objects
|
|
Dim myX As Single = po.X + po.Width
|
|
If curX < myX Then
|
|
curX = myX
|
|
End If
|
|
Dim myY As Single = po.Y + po.Height
|
|
If curY < myY Then
|
|
curY = myY
|
|
End If
|
|
Next
|
|
|
|
Return New SizeF(curX + 20, curY + 20)
|
|
End Function
|
|
|
|
Friend Sub RaisePaintingObjectAdded(args As PaintingObjectEventArgs)
|
|
RaiseEvent PaintingObjectAdded(Me, args)
|
|
End Sub
|
|
Friend Sub RaisePaintingObjectRemoved(args As PaintingObjectEventArgs)
|
|
RaiseEvent PaintingObjectRemoved(Me, args)
|
|
End Sub
|
|
|
|
Private Sub PaintingControl_PaintingObjectAdded(sender As Object, e As PaintingObjectEventArgs) Handles Me.PaintingObjectAdded, Me.PaintingObjectRemoved
|
|
'CalculateScrollValues()
|
|
End Sub
|
|
|
|
Private Sub CheckMouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel
|
|
If pressedAlt Then
|
|
Dim val As Single = e.Delta / 120 / 10
|
|
ZoomFactor = New SizeF(Math.Max(ZoomFactor.Width + val, 0.25), Math.Max(ZoomFactor.Height + val, 0.25))
|
|
Refresh()
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub SuspendDrawing()
|
|
If _stopDrawing < 0 Then
|
|
'bufferedImg = New Bitmap(Width, Height)
|
|
'DrawToBitmap(bufferedImg, New Rectangle(0, 0, bufferedImg.Width, bufferedImg.Height))
|
|
Utils.SuspendDrawing(Me)
|
|
End If
|
|
_stopDrawing += 1
|
|
End Sub
|
|
|
|
Public Sub ResumeDrawing()
|
|
ResumeDrawing(True)
|
|
End Sub
|
|
|
|
Public Sub ResumeDrawing(executeRefresh As Boolean)
|
|
If _stopDrawing >= 0 Then
|
|
_stopDrawing -= 1
|
|
End If
|
|
|
|
If _stopDrawing = -1 Then
|
|
'bufferedImg.Dispose()
|
|
'bufferedImg = Nothing
|
|
'If executeRefresh Then Refresh()
|
|
Utils.ResumeDrawing(Me, executeRefresh)
|
|
End If
|
|
End Sub
|
|
|
|
End Class
|