190930

2019-09-30 16:18:53 +02:00
parent 7d884d7cba
commit 53f2a0666b
70 changed files with 2984 additions and 197 deletions
--- a/Pilz.UI/PaintingControl/PaintingControl.vb
+++ b/Pilz.UI/PaintingControl/PaintingControl.vb
@@ -23,6 +23,8 @@ Public Class PaintingControl

    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
@@ -90,9 +92,10 @@ Public Class PaintingControl
        End Get
        Set(value As Color)
            bgColor = value
-            If value <> Color.Transparent Then
-                MyBase.BackColor = value
-            End If
+            MyBase.BackColor = value
+            'If value <> Color.Transparent Then
+            '    MyBase.BackColor = value
+            'End If
        End Set
    End Property
    Public ReadOnly Property IsAreaSelecting As Boolean
@@ -114,6 +117,7 @@ Public Class PaintingControl
    End Property

    Public Sub New()
+        'SetStyle(ControlStyles.Opaque, True) 'For real transparency
        DoubleBuffered = True
    End Sub

@@ -150,7 +154,7 @@ Public Class PaintingControl
        curObjMouseDown = GetObjects(lastMousePos).Where(Function(n) Not n.MouseTransparency).LastOrDefault
        curObjMouseDown?.RaiseMouseDown(GetMouseEventArgs(e, curObjMouseDown))

-        If Not GetSelectedObjects.Contains(curObjMouseDown) Then
+        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()
@@ -164,7 +168,7 @@ Public Class PaintingControl
            If (Not hasMovedObjects) AndAlso (Not _IsAreaSelecting) Then
                Dim selChanged As New List(Of PaintingObject)

-                If AutoRemoveSelection AndAlso Not pressedShift Then
+                If AutoRemoveSelection AndAlso Not pressedControl Then
                    For Each obj As PaintingObject In PaintingObjects
                        If obj.Selected Then
                            obj.SelectedDirect = False
@@ -175,9 +179,9 @@ Public Class PaintingControl
                    Next
                End If

-                If AutoSingleSelection Then
+                If AutoSingleSelection AndAlso curObjMouseDown IsNot Nothing Then
                    Dim objtosel As PaintingObject = curObjMouseDown
-                    If objtosel?.EnableSelection Then
+                    If objtosel.EnableSelection Then
                        objtosel.SelectedDirect = Not objtosel.Selected
                        If Not selChanged.Contains(objtosel) Then
                            selChanged.Add(objtosel)
@@ -418,7 +422,7 @@ Public Class PaintingControl
        Get
            Dim cp = MyBase.CreateParams

-            'If EnableFullTransparentBackground Then
+            'If EnableRealTransparency Then
            '    cp.ExStyle = cp.ExStyle Or &H20 'WS_EX_TRANSPARENT
            'End If

@@ -431,16 +435,14 @@ Public Class PaintingControl
    ''' </summary>
    ''' <param name="m"></param>
    Protected Overrides Sub WndProc(ByRef m As Message)
-        Dim WM_NCHITTEST As Integer = &H84
-        Dim HTTRANSPARENT As Integer = -1
+        Const WM_NCHITTEST As Integer = &H84
+        Const HTTRANSPARENT As Integer = -1

-        'If m.Msg = WM_NCHITTEST Then
-        '    m.Result = CType(HTTRANSPARENT, IntPtr)
-        'Else
-        '    MyBase.WndProc(m)
-        'End If
-
-        MyBase.WndProc(m)
+        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)
@@ -448,13 +450,13 @@ Public Class PaintingControl
        Me.SuspendLayout()

        'Draw Background
+        'If Not EnableRealTransparency Then
        MyBase.OnPaintBackground(e)
+        'End If
    End Sub

    Protected Overrides Sub OnPaint(e As PaintEventArgs)
-        'Do default Drawing Methode
-        MyBase.OnPaint(e)
-
+        'Draw PaintingObjects stuff
        If StopDrawing Then
            e.Graphics.DrawImage(bufferedImg, Point.Empty)
        Else
@@ -482,6 +484,9 @@ Public Class PaintingControl
            End If
        End If

+        'Do default Drawing Methode
+        MyBase.OnPaint(e)
+
        'Start Drawing directly to the Form
        ResumeLayout(False)
    End Sub
@@ -501,53 +506,76 @@ Public Class PaintingControl
    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 = HelpfulDrawingFunctions.GetRectangle(startMousePos, lastMousePos)
+        Dim rect As RectangleF = GetRectangle(startMousePos, lastMousePos)
        For Each obj As PaintingObject In PaintingObjects
-            obj.Selected = HelpfulDrawingFunctions.OverlapsTwoRectangles(obj.Rectangle, rect)
+            obj.Selected = If(startMousePos.X >= lastMousePos.X,
+                OverlapsTwoRectangles(obj.Rectangle, rect),
+                RectangleContainsRectangle(rect, obj.Rectangle))
        Next
    End Sub

-    Public Sub ArrangeToGrid(obj As PaintingObject)
-        Dim zoomedGridChunkSize As New SizeF(GridChunkSize.Width * ZoomFactor.Width, Me.GridChunkSize.Height * ZoomFactor.Height)
+    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 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 halfHeight As Integer = zoomedGridChunkSize.Height / 2
+            Dim halfWidth As Integer = zoomedGridChunkSize.Width / 2

-        If modTop > halfHeight Then
-            obj.Y += (zoomedGridChunkSize.Height - modTop)
-        Else
-            obj.Y -= modTop
-        End If
+            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
-            obj.X += (zoomedGridChunkSize.Width - modLeft)
-        Else
-            obj.X -= modLeft
-        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

-        If obj.EnableResize AndAlso Not obj.HardcodedSize Then
            Dim modH As Integer = obj.Height Mod zoomedGridChunkSize.Height
            Dim modW As Integer = obj.Width Mod zoomedGridChunkSize.Width

-            If modH > halfHeight Then
-                obj.Height += (zoomedGridChunkSize.Height - modH)
-            Else
-                obj.Height -= modH
-            End If
+            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
-                obj.Width += (zoomedGridChunkSize.Width - modW)
-            Else
-                obj.Width -= modW
-            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

@@ -564,7 +592,7 @@ Public Class PaintingControl
        If GridEnabled Then
            For Each obj As PaintingObject In GetSelectedObjects()
                If obj.AutoAlignToGrid Then
-                    ArrangeToGrid(obj)
+                    ArrangeToGrid(obj, False)
                End If
            Next
            If Not StopDrawing Then Refresh()