Projektdateien hinzufügen.

This commit is contained in:
2019-04-02 18:47:41 +02:00
parent 2ce6f5f16d
commit ef15e45df7
138 changed files with 8675 additions and 0 deletions

View File

@@ -0,0 +1,13 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On

View File

@@ -0,0 +1,10 @@
<?xml version="1.0" encoding="utf-8"?>
<MyApplicationData xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<MySubMain>false</MySubMain>
<SingleInstance>false</SingleInstance>
<ShutdownMode>0</ShutdownMode>
<EnableVisualStyles>true</EnableVisualStyles>
<AuthenticationMode>0</AuthenticationMode>
<ApplicationType>1</ApplicationType>
<SaveMySettingsOnExit>true</SaveMySettingsOnExit>
</MyApplicationData>

View File

@@ -0,0 +1,35 @@
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' Allgemeine Informationen über eine Assembly werden über die folgenden
' Attribute gesteuert. Ändern Sie diese Attributwerte, um die Informationen zu ändern,
' die einer Assembly zugeordnet sind.
' Werte der Assemblyattribute überprüfen
<Assembly: AssemblyTitle("PaintingControls")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("Dr. Schneider Kunststoffwerke GmbH")>
<Assembly: AssemblyProduct("PaintingControls")>
<Assembly: AssemblyCopyright("Copyright © Pascal Schedel 2018")>
<Assembly: AssemblyTrademark("")>
<Assembly: ComVisible(False)>
'Die folgende GUID bestimmt die ID der Typbibliothek, wenn dieses Projekt für COM verfügbar gemacht wird.
<Assembly: Guid("35e33313-ac05-4192-9cc7-c60016d65657")>
' Versionsinformationen für eine Assembly bestehen aus den folgenden vier Werten:
'
' Hauptversion
' Nebenversion
' Buildnummer
' Revision
'
' Sie können alle Werte angeben oder Standardwerte für die Build- und Revisionsnummern verwenden,
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.0.0.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")>

63
Pilz.UI/My Project/Resources.Designer.vb generated Normal file
View File

