190607 c1

- Add Pilz.Drawing.Drawing3D.OpenGLFactory - Fix small bugs in Pilz.UI.PaintingControl
2019-06-07 20:56:19 +02:00
parent ef15e45df7
commit 2f09834fa0
65 changed files with 6670 additions and 118 deletions
--- a/Pilz.UI/PaintingControl/DefaultDrawMethodes.vb
+++ b/Pilz.UI/PaintingControl/DefaultDrawMethodes.vb
@@ -31,21 +31,33 @@ Public Class DefaultDrawMethodes
    Public Shared Sub DrawPicture(e As PaintingObjectPaintEventArgs)
        Dim obj As PaintingObject = e.PaintingObject
        Dim objImg As Image
+        Dim objImgSize As Size
        Dim result As RectangleF
        Dim image As Bitmap
+        Dim zoomf As SizeF
+        Dim hasNoParent As Boolean = e.PaintingObject.Parent Is Nothing
+        Dim syncObj As Object

-        SyncLock e.PaintingObject.Parent
+        If hasNoParent Then
+            zoomf = New SizeF(1, 1)
+            Static newSyncObj As New Object
+            syncObj = newSyncObj
+        Else
+            zoomf = e.PaintingObject.Parent.ZoomFactor
+            syncObj = e.PaintingObject.Parent
+        End If
+
+        SyncLock syncObj
            If obj?.Image Is Nothing Then Return
            objImg = obj.Image
+            objImgSize = objImg.Size
        End SyncLock

        image = obj.BufferedImage
-        result = CalculateImageResolution(obj, objImg.Size)
+        result = CalculateImageResolution(obj, objImgSize, zoomf)

        If obj.ImageProperties.Rotate = 90 OrElse obj.ImageProperties.Rotate = 270 Then
-            result = CalculateImageResolution(obj, New SizeF(objImg.Size.Height, objImg.Size.Width))
-        Else
-            result = result
+            result = CalculateImageResolution(obj, New SizeF(objImgSize.Height, objImgSize.Width), zoomf)
        End If

        If image Is Nothing Then
@@ -71,7 +83,7 @@ Public Class DefaultDrawMethodes
            End If

            If needRescaleImageBecauseRot Then
-                result = CalculateImageResolution(obj, New SizeF(objImg.Size.Height, objImg.Size.Width))
+                result = CalculateImageResolution(obj, New SizeF(objImgSize.Height, objImgSize.Width), zoomf)
                image = DrawToNewImage(image, result.Size)
            End If

@@ -79,12 +91,15 @@ Public Class DefaultDrawMethodes
        End If

        If image IsNot Nothing Then
-            e.Graphics.DrawImageUnscaled(image, New Rectangle(New Point(obj.Location.X + result.Location.X - e.Offset.X, obj.Location.Y + result.Location.Y - e.Offset.Y), result.Size.ToSize))
+            SyncLock syncObj
+                e.Graphics.DrawImageUnscaled(image, New Rectangle(New Point(obj.Location.X + result.Location.X - e.Offset.X, obj.Location.Y + result.Location.Y - e.Offset.Y), result.Size.ToSize))
+            End SyncLock
        End If
    End Sub

    Private Shared Function DrawToNewImage(image As Bitmap, newSize As SizeF) As Bitmap
-        Dim bmp As New Bitmap(CInt(newSize.Width), CInt(newSize.Height))
+        Dim bmp As New Bitmap(CInt(If(newSize.Width < 0, newSize.Width * -1, newSize.Width)),
+                              CInt(If(newSize.Height < 0, newSize.Height * -1, newSize.Height)))
        Dim gimage As Graphics = Graphics.FromImage(bmp)
        gimage.SmoothingMode = SmoothingMode.HighQuality
        gimage.PixelOffsetMode = PixelOffsetMode.HighQuality
@@ -103,10 +118,10 @@ Public Class DefaultDrawMethodes
        e.Graphics.DrawLine(p2, no, no + obj.Size)
    End Sub

-    Private Shared Function CalculateImageResolution(obj As PaintingObject, imageSize As SizeF) As RectangleF
+    Private Shared Function CalculateImageResolution(obj As PaintingObject, imageSize As SizeF, zoom As SizeF) As RectangleF
        Dim result As New RectangleF
        Dim objrect As New RectangleF(obj.Location, obj.Size)
-        Dim size As SizeF = imageSize
+        Dim size As SizeF = New SizeF(imageSize.Width * zoom.Width, imageSize.Height * zoom.Height)
        Dim clientRectangle As RectangleF = objrect
        Dim val As Single = clientRectangle.Width / size.Width

