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