@@ -0,0 +1,63 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Imports System
Namespace My.Resources
'Diese Klasse wurde von der StronglyTypedResourceBuilder automatisch generiert
'-Klasse über ein Tool wie ResGen oder Visual Studio automatisch generiert.
'Um einen Member hinzuzufügen oder zu entfernen, bearbeiten Sie die .ResX-Datei und führen dann ResGen
'mit der /str-Option erneut aus, oder Sie erstellen Ihr VS-Projekt neu.
'''<summary>
''' Eine stark typisierte Ressourcenklasse zum Suchen von lokalisierten Zeichenfolgen usw.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "15.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo
'''<summary>
''' Gibt die zwischengespeicherte ResourceManager-Instanz zurück, die von dieser Klasse verwendet wird.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If Object.ReferenceEquals(resourceMan, Nothing) Then
Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("Pilz.UI.Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Überschreibt die CurrentUICulture-Eigenschaft des aktuellen Threads für alle
''' Ressourcenzuordnungen, die diese stark typisierte Ressourcenklasse verwenden.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set
resourceCulture = value
End Set
End Property
End Module
End Namespace

View File

@@ -0,0 +1,117 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>

73
Pilz.UI/My Project/Settings.Designer.vb generated Normal file
View File

@@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' Dieser Code wurde von einem Tool generiert.
' Laufzeitversion:4.0.30319.42000
'
' Änderungen an dieser Datei können falsches Verhalten verursachen und gehen verloren, wenn
' der Code erneut generiert wird.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "15.9.0.0"), _
Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Partial Friend NotInheritable Class MySettings
Inherits Global.System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings()),MySettings)
#Region "Automatische My.Settings-Speicherfunktion"
#If _MyType = "WindowsForms" Then
Private Shared addedHandler As Boolean
Private Shared addedHandlerLockObject As New Object
<Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Private Shared Sub AutoSaveSettings(sender As Global.System.Object, e As Global.System.EventArgs)
If My.Application.SaveMySettingsOnExit Then
My.Settings.Save()
End If
End Sub
#End If
#End Region
Public Shared ReadOnly Property [Default]() As MySettings
Get
#If _MyType = "WindowsForms" Then
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
#End If
Return defaultInstance
End Get
End Property
End Class
End Namespace
Namespace My
<Global.Microsoft.VisualBasic.HideModuleNameAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Module MySettingsProperty
<Global.System.ComponentModel.Design.HelpKeywordAttribute("My.Settings")> _
Friend ReadOnly Property Settings() As Global.Pilz.UI.My.MySettings
Get
Return Global.Pilz.UI.My.MySettings.Default
End Get
End Property
End Module
End Namespace

View File

@@ -0,0 +1,7 @@
<?xml version='1.0' encoding='utf-8'?>
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles>
<Profile Name="(Default)" />
</Profiles>
<Settings />
</SettingsFile>

View File

@@ -0,0 +1,220 @@
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Windows.Forms
Imports Pilz.Drawing
''' <summary>
''' Contains static methods that are used for the standart PaintingObject Types.
''' </summary>
Public Class DefaultDrawMethodes
Public Shared Sub DrawText(e As PaintingObjectPaintEventArgs)
Dim obj As PaintingObject = e.PaintingObject
Dim b As New SolidBrush(obj.TextColor)
Dim p As New PointF
Dim rect As New Rectangle(e.X, e.Y, obj.Width, obj.Height)
Dim f As StringFormat = StringFormat.GenericDefault
f.Alignment = obj.HorizontalTextAlignment
f.LineAlignment = obj.VerticalTextAlignment
Dim zoomFactor As Single
If obj.Parent Is Nothing Then
zoomFactor = 1.0!
Else
zoomFactor = obj.Parent.ZoomFactor.Width
End If
e.Graphics.DrawString(obj.Text, New Font(obj.TextFont.FontFamily, obj.TextFont.Size * zoomFactor, obj.TextFont.Style), b, rect, f)
End Sub
Public Shared Sub DrawPicture(e As PaintingObjectPaintEventArgs)
Dim obj As PaintingObject = e.PaintingObject
Dim objImg As Image
Dim result As RectangleF
Dim image As Bitmap
SyncLock e.PaintingObject.Parent
If obj?.Image Is Nothing Then Return
objImg = obj.Image
End SyncLock
image = obj.BufferedImage
result = CalculateImageResolution(obj, objImg.Size)
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
End If
If image Is Nothing Then
Dim needRescaleImageBecauseRot As Boolean = False
image = DrawToNewImage(objImg, result.Size)
Select Case obj.ImageProperties.Rotate
Case 90
image.RotateFlip(RotateFlipType.Rotate90FlipNone)
needRescaleImageBecauseRot = True
Case 180
image.RotateFlip(RotateFlipType.Rotate180FlipNone)
Case 270
image.RotateFlip(RotateFlipType.Rotate270FlipNone)
needRescaleImageBecauseRot = True
End Select
If obj.ImageProperties.FlipX Then
image.RotateFlip(RotateFlipType.RotateNoneFlipX)
End If
If obj.ImageProperties.FlipY Then
image.RotateFlip(RotateFlipType.RotateNoneFlipY)
End If
If needRescaleImageBecauseRot Then
result = CalculateImageResolution(obj, New SizeF(objImg.Size.Height, objImg.Size.Width))
image = DrawToNewImage(image, result.Size)
End If
obj.BufferedImage = image
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))
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 gimage As Graphics = Graphics.FromImage(bmp)
gimage.SmoothingMode = SmoothingMode.HighQuality
gimage.PixelOffsetMode = PixelOffsetMode.HighQuality
gimage.PageUnit = GraphicsUnit.Pixel
gimage.InterpolationMode = InterpolationMode.HighQualityBicubic
gimage.DrawImage(image, New RectangleF(PointF.Empty, newSize))
gimage.Dispose()
Return bmp
End Function
Public Shared Sub DrawLine(e As PaintingObjectPaintEventArgs)
Dim obj As PaintingObject = e.PaintingObject
Dim p2 As New Pen(obj.OutlineColor, obj.OutlineThicknes) With {.DashStyle = obj.OutlineDashStyle}
p2.Alignment = PenAlignment.Center
Dim no As PointF = New PointF(e.X, e.Y)
e.Graphics.DrawLine(p2, no, no + obj.Size)
End Sub
Private Shared Function CalculateImageResolution(obj As PaintingObject, imageSize As SizeF) As RectangleF
Dim result As New RectangleF
Dim objrect As New RectangleF(obj.Location, obj.Size)
Dim size As SizeF = imageSize
Dim clientRectangle As RectangleF = objrect
Dim val As Single = clientRectangle.Width / size.Width
clientRectangle = objrect
Dim num As Single = Math.Min(val, clientRectangle.Height / size.Height)
result.Width = CInt(Math.Truncate(size.Width * num))
result.Height = CInt(Math.Truncate(size.Height * num))
clientRectangle = objrect
result.X = (clientRectangle.Width - result.Width) \ 2
clientRectangle = objrect
result.Y = (clientRectangle.Height - result.Height) \ 2
Return result
End Function
Public Shared Sub DrawTriangle(e As PaintingObjectPaintEventArgs)
Dim obj As PaintingObject = e.PaintingObject
If obj.EnableFill Then
Dim b As New SolidBrush(obj.FillColor)
Dim p1 As New Point(obj.Size.Width / 2 + e.X, e.Y)
Dim p2 As New Point(e.X, e.Y + obj.Size.Height)
Dim p3 As New Point(e.X + obj.Size.Width, e.Y + obj.Size.Height)
e.Graphics.FillPolygon(b, {p1, p2, p3})
End If
If obj.EnableOutline Then
Dim lw As Single = obj.OutlineThicknes
Dim p As New Pen(obj.OutlineColor, obj.OutlineThicknes) With {.DashStyle = obj.OutlineDashStyle, .Alignment = PenAlignment.Inset}
Dim p1 As New Point(obj.Size.Width / 2 + e.X, e.Y)
Dim p2 As New Point(e.X, e.Y + obj.Size.Height)
Dim p3 As New Point(e.X + obj.Size.Width, e.Y + obj.Size.Height)
e.Graphics.DrawPolygon(p, {p1, p2, p3})
End If
End Sub
Public Shared Sub DrawRectangle(e As PaintingObjectPaintEventArgs)
Dim obj As PaintingObject = e.PaintingObject
Dim hol As Single = obj.OutlineThicknes / 2
If obj.EnableFill Then
Dim b As New SolidBrush(obj.FillColor)
Dim rect As Rectangle = If(obj.EnableOutline,
New Rectangle(e.X + hol, e.Y + hol, obj.Size.Width - hol * 2, obj.Size.Height - hol * 2),
New Rectangle(e.X, e.Y, obj.Size.Width, obj.Size.Height))
e.Graphics.FillRectangle(b, rect)
End If
If obj.EnableOutline Then
Dim p As New Pen(obj.OutlineColor, obj.OutlineThicknes) With {.DashStyle = obj.OutlineDashStyle, .Alignment = PenAlignment.Inset}
Dim rect As New Rectangle(e.X, e.Y, obj.Size.Width, obj.Size.Height)
e.Graphics.DrawRectangle(p, rect)
End If
End Sub
Public Shared Sub DrawEllipse(e As PaintingObjectPaintEventArgs)
Dim obj As PaintingObject = e.PaintingObject
If obj.EnableFill Then
Dim b As New SolidBrush(obj.FillColor)
Dim rect As Rectangle = New Rectangle(e.X, e.Y, obj.Size.Width, obj.Size.Height)
e.Graphics.FillEllipse(b, rect)
End If
If obj.EnableOutline Then
Dim p As New Pen(obj.OutlineColor, obj.OutlineThicknes) With {.DashStyle = obj.OutlineDashStyle, .Alignment = PenAlignment.Inset}
Dim rect As New Rectangle(e.X, e.Y, obj.Size.Width, obj.Size.Height)
e.Graphics.DrawEllipse(p, rect)
End If
End Sub
Public Shared Sub DrawSelection(e As PaintingObjectPaintEventArgs)
Dim obj As PaintingObject = e.PaintingObject
Dim lw As Single = 2.5!
Dim hlw As Single = lw / 2
Dim hlwphol As Single = hlw '+ hol
Dim hlwpholm2 As Single = hlwphol * 2
Dim p As New Pen(Color.CornflowerBlue, lw) With {.DashStyle = obj.SelectionDashStyle, .Alignment = PenAlignment.Outset}
Dim rect As New Rectangle(e.X - hlwphol, e.Y - hlwphol, obj.Size.Width + hlwpholm2, obj.Size.Height + hlwpholm2)
e.Graphics.DrawRectangle(p, rect)
End Sub
Public Shared Sub DrawGrid(e As PaintEventArgs, pc As PaintingControl, offset As PointF)
Dim p As New Pen(pc.GridColor, 0.5)
Dim curX As Integer = pc.GridChunkSize.Width * pc.ZoomFactor.Width - offset.X
Do While curX < pc.Width
e.Graphics.DrawLine(p, curX, -offset.Y, curX, pc.Height)
curX += (pc.GridChunkSize.Width * pc.ZoomFactor.Width)
Loop
Dim curY As Integer = pc.GridChunkSize.Height * pc.ZoomFactor.Height - offset.Y
Do While curY < pc.Height
e.Graphics.DrawLine(p, -offset.X, curY, pc.Width, curY)
curY += (pc.GridChunkSize.Height * pc.ZoomFactor.Height)
Loop
End Sub
Public Shared Sub DrawAreaSelection(e As PaintEventArgs, pc As PaintingControl, startMousePos As PointF, lastMousePos As PointF)
Dim p As New Pen(pc.AreaSelectionColor)
p.DashStyle = DashStyle.DashDot
p.Width = 3
Dim rectToDraw As RectangleF = HelpfulDrawingFunctions.GetRectangle(startMousePos, lastMousePos)
e.Graphics.DrawRectangle(p, rectToDraw.X, rectToDraw.Y, rectToDraw.Width, rectToDraw.Height)
End Sub
End Class