--- a/Pilz.UI/PaintingControl/PaintingControl.vb
+++ b/Pilz.UI/PaintingControl/PaintingControl.vb
@@ -107,6 +107,7 @@ Public Class PaintingControl
        Set
            If _ZoomFactor <> Value Then
                _ZoomFactor = Value
+                ResetAllBufferedImages()
                RaiseEvent ZoomFactorChanged(Me, New EventArgs)
            End If
        End Set
@@ -116,6 +117,13 @@ Public Class PaintingControl
        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
@@ -166,6 +174,7 @@ Public Class PaintingControl
                        End If
                    Next
                End If
+
                If AutoSingleSelection Then
                    Dim objtosel As PaintingObject = curObjMouseDown
                    If objtosel?.EnableSelection Then
@@ -218,8 +227,10 @@ Public Class PaintingControl

        If _IsMovingObjects Then
            _IsMovingObjects = False
+            For Each obj As PaintingObject In GetSelectedObjects()
+                obj.RaiseMoved(New EventArgs)
+            Next
            AutoArrangeToGrid()
-            'CalculateScrollValues()
        End If

        If curObjMouseDown IsNot Nothing Then
@@ -304,43 +315,38 @@ Public Class PaintingControl
            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)
-        Dim updateprocesses As New List(Of Task)

        SuspendDrawing()

        For Each obj As PaintingObject In objs
-            updateprocesses.Add(Task.Run(
-                Sub()
-                    Dim sp As PointF = savedPos(obj)
+            Dim sp As PointF = savedPos(obj)

-                    If Not movedObjs.Contains(obj) Then
-                        UpdateObjectPosition(e, obj, sp)
-                        movedObjs.Add(obj)
-                    End If
+            If Not movedObjs.Contains(obj) Then
+                UpdateObjectPosition(e, obj, sp)
+                movedObjs.Add(obj)
+            End If

-                    If obj.PinnedObjects.Count > 0 Then
-                        UpdateObjectPositions(e, obj.PinnedObjects, movedObjs)
-                        movedObjs.AddRange(obj.PinnedObjects.ToArray)
-                    End If
-                End Sub))
-        Next
-
-        For Each a In updateprocesses
-            Do Until a.IsCompleted
-            Loop
+            If obj.PinnedObjects.Count > 0 Then
+                UpdateObjectPositions(e, obj.PinnedObjects, movedObjs)
+                movedObjs.AddRange(obj.PinnedObjects.ToArray)
+            End If
        Next

        ResumeDrawing(False)
    End Sub
+
    Private Sub UpdateObjectPosition(e As MouseEventArgs, obj As PaintingObject, sp As PointF)
        obj.Location = New Point(e.X - sp.X + Offset.X,
                                 e.Y - sp.Y + Offset.Y)
+        obj.RaiseMoving(New EventArgs)
    End Sub

    Private Function IsResizingObjs(objs As IList(Of PaintingObject)) As Boolean
@@ -355,19 +361,25 @@ Public Class PaintingControl
    End Function

    Public Function GetObject(p As PointF, Optional UseExtRect As Boolean = False) As PaintingObject
-        For Each obj As PaintingObject In PaintingObjects
-            If UseExtRect Then
-                If HelpfulDrawingFunctions.IsPointInRectangle(p, obj.RectangleExtended) Then
-                    Return obj
-                End If
-            Else
-                If HelpfulDrawingFunctions.IsPointInRectangle(p, obj.Rectangle) Then
-                    Return obj
+        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 Nothing
+        Return val
    End Function

    Public Function GetObjects(p As Point) As PaintingObject()
@@ -439,46 +451,6 @@ Public Class PaintingControl
        MyBase.OnPaintBackground(e)
    End Sub

-    Private Function GetCurrentHashValue() As Integer
-        Dim hashes As New List(Of Integer)
-
-        hashes.AddRange({Offset.X,
-                        Offset.Y,
-                        Size.Width,
-                        Size.Height})
-
-        For Each p As PaintingObject In PaintingObjects
-            hashes.AddRange({p.Location.X,
-                            p.Location.Y,
-                            p.Size.Width,
-                            p.Size.Height,
-                            p.DrawMethodes.Count,
-                            p.FillColor.ToArgb,
-                            p.OutlineColor.ToArgb,
-                            p.SelectionColor.ToArgb,
-                            p.TextColor.ToArgb,
-                            p.Type,
-                            p.Text.GetHashCode / p.Text.Length,
-                            p.Visible,
-                            p.VerticalTextAlignment,
-                            p.HorizontalTextAlignment})
-        Next
-
-        Dim hash As Integer = 0
-
-        For Each h As Integer In hashes
-            Try
-                hash += h
-            Catch ex As Exception
-                If h <> 0 AndAlso h <> 1 Then
-                    hash /= h
-                End If
-            End Try
-        Next
-
-        Return hash
-    End Function
-
    Protected Overrides Sub OnPaint(e As PaintEventArgs)
        'Do default Drawing Methode
        MyBase.OnPaint(e)
