Imports System.Drawing Imports System.Windows.Forms Imports Pilz.Drawing Friend Class PaintingObjectResizing Public Shared Event CheckEnabled(sender As PaintingObjectResizing, ByRef enabled As Boolean) 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) 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 ReadOnly Property PaintingObject As PaintingObject Get Return mObj End Get End Property Public Sub New(obj As PaintingObject) mObj = obj mObjControl = mObj.Parent End Sub Private Function IsEnabled() As Boolean Dim enabled = Me.Enabled RaiseEvent CheckEnabled(Me, enabled) Return enabled 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 eXo As Integer = e.X Dim eYo As Integer = e.Y Dim realX As Integer = eXo + mObj.Parent.Offset.X Dim realY As Integer = eYo + mObj.Parent.Offset.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 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 Dim isOnTop As Boolean = mObj.Parent.GetObject(New PointF(realX, realY), True) Is mObj If IsEnabled() AndAlso isOnTop 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