View File

@@ -0,0 +1,16 @@
Imports System.Drawing
Imports System.IO
Imports System.Windows.Forms
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq
Public Class PaintingObjectEventArgs
Inherits EventArgs
Public ReadOnly Property PaintingObjects As PaintingObject() = Nothing
Friend Sub New(paintingObjects As PaintingObject())
_PaintingObjects = paintingObjects
End Sub
End Class

View File

@@ -0,0 +1,78 @@
Imports System.Drawing
Imports System.IO
Imports System.Windows.Forms
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq
Public Class PaintingObjectPaintEventArgs
Inherits EventArgs
''' <summary>
''' The Painting Object to draw.
''' </summary>
''' <returns></returns>
Public ReadOnly Property PaintingObject As PaintingObject
''' <summary>
''' The current offset of the page on the screen.
''' </summary>
''' <returns></returns>
Public ReadOnly Property Offset As PointF
''' <summary>
''' The Grpahics from the parent PaintingControl.
''' </summary>
''' <returns></returns>
Public ReadOnly Property Graphics As Graphics
''' <summary>
''' The position of the PaintingObject on Screen.
''' </summary>
''' <returns></returns>
Public ReadOnly Property Location As PointF
Get
Return New PointF(X, Y)
End Get
End Property
''' <summary>
''' The X position of the PaintingObject on Screen.
''' </summary>
''' <returns></returns>
Public ReadOnly Property X As Single
Get
Return PaintingObject.X - Offset.X
End Get
End Property
''' <summary>
''' The Y position of the PaintingObject on Screen.
''' </summary>
''' <returns></returns>
Public ReadOnly Property Y As Single
Get
Return PaintingObject.Y - Offset.Y
End Get
End Property
''' <summary>
''' The rectangle of the PaintingObject on Screen.
''' </summary>
''' <returns></returns>
Public ReadOnly Property Rectangle As RectangleF
Get
Return New RectangleF(X, Y, PaintingObject.Width, PaintingObject.Height)
End Get
End Property
Friend Sub New(obj As PaintingObject, g As Graphics)
Me.New(obj, g, obj.Parent.Offset)
End Sub
Friend Sub New(obj As PaintingObject, g As Graphics, offset As PointF)
PaintingObject = obj
Me.Offset = offset
Graphics = g
End Sub
End Class

View File

@@ -0,0 +1,5 @@
Imports System.Drawing
Public Interface IPaintingObjectContainer
End Interface

View File

@@ -0,0 +1,5 @@
Public Class PaintingObjectImageProperties
Public Property FlipY As Boolean = False
Public Property FlipX As Boolean = False
Public Property Rotate As UShort = 0
End Class

View File

@@ -0,0 +1,120 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>

View File

