CodePaste Logo
New Snippet New Snippet Recent Snippets Recent Snippets My Snippets My Snippets Web Code Search Snippets Search
Sign inor Register
Language: VB.NET

AllExperts 20100811

188 Views
Copy Code Show/Hide Line Numbers
Imports System.Windows
Imports System.Windows.Forms
 
Public Class Form1
    Dim rc As ResizeableControl
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        rc = New ResizeableControl(RichTextBox1)
        rc = New ResizeableControl(PictureBox1)
        AddHandler Me.Click, AddressOf Object_Click
        For Each ctl As Control In Me.Controls
            AddHandler ctl.Click, AddressOf Object_Click
        Next
    End Sub
 
    Private Sub Object_Click(ByVal sender As System.Object, ByVal e As EventArgs)
        Dim c As Control = CType(sender, Control)
        For Each ctl As Control In Me.Controls
            If Not ctl.Equals(c) Then
                ctl.Refresh()
            End If
        Next
    End Sub
 
    Public Class ResizeableControl
        Private WithEvents mControl As Control
        Private mMouseDown As Boolean = False
        Private mEdge As EdgeEnum = EdgeEnum.None
        Private medge1 As EdgeEnum = EdgeEnum.TopLeft
        Private medge2 As EdgeEnum = EdgeEnum.Top
        Private medge3 As EdgeEnum = EdgeEnum.Bottom
        Private medge4 As EdgeEnum = EdgeEnum.Left
        Private medge5 As EdgeEnum = EdgeEnum.Right
        Private mWidth As Integer = 4
        Private mOutlineDrawn As Boolean = False
        Private Enum EdgeEnum
            None
            Right
            Left
            Top
            Bottom
            TopLeft
        End Enum
 
        Public Sub New(ByVal Control As Control)
            mControl = Control
        End Sub
        Private Sub mControl_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles mControl.MouseDown
            If e.Button = Windows.Forms.MouseButtons.Left Then mMouseDown = True
            DrawControlBorders()
        End Sub
        Private Sub DrawControlBorders()
            If Not mMouseDown Then Exit Sub
            Dim c As Control = mControl
            c.Refresh()
            Dim g As Graphics = c.CreateGraphics
            Dim cPen As New Pen(Color.Blue)
            cPen.DashStyle = Drawing2D.DashStyle.Dash
            cPen.Width = 2
            cPen.LineJoin = Drawing2D.LineJoin.Bevel
            g.DrawRectangle(cPen, 0, 0, g.VisibleClipBounds.Width, g.VisibleClipBounds.Height)
 
            Dim sides As New List(Of Rectangle)
            sides.Add(New Rectangle(0, 0, mWidth * 4, mWidth * 4))
            sides.Add(New Rectangle(0, Convert.ToInt32(c.Height / 2) - 4, 8, 8))
            sides.Add(New Rectangle(c.Width - mWidth - 4, Convert.ToInt32(c.Height / 2) - 4, 8, 8))
            sides.Add(New Rectangle(Convert.ToInt32(c.Width / 2) - 4, 0, 8, 8))
            sides.Add(New Rectangle(Convert.ToInt32(c.Width / 2) - 4, c.Height - mWidth - 4, 8, 8))
            g.FillRectangles(Brushes.Blue, sides.ToArray)
        End Sub
        Private Sub mControl_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles mControl.MouseUp
            mMouseDown = False
        End Sub
        Private Sub mControl_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles mControl.MouseMove
 
            Dim c As Control = CType(sender, Control)
 
            If mMouseDown And mEdge <> EdgeEnum.None Then
                c.SuspendLayout()
                Select Case mEdge
                    Case EdgeEnum.TopLeft
                        c.SetBounds(c.Left + e.X, c.Top + e.Y, c.Width, c.Height)
                    Case EdgeEnum.Left
                        c.SetBounds(c.Left + e.X, c.Top, c.Width - e.X, c.Height)
                    Case EdgeEnum.Right
                        c.SetBounds(c.Left, c.Top, c.Width - (c.Width - e.X), c.Height)
                    Case EdgeEnum.Top
                        c.SetBounds(c.Left, c.Top + e.Y, c.Width, c.Height - e.Y)
                    Case EdgeEnum.Bottom
                        c.SetBounds(c.Left, c.Top, c.Width, c.Height - (c.Height - e.Y))
                End Select
                c.ResumeLayout()
            Else
                Select Case True
                    Case e.X <= (mWidth * 4) And e.Y <= (mWidth * 4) 'top left corner
                        c.Cursor = Cursors.SizeAll
                        mEdge = EdgeEnum.TopLeft
                    Case (e.X <= mWidth AndAlso e.Y >= Convert.ToInt32(c.Height / 2) - 4 AndAlso e.Y <= Convert.ToInt32(c.Height / 2) + 4)  'left edge
                        c.Cursor = Cursors.SizeWE
                        mEdge = EdgeEnum.Left
                    Case (e.X > c.Width - (mWidth + 1) AndAlso e.Y >= Convert.ToInt32(c.Height / 2) - 4 AndAlso e.Y <= Convert.ToInt32(c.Height / 2) + 4) 'right edge
                        c.Cursor = Cursors.SizeWE
                        mEdge = EdgeEnum.Right
                    Case (e.Y <= mWidth AndAlso e.X >= Convert.ToInt32(c.Width / 2) - 4 AndAlso e.X <= Convert.ToInt32(c.Width / 2) + 4) 'top edge
                        c.Cursor = Cursors.SizeNS
                        mEdge = EdgeEnum.Top
                    Case (e.Y > c.Height - (mWidth + 1) AndAlso e.X >= Convert.ToInt32(c.Width / 2) - 4 AndAlso e.X <= Convert.ToInt32(c.Width / 2) + 4) 'bottom edge
                        c.Cursor = Cursors.SizeNS
                        mEdge = EdgeEnum.Bottom
                    Case Else 'no edge
                        c.Cursor = Cursors.Default
                        mEdge = EdgeEnum.None
                End Select
            End If
            Me.DrawControlBorders()
        End Sub
 
        Private Sub mControl_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles mControl.MouseLeave
            Dim c As Control = CType(sender, Control)
            mEdge = EdgeEnum.None
            '            c.Refresh()
            mMouseDown = False
        End Sub
 
    End Class
 
    
End Class
by Mayank
  August 11, 2010 @ 2:55pm

Add a comment


Report Abuse
brought to you by:
West Wind Techologies



If you find this site useful and use it frequently please consider making a donation to support this free service.
Donate