运行时改变控件大小

Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Drawing.Drawing2D

Namespace RectControl
    Public Class CRectControl
        Inherits System.Windows.Forms.UserControl

        Private baseRect As Rectangle '移动后控件相对于窗体的rect 
        Private ControlRect As Rectangle '控件本身的Rect，用于鼠标击键测试 
        Private SmallRect As Rectangle() = New Rectangle(7) {} '8个允许调整控件大小的小正方形 
        Private BoundRect As Rectangle() = New Rectangle(3) {}  'CRectControl边框 
        Private Square As New Size(6, 6)  '小正方形的大小 
        Private currentControl As Control

        Private prevLeftClick As Point '保存鼠标单击的位置，以备释放鼠标时计算距离 
        Private isFirst As Boolean = True

        Private Enum HitDownSquare
            HDS_NONE = 0
            HDS_TOP = 1
            HDS_RIGHT = 2
            HDS_BOTTOM = 3
            HDS_LEFT = 4
            HDS_TOPLEFT = 5
            HDS_TOPRIGHT = 6
            HDS_BOTTOMLEFT = 7
            HDS_BOTTOMRIGHT = 8
        End Enum

        Private CurrHitPlace As HitDownSquare

        Public Sub New(ByVal theControl As Control)
            InitializeComponent()
            currentControl = theControl
            Call Create()
        End Sub

        Private Sub InitializeComponent()
            Me.BackColor = System.Drawing.Color.Transparent
            Me.Name = "TestMoveAndResizeControl"
            'Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
        End Sub

        Public Property Rect() As Rectangle
            Get
                Return baseRect
            End Get
            Set(ByVal value As Rectangle)
                Dim X As Integer = Square.Width
                Dim Y As Integer = Square.Height
                Dim Height As Integer = value.Height
                Dim Width As Integer = value.Width
                baseRect = New Rectangle(X, Y, Width, Height)
                SetRectangles()
            End Set
        End Property

        Private Sub RectTracker_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
            If e.Button = MouseButtons.Left Then
                If isFirst = True Then
                    prevLeftClick = New Point(e.X, e.Y)
                    isFirst = False
                Else
                    Me.Visible = False
                    Call Mouse_Move(Me, e)
                    prevLeftClick = New Point(e.X, e.Y) '调整位置或大小 
                End If
            Else
                isFirst = True
                Me.Visible = True

                Call Hit_Test(e.X, e.Y) '更新鼠标指针样式 
            End If
        End Sub

        Private Sub RectTracker_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
            Call Create()
            Me.Visible = True
        End Sub

        Private Sub RectTracker_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
            Call Draw() '画边框 
        End Sub

        Public Sub Mouse_Move(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
            '控件最小为 8x8 
            If currentControl.Height < 8 Then
                currentControl.Height = 8
                Exit Sub
            ElseIf currentControl.Width < 8 Then
                currentControl.Width = 8
                Exit Sub
            End If

            Select Case Me.CurrHitPlace
                Case HitDownSquare.HDS_TOP
                    currentControl.Height = currentControl.Height - e.Y + prevLeftClick.Y
                    If currentControl.Height > 8 Then currentControl.Top = currentControl.Top + e.Y - prevLeftClick.Y
                Case HitDownSquare.HDS_TOPLEFT
                    currentControl.Height = currentControl.Height - e.Y + prevLeftClick.Y
                    If currentControl.Height > 8 Then currentControl.Top = currentControl.Top + e.Y - prevLeftClick.Y
                    currentControl.Width = currentControl.Width - e.X + prevLeftClick.X
                    If currentControl.Width > 8 Then currentControl.Left = currentControl.Left + e.X - prevLeftClick.X
                Case HitDownSquare.HDS_TOPRIGHT
                    currentControl.Height = currentControl.Height - e.Y + prevLeftClick.Y
                    If currentControl.Height > 8 Then currentControl.Top = currentControl.Top + e.Y - prevLeftClick.Y
                    currentControl.Width = currentControl.Width + e.X - prevLeftClick.X
                Case HitDownSquare.HDS_RIGHT
                    currentControl.Width = currentControl.Width + e.X - prevLeftClick.X
                Case HitDownSquare.HDS_BOTTOM
                    currentControl.Height = currentControl.Height + e.Y - prevLeftClick.Y
                Case HitDownSquare.HDS_BOTTOMLEFT
                    currentControl.Height = currentControl.Height + e.Y - prevLeftClick.Y
                    currentControl.Width = currentControl.Width - e.X + prevLeftClick.X
                    If currentControl.Width > 8 Then currentControl.Left = currentControl.Left + e.X - prevLeftClick.X
                Case HitDownSquare.HDS_BOTTOMRIGHT
                    currentControl.Height = currentControl.Height + e.Y - prevLeftClick.Y
                    currentControl.Width = currentControl.Width + e.X - prevLeftClick.X
                Case HitDownSquare.HDS_LEFT
                    currentControl.Width = currentControl.Width - e.X + prevLeftClick.X
                    If currentControl.Width > 8 Then currentControl.Left = currentControl.Left + e.X - prevLeftClick.X
                Case HitDownSquare.HDS_NONE
                    currentControl.Location = New Point(currentControl.Location.X + e.X - prevLeftClick.X, currentControl.Location.Y + e.Y - prevLeftClick.Y)
            End Select
        End Sub

        Private Sub SetRectangles()
            '定义8个小正方形的范围 
            SmallRect(0) = New Rectangle(New Point(baseRect.X - Square.Width, baseRect.Y - Square.Height), Square) '左上 
            SmallRect(4) = New Rectangle(New Point(baseRect.X + (baseRect.Width / 2) - (Square.Width / 2), baseRect.Y - Square.Height), Square) '上中间 
            SmallRect(1) = New Rectangle(New Point(baseRect.X + baseRect.Width, baseRect.Y - Square.Height), Square) '右上 
            SmallRect(2) = New Rectangle(New Point(baseRect.X - Square.Width, baseRect.Y + baseRect.Height), Square) '左下 
            SmallRect(5) = New Rectangle(New Point(baseRect.X + (baseRect.Width / 2) - (Square.Width / 2), baseRect.Y + baseRect.Height), Square) '下中间 
            SmallRect(3) = New Rectangle(New Point(baseRect.X + baseRect.Width, baseRect.Y + baseRect.Height), Square) '右下 
            SmallRect(6) = New Rectangle(New Point(baseRect.X - Square.Width, baseRect.Y + (baseRect.Height / 2) - (Square.Height / 2)), Square) '左中间 
            SmallRect(7) = New Rectangle(New Point(baseRect.X + baseRect.Width, baseRect.Y + (baseRect.Height / 2) - (Square.Height / 2)), Square) '右中间 
            ControlRect = New Rectangle(New Point(0, 0), Me.Bounds.Size) '整个包括周围边框的范围 
        End Sub

        Private Sub Create() '创建边界 
            Dim X As Integer = currentControl.Bounds.X - Square.Width
            Dim Y As Integer = currentControl.Bounds.Y - Square.Height
            Dim Height As Integer = currentControl.Bounds.Height + (Square.Height * 2)
            Dim Width As Integer = currentControl.Bounds.Width + (Square.Width * 2)

            Me.Bounds = New Rectangle(X, Y, Width + 1, Height + 1)
            Me.BringToFront()
            Rect = currentControl.Bounds
            Me.Region = New Region(BuildFrame()) '设置可视区域 
        End Sub

        Private Function BuildFrame() As GraphicsPath
            Dim path As New GraphicsPath()

            BoundRect(0) = New Rectangle(0, 0, currentControl.Width + (Square.Width * 2) + 1, Square.Height + 1)
            BoundRect(1) = New Rectangle(0, Square.Height + 1, Square.Width + 1, currentControl.Bounds.Height + Square.Height + 1)
            BoundRect(2) = New Rectangle(Square.Width + 1, currentControl.Bounds.Height + Square.Height - 1, currentControl.Width + Square.Width + 2, Square.Height + 2)
            BoundRect(3) = New Rectangle(currentControl.Width + Square.Width - 1, Square.Height + 1, Square.Width + 2, currentControl.Height - 1)

            path.AddRectangle(BoundRect(0))
            path.AddRectangle(BoundRect(1))
            path.AddRectangle(BoundRect(2))
            path.AddRectangle(BoundRect(3))

            Return path
        End Function

        Public Sub Draw()
            Try
                Using g As Graphics = Me.CreateGraphics
                    'g.FillRectangles(Brushes.LightGray, BoundRect) '填充用于调整的边框的内部 
                    g.FillRectangles(Brushes.White, SmallRect) '填充8个锚点的内部 
                    g.DrawRectangles(Pens.Black, SmallRect) '绘制8个锚点的黑色边线 
                End Using
            Catch ex As Exception
                Console.WriteLine(ex.Message)
            End Try
        End Sub

        Public Function Hit_Test(ByVal x As Integer, ByVal y As Integer) As Boolean
            Dim point As New Point(x, y)
            If Not ControlRect.Contains(point) Then
                Cursor.Current = Cursors.Arrow
                Return False
            ElseIf SmallRect(0).Contains(point) Then
                Cursor.Current = Cursors.SizeNWSE
                CurrHitPlace = HitDownSquare.HDS_TOPLEFT
            ElseIf SmallRect(3).Contains(point) Then
                Cursor.Current = Cursors.SizeNWSE
                CurrHitPlace = HitDownSquare.HDS_BOTTOMRIGHT
            ElseIf SmallRect(1).Contains(point) Then
                Cursor.Current = Cursors.SizeNESW
                CurrHitPlace = HitDownSquare.HDS_TOPRIGHT
            ElseIf SmallRect(2).Contains(point) Then
                Cursor.Current = Cursors.SizeNESW
                CurrHitPlace = HitDownSquare.HDS_BOTTOMLEFT
            ElseIf SmallRect(4).Contains(point) Then
                Cursor.Current = Cursors.SizeNS
                CurrHitPlace = HitDownSquare.HDS_TOP
            ElseIf SmallRect(5).Contains(point) Then
                Cursor.Current = Cursors.SizeNS
                CurrHitPlace = HitDownSquare.HDS_BOTTOM
            ElseIf SmallRect(6).Contains(point) Then
                Cursor.Current = Cursors.SizeWE
                CurrHitPlace = HitDownSquare.HDS_LEFT
            ElseIf SmallRect(7).Contains(point) Then
                Cursor.Current = Cursors.SizeWE
                CurrHitPlace = HitDownSquare.HDS_RIGHT
            ElseIf ControlRect.Contains(point) Then
                Cursor.Current = Cursors.SizeAll
                CurrHitPlace = HitDownSquare.HDS_NONE
            End If
            Return True
        End Function
    End Class

End Namespace

测试代码如下：

Imports System.Windows.Forms

Public Class frmTest

    Private CRectCtl As RectControl.CRectControl

    Private Sub Button_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
        Dim btn As Button = CType(sender, Button)
        btn.BringToFront()
        btn.Capture = False
        If Me.Controls.Contains(CRectCtl) Then Me.Controls.Remove(CRectCtl)
        CRectCtl = New RectControl.CRectControl(btn)
        Me.Controls.Add(CRectCtl)
        CRectCtl.BringToFront()
        CRectCtl.Draw()
    End Sub

    Private Sub frmTest_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim btn As New Button With {.Text = "test"}
        AddHandler btn.MouseDown, AddressOf Button_MouseDown
        Me.Controls.Add(btn)
    End Sub
End Class