@@ -0,0 +1,660 @@
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 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 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
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
RaiseEvent ZoomFactorChanged(Me, New EventArgs)
End If
End Set
End Property
Public Sub New()
DoubleBuffered = True
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 Not GetSelectedObjects.Contains(curObjMouseDown) 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 pressedShift 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 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 pressedControl 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
AutoArrangeToGrid()
'CalculateScrollValues()
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 pressedControl 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 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)
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)
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
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)
End Sub
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
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
End If
End If
Next
Return Nothing
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 EnableFullTransparentBackground 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)
Dim WM_NCHITTEST As Integer = &H84
Dim HTTRANSPARENT As Integer = -1
'If m.Msg = WM_NCHITTEST Then
' m.Result = CType(HTTRANSPARENT, IntPtr)
'Else
' MyBase.WndProc(m)
'End If
MyBase.WndProc(m)
End Sub
Protected Overrides Sub OnPaintBackground(e As PaintEventArgs)
'Stop Drawing directly to the parent
Me.SuspendLayout()
'Draw Background
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)
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
'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 = HelpfulDrawingFunctions.GetRectangle(startMousePos, lastMousePos)
For Each obj As PaintingObject In PaintingObjects
obj.Selected = HelpfulDrawingFunctions.OverlapsTwoRectangles(obj.Rectangle, rect)
Next
End Sub
Public Sub ArrangeToGrid(obj As PaintingObject)
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
If modTop > halfHeight Then
obj.Y += (zoomedGridChunkSize.Height - modTop)
Else
obj.Y -= modTop
End If
If modLeft > halfWidth Then
obj.X += (zoomedGridChunkSize.Width - modLeft)
Else
obj.X -= modLeft
End If
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
If modW > halfWidth Then
obj.Width += (zoomedGridChunkSize.Width - modW)
Else
obj.Width -= modW
End If
End If
End Sub
Public Sub AutoArrangeToGrid()
If GridEnabled Then
For Each obj As PaintingObject In GetSelectedObjects()
If obj.AutoAlignToGrid Then
ArrangeToGrid(obj)
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

View File

@@ -0,0 +1,6 @@
Imports System.Drawing
Imports System.Windows.Forms
Public Delegate Sub DelegateDrawPaintingObjectMethode(e As PaintingObjectPaintEventArgs)
Public Delegate Sub DelegateDrawPaintingControlGridMethode(e As PaintEventArgs, pc As PaintingControl, offset As PointF)
Public Delegate Sub DelegateDrawPaintingControlAreaSelectionMethode(e As PaintEventArgs, pc As PaintingControl, startMousePos As PointF, lastMousePos As PointF)

View File

@@ -0,0 +1,586 @@
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 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 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
Public Sub RaiseMouseClick(e As MouseEventArgs)
RaiseEvent MouseClick(Me, e)
End Sub
Public Sub RaiseMouseDown(e As MouseEventArgs)
RaiseEvent MouseDown(Me, e)
End Sub
Public Sub RaiseMouseUp(e As MouseEventArgs)
RaiseEvent MouseUp(Me, e)
End Sub
Public Sub RaiseMouseMove(e As MouseEventArgs)
RaiseEvent MouseMove(Me, e)
End Sub
Private Sub RaisePaint(e As PaintEventArgs)
RaiseEvent Paint(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 ReadOnly Property Right As Integer
Get
Return X + Width
End Get
End Property
<JsonIgnore> Public ReadOnly Property Bottom() As Integer
Get
Return Y + Height
End Get
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)
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
dm?.Invoke(poevargs)
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 t As Type = Me.GetType
Dim blackField As New List(Of String) From {
NameOf(_PinnedObjects),
NameOf(resizeEngine),
NameOf(_Parent),
NameOf(BufferedImage)
}
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
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

View File

@@ -0,0 +1,85 @@
Public Class PaintingObjectLayering
Public ReadOnly Property PaintingObject As PaintingObject
''' <summary>
''' Get the current object list from the painting object.
''' </summary>
''' <returns>Returns the current object list from the painting object.</returns>
Public ReadOnly Property ObjectList As PaintingObjectList
Get
Return PaintingObject.Parent.PaintingObjects
End Get
End Property
''' <summary>
''' Create a new instance of object layer managing.
''' </summary>
''' <param name="obj"></param>
Public Sub New(obj As PaintingObject)
PaintingObject = obj
End Sub
''' <summary>
''' Moves the object by the given number of indicies.
''' </summary>
''' <param name="count">The number how many objects it should be moved.</param>
Public Sub MoveObject(count As Integer)
Dim oldIndex As Integer = ObjectList.IndexOf(PaintingObject)
Dim newIndex As Integer = oldIndex + count
MoveObjectTo(newIndex)
End Sub
''' <summary>
''' Moves the object to the new index.
''' </summary>
''' <param name="newIndex"></param>
Public Sub MoveObjectTo(newIndex As Integer)
Dim list As PaintingObjectList = ObjectList
'Check & make index valid
If newIndex >= ObjectList.Count Then
newIndex = ObjectList.Count - 1
ElseIf newIndex < 0 Then
newIndex = 0
End If
'Remove object
list.Remove(PaintingObject)
'Insert object at new index
list.Insert(newIndex, PaintingObject)
'Order all objects again
list.Layering.OrderAll()
End Sub
''' <summary>
''' Moves the object to the front.
''' </summary>
Public Sub BringToTop()
MoveObjectTo(ObjectList.Count - 1)
End Sub
''' <summary>
''' Moves the object to the back.
''' </summary>
Public Sub SendToBack()
MoveObjectTo(0)
End Sub
''' <summary>
''' Moves the object fordward by one
''' </summary>
Public Sub OneToTop()
MoveObject(+1)
End Sub
''' <summary>
''' Moves the object backward by one
''' </summary>
Public Sub OneToBack()
MoveObject(-1)
End Sub
End Class