@@ -579,6 +551,15 @@ Public Class PaintingControl
        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()
--- a/Pilz.UI/PaintingControl/PaintingObject.vb
+++ b/Pilz.UI/PaintingControl/PaintingObject.vb
@@ -47,6 +47,7 @@ Imports Newtonsoft.Json
    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)
@@ -56,6 +57,8 @@ Imports Newtonsoft.Json
    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
@@ -69,21 +72,27 @@ Imports Newtonsoft.Json
        Me.DrawMethodes.AddRange(drawMethodes)
    End Sub

-    Public Sub RaiseMouseClick(e As MouseEventArgs)
+    Friend Sub RaiseMouseClick(e As MouseEventArgs)
        RaiseEvent MouseClick(Me, e)
    End Sub
-    Public Sub RaiseMouseDown(e As MouseEventArgs)
+    Friend Sub RaiseMouseDown(e As MouseEventArgs)
        RaiseEvent MouseDown(Me, e)
    End Sub
-    Public Sub RaiseMouseUp(e As MouseEventArgs)
+    Friend Sub RaiseMouseUp(e As MouseEventArgs)
        RaiseEvent MouseUp(Me, e)
    End Sub
-    Public Sub RaiseMouseMove(e As MouseEventArgs)
+    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
@@ -376,16 +385,22 @@ Imports Newtonsoft.Json
        End Set
    End Property

-    <JsonIgnore> Public ReadOnly Property Right As Integer
+    <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 ReadOnly Property Bottom() As Integer
+    <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
@@ -439,7 +454,11 @@ Imports Newtonsoft.Json
            Dim poevargs As New PaintingObjectPaintEventArgs(Me, g, offset)

            For Each dm As DelegateDrawPaintingObjectMethode In DrawMethodes
-                dm?.Invoke(poevargs)
+                Try
+                    dm?.Invoke(poevargs)
+                Catch ex As Exception
+                    _ErrorsAtDrawing += 1
+                End Try
            Next

            If Selected AndAlso DrawSelectionMethode IsNot Nothing Then
@@ -454,20 +473,27 @@ Imports Newtonsoft.Json

    Public Function Clone(includePinnedObject As Boolean) As Object
        Dim obj As New PaintingObject
-        Dim t As Type = Me.GetType
-        Dim blackField As New List(Of String) From {
+        Dim metype As Type = Me.GetType
+        Dim blackField As String() = {
            NameOf(_PinnedObjects),
            NameOf(resizeEngine),
            NameOf(_Parent),
-            NameOf(BufferedImage)
+            NameOf(BufferedImage),
+            NameOf(_ImageProperties)
        }

-        Dim fields As FieldInfo() = t.GetFields(BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.IgnoreCase Or BindingFlags.Instance)
-        For Each field As FieldInfo In fields
-            If Not blackField.Contains(field.Name) Then
-                field.SetValue(obj, field.GetValue(Me))
-            End If
-        Next
+        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)
--- a/Pilz.UI/PaintingControl/PaintingObjectResizing.vb
+++ b/Pilz.UI/PaintingControl/PaintingObjectResizing.vb
@@ -95,8 +95,12 @@ Imports Pilz.Drawing

        ElseIf Not mMouseDown Then

-            Dim eX As Integer = e.X - mObj.X + mObj.Parent.Offset.X
-            Dim eY As Integer = e.Y - mObj.Y + mObj.Parent.Offset.Y
+            Dim eXo As Integer = e.X
+            Dim eYo As Integer = e.Y
+            Dim eXwo As Integer = eXo - mObj.X
+            Dim eYwo As Integer = eYo - mObj.Y
+            Dim eX As Integer = eXwo + mObj.Parent.Offset.X
+            Dim eY As Integer = eYwo + mObj.Parent.Offset.Y
            Dim eLocation As New Point(eX, eY)
            Dim extRect As RectangleF = mObj.RectangleExtended
            Dim oldRect As RectangleF = mObj.Rectangle
@@ -108,8 +112,9 @@ Imports Pilz.Drawing
            newRect.Height = (extRect.Height - oldRect.Height) / 2

            Dim setToNone As Boolean = False
+            Dim isOnTop As Boolean = mObj.Parent.GetObject(New PointF(eXo, eYo), True) Is mObj

-            If Enabled Then
+            If Enabled AndAlso isOnTop Then
                Select Case True
                    Case HelpfulDrawingFunctions.IsPointInRectangle(eLocation, New Rectangle(newRect.X, newRect.Y, newRect.Width, newRect.Height))
                        mObj.Cursor = Cursors.SizeNWSE