Pilz/Pilz.UI/PaintingControl/PaintingControl.vb

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, Me.KeyUp
        pressedShift = e.Shift
        pressedControl = e.Control
        pressedAlt = e.Alt
    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 pressedControl 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