View File

@@ -0,0 +1,73 @@
Public Class PaintingObjectListLayering
Public ReadOnly Property ObjectList As PaintingObjectList
Public ReadOnly Property Conditions As New Dictionary(Of Integer, Func(Of PaintingObject, Boolean))
''' <summary>
''' Get the order function will checkout the conditions.
''' </summary>
''' <returns>Returns true, if conditions are aviable, otherwise false.</returns>
Public ReadOnly Property EnableConditions As Boolean
Get
Return Conditions.Any
End Get
End Property
''' <summary>
''' Create a new instance of object list layer managing.
''' </summary>
''' <param name="list"></param>
Public Sub New(list As PaintingObjectList)
ObjectList = list
End Sub
''' <summary>
''' Order all objects using the conditions. If no conditions are setted, this method will do nothing.
''' </summary>
Public Sub OrderAll()
If EnableConditions Then
OrderAllPrivate()
End If
End Sub
Private Sub OrderAllPrivate()
Dim list As PaintingObjectList = ObjectList
Dim listOld As List(Of PaintingObject) = list.ToList
Dim toRemove As New List(Of PaintingObject)
'Disable raising events
ObjectList.EnableRaisingEvents = False
'Clear list
list.Clear()
'Add ordered
For Each kvp In Conditions.OrderBy(Function(n) n.Key)
Dim func = kvp.Value
For Each obj As PaintingObject In listOld
If func(obj) Then
'Add to list
list.Add(obj)
'Add to remove
toRemove.Add(obj)
End If
Next
'Remove remembered objects
For Each obj As PaintingObject In toRemove
listOld.Remove(obj)
Next
toRemove.Clear()
Next
'Enable raising events
ObjectList.EnableRaisingEvents = True
'Refresh
ObjectList.MyParent?.Refresh()
End Sub
End Class

View File

@@ -0,0 +1,171 @@
Imports System.Drawing
Imports System.Windows.Forms
Imports Newtonsoft.Json
Imports Pilz.Drawing
<Serializable> Friend Class PaintingObjectResizing
Private WithEvents mObj As PaintingObject
Private WithEvents mObjParent As Control = Nothing
Private WithEvents mObjControl As Control = Nothing
Private mMouseDown As Boolean = False
Private mEdge As EdgeEnum = EdgeEnum.None
Private mWidth As Integer = 4
Private qWidth As Integer = 4 * 4
Private rect As New Rectangle
Public Property Enabled As Boolean = True
Public Property MinimumSize As New SizeF(15, 15)
<Serializable> Private Enum EdgeEnum
None
Right
Left
Top
Bottom
TopLeft
TopRight
BottomLeft
BottomRight
End Enum
Public ReadOnly Property IsResizing As Boolean
Get
Return mMouseDown AndAlso mEdge <> EdgeEnum.None
End Get
End Property
Public Sub New(obj As PaintingObject)
mObj = obj
mObjControl = mObj.Parent
End Sub
Shared Function ApplyToControl(obj As PaintingObject) As PaintingObjectResizing
Return New PaintingObjectResizing(obj)
End Function
Private Sub mControl_MouseDown(sender As Object, e As MouseEventArgs) Handles mObj.MouseDown
If e.Button = System.Windows.Forms.MouseButtons.Left Then
mMouseDown = True
End If
End Sub
Private Sub mControl_MouseUp(sender As Object, e As MouseEventArgs) Handles mObj.MouseUp
mMouseDown = False
If mObj.Selected Then
mObj.AutoArrangeToGrid()
End If
End Sub
Private Sub KeepInRange(ByRef size As SizeF)
If size.Height < MinimumSize.Height OrElse size.Width < MinimumSize.Width Then
size = New SizeF(Math.Max(size.Width, MinimumSize.Width),
Math.Max(size.Height, MinimumSize.Height))
End If
End Sub
Private Sub mControl_MouseMove(sender As Object, e As MouseEventArgs) Handles mObjControl.MouseMove
If mMouseDown AndAlso mEdge <> EdgeEnum.None Then
Dim eX As Integer = e.X + mObj.Parent.Offset.X
Dim eY As Integer = e.Y + mObj.Parent.Offset.Y
Select Case mEdge
Case EdgeEnum.TopLeft
mObj.SetBounds(eX, eY, mObj.Width + (mObj.Left - eX), mObj.Height + (mObj.Top - eY))
Case EdgeEnum.TopRight
mObj.SetBounds(mObj.Left, eY, eX - mObj.Left, mObj.Height + (mObj.Top - eY))
Case EdgeEnum.BottomRight
mObj.SetBounds(mObj.Left, mObj.Top, eX - mObj.Left, eY - mObj.Top)
Case EdgeEnum.BottomLeft
mObj.SetBounds(eX, mObj.Top, mObj.Width + (mObj.Left - eX), eY - mObj.Top)
Case EdgeEnum.Left
mObj.SetBounds(eX, mObj.Top, mObj.Width + (mObj.Left - eX), mObj.Height)
Case EdgeEnum.Right
mObj.SetBounds(mObj.Left, mObj.Top, eX - mObj.Left, mObj.Height)
Case EdgeEnum.Top
mObj.SetBounds(mObj.Left, eY, mObj.Width, mObj.Height + (mObj.Top - eY))
Case EdgeEnum.Bottom
mObj.SetBounds(mObj.Left, mObj.Top, mObj.Width, eY - mObj.Top)
End Select
KeepInRange(mObj.Size)
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 eLocation As New Point(eX, eY)
Dim extRect As RectangleF = mObj.RectangleExtended
Dim oldRect As RectangleF = mObj.Rectangle
Dim newRect As New RectangleF
newRect.X = extRect.X - oldRect.X
newRect.Y = extRect.Y - oldRect.Y
newRect.Width = (extRect.Width - oldRect.Width) / 2
newRect.Height = (extRect.Height - oldRect.Height) / 2
Dim setToNone As Boolean = False
If Enabled Then
Select Case True
Case HelpfulDrawingFunctions.IsPointInRectangle(eLocation, New Rectangle(newRect.X, newRect.Y, newRect.Width, newRect.Height))
mObj.Cursor = Cursors.SizeNWSE
mEdge = EdgeEnum.TopLeft
Case HelpfulDrawingFunctions.IsPointInRectangle(eLocation, New Rectangle(mObj.Width, newRect.Y, newRect.Width, newRect.Height))
mObj.Cursor = Cursors.SizeNESW
mEdge = EdgeEnum.TopRight
Case HelpfulDrawingFunctions.IsPointInRectangle(eLocation, New Rectangle(mObj.Width, mObj.Height, newRect.Width, newRect.Height))
mObj.Cursor = Cursors.SizeNWSE
mEdge = EdgeEnum.BottomRight
Case HelpfulDrawingFunctions.IsPointInRectangle(eLocation, New Rectangle(newRect.X, mObj.Height, newRect.Width, newRect.Height))
mObj.Cursor = Cursors.SizeNESW
mEdge = EdgeEnum.BottomLeft
Case HelpfulDrawingFunctions.IsPointInRectangle(eLocation, New Rectangle(-newRect.Width, 0, newRect.Width, mObj.Height))
mObj.Cursor = Cursors.SizeWE
mEdge = EdgeEnum.Left
Case HelpfulDrawingFunctions.IsPointInRectangle(eLocation, New Rectangle(mObj.Width, 0, newRect.Width, mObj.Height))
mObj.Cursor = Cursors.SizeWE
mEdge = EdgeEnum.Right
Case HelpfulDrawingFunctions.IsPointInRectangle(eLocation, New Rectangle(0, -newRect.Height, mObj.Width, newRect.Height))
mObj.Cursor = Cursors.SizeNS
mEdge = EdgeEnum.Top
Case HelpfulDrawingFunctions.IsPointInRectangle(eLocation, New Rectangle(0, mObj.Height, mObj.Width, newRect.Height))
mObj.Cursor = Cursors.SizeNS
mEdge = EdgeEnum.Bottom
Case Else
setToNone = True
End Select
Else
setToNone = True
End If
If setToNone Then
mObj.Cursor = Cursors.Default
mEdge = EdgeEnum.None
End If
End If
End Sub
Private Sub mControl_Paint(sender As PaintingObject, e As PaintEventArgs) Handles mObj.Paint
'e.Graphics.FillRectangle(brush, rect)
End Sub
Private Sub mControl_MouseLeave(ByVal sender As PaintingObject, ByVal e As EventArgs) Handles mObj.SelectedChanged
If Not sender.Selected Then
mEdge = EdgeEnum.None
End If
End Sub
Private Sub mObjParent_ParentChanged(sender As Object, e As EventArgs) Handles mObjControl.ParentChanged
mObjParent = mObjControl.Parent
End Sub
Private Sub mObj_ParentChanged(sender As PaintingObject, e As EventArgs) Handles mObj.ParentChanged
mObjControl = mObj.Parent
mObjParent = mObjControl?.Parent
End Sub
End Class

View File

@@ -0,0 +1,27 @@
<?xml version="1.0"?>
<package xmlns="http://schemas.microsoft.com/packaging/2013/05/nuspec.xsd">
<metadata>
<id>PaintingControls</id>
<version>1.0.0.0</version>
<title>PaintingControls</title>
<authors>Pilzinsel64</authors>
<owners>Pilzinsel64</owners>
<licenseUrl>https://github.com/dotnet/corefx/blob/master/LICENSE.TXT</licenseUrl>
<projectUrl>https://www.nuget.org/packages/PaintingControls/</projectUrl>
<requireLicenseAcceptance>false</requireLicenseAcceptance>
<description>Create an PaintingControl and add several PaintingObjects containing visual objects.
The PaintingControl has some user actions that can be enabled/disabled.
Also you can completly customize the drawing process of an PaintingObject.
It is very simple to use.</description>
<releaseNotes></releaseNotes>
<copyright>Copyright © Pilzinsel64 2018</copyright>
<tags>control object paint visual</tags>
<dependencies>
<dependency id="Newtonsoft.Json" version="11.0.2"/>
</dependencies>
<summary>PaintingControls is a simple way to paint and control visual objects.</summary>
</metadata>
<files>
<file src="lib\**" target="lib/" />
</files>
</package>

Binary file not shown.

View File

@@ -0,0 +1,32 @@
<?xml version="1.0"?>
<doc>
<assembly>
<name>
PaintingControls
</name>
</assembly>
<members>
<member name="T:PaintingControls.My.Resources.Resources">
<summary>
A strongly-typed resource class, for looking up localized strings, etc.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.ResourceManager">
<summary>
Returns the cached ResourceManager instance used by this class.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.Culture">
<summary>
Overrides the current thread's CurrentUICulture property for all
resource lookups using this strongly typed resource class.
</summary>
</member>
<member name="M:PaintingControls.PaintingControl.WndProc(System.Windows.Forms.Message@)">
<summary>
Sorg dafür, dass Events durch dieses Control durchdringen zum Parnet-Control.
</summary>
<param name="m"></param>
</member>
</members>
</doc>

Binary file not shown.

View File

@@ -0,0 +1,32 @@
<?xml version="1.0"?>
<doc>
<assembly>
<name>
PaintingControls
</name>
</assembly>
<members>
<member name="T:PaintingControls.My.Resources.Resources">
<summary>
Eine stark typisierte Ressourcenklasse zum Suchen von lokalisierten Zeichenfolgen usw.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.ResourceManager">
<summary>
Gibt die zwischengespeicherte ResourceManager-Instanz zurück, die von dieser Klasse verwendet wird.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.Culture">
<summary>
Überschreibt die CurrentUICulture-Eigenschaft des aktuellen Threads für alle
Ressourcenzuordnungen, die diese stark typisierte Ressourcenklasse verwenden.
</summary>
</member>
<member name="M:PaintingControls.PaintingControl.WndProc(System.Windows.Forms.Message@)">
<summary>
Sorg dafür, dass Events durch dieses Control durchdringen zum Parnet-Control.
</summary>
<param name="m"></param>
</member>
</members>
</doc>

Binary file not shown.

View File

@@ -0,0 +1,32 @@
<?xml version="1.0"?>
<doc>
<assembly>
<name>
PaintingControls
</name>
</assembly>
<members>
<member name="T:PaintingControls.My.Resources.Resources">
<summary>
Eine stark typisierte Ressourcenklasse zum Suchen von lokalisierten Zeichenfolgen usw.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.ResourceManager">
<summary>
Gibt die zwischengespeicherte ResourceManager-Instanz zurück, die von dieser Klasse verwendet wird.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.Culture">
<summary>
Überschreibt die CurrentUICulture-Eigenschaft des aktuellen Threads für alle
Ressourcenzuordnungen, die diese stark typisierte Ressourcenklasse verwenden.
</summary>
</member>
<member name="M:PaintingControls.PaintingControl.WndProc(System.Windows.Forms.Message@)">
<summary>
Sorg dafür, dass Events durch dieses Control durchdringen zum Parnet-Control.
</summary>
<param name="m"></param>
</member>
</members>
</doc>

Binary file not shown.

View File

@@ -0,0 +1,32 @@
<?xml version="1.0"?>
<doc>
<assembly>
<name>
PaintingControls
</name>
</assembly>
<members>
<member name="T:PaintingControls.My.Resources.Resources">
<summary>
Eine stark typisierte Ressourcenklasse zum Suchen von lokalisierten Zeichenfolgen usw.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.ResourceManager">
<summary>
Gibt die zwischengespeicherte ResourceManager-Instanz zurück, die von dieser Klasse verwendet wird.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.Culture">
<summary>
Überschreibt die CurrentUICulture-Eigenschaft des aktuellen Threads für alle
Ressourcenzuordnungen, die diese stark typisierte Ressourcenklasse verwenden.
</summary>
</member>
<member name="M:PaintingControls.PaintingControl.WndProc(System.Windows.Forms.Message@)">
<summary>
Sorg dafür, dass Events durch dieses Control durchdringen zum Parnet-Control.
</summary>
<param name="m"></param>
</member>
</members>
</doc>

Binary file not shown.

View File

@@ -0,0 +1,32 @@
<?xml version="1.0"?>
<doc>
<assembly>
<name>
PaintingControls
</name>
</assembly>
<members>
<member name="T:PaintingControls.My.Resources.Resources">
<summary>
Eine stark typisierte Ressourcenklasse zum Suchen von lokalisierten Zeichenfolgen usw.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.ResourceManager">
<summary>
Gibt die zwischengespeicherte ResourceManager-Instanz zurück, die von dieser Klasse verwendet wird.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.Culture">
<summary>
Überschreibt die CurrentUICulture-Eigenschaft des aktuellen Threads für alle
Ressourcenzuordnungen, die diese stark typisierte Ressourcenklasse verwenden.
</summary>
</member>
<member name="M:PaintingControls.PaintingControl.WndProc(System.Windows.Forms.Message@)">
<summary>
Sorg dafür, dass Events durch dieses Control durchdringen zum Parnet-Control.
</summary>
<param name="m"></param>
</member>
</members>
</doc>

Binary file not shown.

View File

@@ -0,0 +1,32 @@
<?xml version="1.0"?>
<doc>
<assembly>
<name>
PaintingControls
</name>
</assembly>
<members>
<member name="T:PaintingControls.My.Resources.Resources">
<summary>
Eine stark typisierte Ressourcenklasse zum Suchen von lokalisierten Zeichenfolgen usw.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.ResourceManager">
<summary>
Gibt die zwischengespeicherte ResourceManager-Instanz zurück, die von dieser Klasse verwendet wird.
</summary>
</member>
<member name="P:PaintingControls.My.Resources.Resources.Culture">
<summary>
Überschreibt die CurrentUICulture-Eigenschaft des aktuellen Threads für alle
Ressourcenzuordnungen, die diese stark typisierte Ressourcenklasse verwenden.
</summary>
</member>
<member name="M:PaintingControls.PaintingControl.WndProc(System.Windows.Forms.Message@)">
<summary>
Sorg dafür, dass Events durch dieses Control durchdringen zum Parnet-Control.
</summary>
<param name="m"></param>
</member>
</members>
</doc>

Binary file not shown.

156
Pilz.UI/Pilz.UI.vbproj Normal file
View File

@@ -0,0 +1,156 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="15.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProjectGuid>{827C60BF-4D92-4D39-92F0-4285923266A1}</ProjectGuid>
<OutputType>Library</OutputType>
<RootNamespace>Pilz.UI</RootNamespace>
<AssemblyName>Pilz.UI</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Windows</MyType>
<TargetFrameworkVersion>v4.5</TargetFrameworkVersion>
<TargetFrameworkProfile />
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>Pilz.UI.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>none</DebugType>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>Pilz.UI.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<RemoveIntegerChecks>true</RemoveIntegerChecks>
</PropertyGroup>
<PropertyGroup>
<OptionExplicit>On</OptionExplicit>
</PropertyGroup>
<PropertyGroup>
<OptionCompare>Binary</OptionCompare>
</PropertyGroup>
<PropertyGroup>
<OptionStrict>Off</OptionStrict>
</PropertyGroup>
<PropertyGroup>
<OptionInfer>On</OptionInfer>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Debug|x86'">
<DebugSymbols>true</DebugSymbols>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x86\Debug\</OutputPath>
<DocumentationFile>Pilz.UI.xml</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<DebugType>full</DebugType>
<PlatformTarget>x86</PlatformTarget>
<CodeAnalysisRuleSet>MinimumRecommendedRules.ruleset</CodeAnalysisRuleSet>
<UseVSHostingProcess>true</UseVSHostingProcess>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Release|x86'">
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x86\Release\</OutputPath>
<RemoveIntegerChecks>true</RemoveIntegerChecks>
<DocumentationFile>Pilz.UI.xml</DocumentationFile>
<Optimize>true</Optimize>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<PlatformTarget>x86</PlatformTarget>
<CodeAnalysisRuleSet>MinimumRecommendedRules.ruleset</CodeAnalysisRuleSet>
</PropertyGroup>
<ItemGroup>
<Reference Include="Newtonsoft.Json, Version=12.0.0.0, Culture=neutral, PublicKeyToken=30ad4fe6b2a6aeed, processorArchitecture=MSIL">
<HintPath>..\packages\Newtonsoft.Json.12.0.1\lib\net45\Newtonsoft.Json.dll</HintPath>
</Reference>
<Reference Include="System" />
<Reference Include="System.Data" />
<Reference Include="System.Drawing" />
<Reference Include="System.Windows.Forms" />
<Reference Include="System.Xml" />
<Reference Include="System.Core" />
<Reference Include="System.Xml.Linq" />
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="System.Net.Http" />
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Collections.Generic" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
<Import Include="System.Linq" />
<Import Include="System.Xml.Linq" />
<Import Include="System.Threading.Tasks" />
</ItemGroup>
<ItemGroup>
<Compile Include="PaintingControl\ImageProperties.vb" />
<Compile Include="PaintingControl\IPaintingObjectContainer.vb" />
<Compile Include="PaintingControl\PaintingControlDelegates.vb" />
<Compile Include="PaintingControl\DefaultDrawMethodes.vb" />
<Compile Include="PaintingControl\EventArgs\PaintingObjectPaintEventArgs.vb" />
<Compile Include="PaintingControl\EventArgs\PaintingObjectEventArgs.vb" />
<Compile Include="PaintingControl\PaintingObjectLayering.vb" />
<Compile Include="PaintingControl\PaintingObjectListLayering.vb" />
<Compile Include="PaintingControl\PaintingControl.vb">
<SubType>UserControl</SubType>
</Compile>
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
</Compile>
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>Resources.resx</DependentUpon>
</Compile>
<Compile Include="My Project\Settings.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
<Compile Include="PaintingControl\PaintingObject.vb" />
<Compile Include="PaintingControl\PaintingObjectResizing.vb" />
<Compile Include="Utilities\DrawingControl.vb" />
<Compile Include="Utilities\User32Bridge.vb" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="My Project\Resources.resx">
<Generator>VbMyResourcesResXFileCodeGenerator</Generator>
<LastGenOutput>Resources.Designer.vb</LastGenOutput>
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<SubType>Designer</SubType>
</EmbeddedResource>
<EmbeddedResource Include="PaintingControl\PaintingControl.resx">
<DependentUpon>PaintingControl.vb</DependentUpon>
</EmbeddedResource>
</ItemGroup>
<ItemGroup>
<None Include="My Project\Application.myapp">
<Generator>MyApplicationCodeGenerator</Generator>
<LastGenOutput>Application.Designer.vb</LastGenOutput>
</None>
<None Include="My Project\Settings.settings">
<Generator>SettingsSingleFileGenerator</Generator>
<CustomToolNamespace>My</CustomToolNamespace>
<LastGenOutput>Settings.Designer.vb</LastGenOutput>
</None>
<None Include="packages.config" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Pilz.Drawing\Pilz.Drawing.vbproj">
<Project>{1a0b8106-2449-4908-b5e1-a00d8e9cf8f6}</Project>
<Name>Pilz.Drawing</Name>
</ProjectReference>
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>

View File

@@ -0,0 +1,28 @@
Imports System.Runtime.CompilerServices
Imports System.Windows.Forms
Namespace Utils
Public Module DrawingControl
Private Const WM_SETREDRAW = 11
<Extension>
Public Sub SuspendDrawing(control As Control)
SendMessage(control.Handle, WM_SETREDRAW, False, 0)
End Sub
<Extension>
Public Sub ResumeDrawing(control As Control)
ResumeDrawing(control, True)
End Sub
<Extension>
Public Sub ResumeDrawing(control As Control, redraw As Boolean)
SendMessage(control.Handle, WM_SETREDRAW, True, 0)
If redraw Then control.Refresh()
End Sub
End Module
End Namespace

View File

@@ -0,0 +1,5 @@
Public Module User32Bridge
Friend Declare Auto Function SendMessage Lib "user32.dll" (hWnd As IntPtr, Msg As Integer, wParam As Boolean, lParam As Integer) As Integer
End Module

4
Pilz.UI/packages.config Normal file
View File

@@ -0,0 +1,4 @@
<?xml version="1.0" encoding="utf-8"?>
<packages>
<package id="Newtonsoft.Json" version="12.0.1" targetFramework="net45" />
</packages>