运行时改变控件大小和位置

Option Explicit

Dim oldX As Single '保存点击时X的坐标
Dim oldY As Single '保存点击时Y的坐标
Dim PublicControl As Control

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    oldX = X
    oldY = Y
End Sub

Private Sub Command1_GotFocus()
    Set PublicControl = Command1
    Control_Gotfocus Command1
End Sub

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Control_Move PublicControl, X, Y, Button
End Sub

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Control_MoveUp PublicControl, X, Y, Button
    Command1_GotFocus
End Sub

Private Sub Pic1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    oldX = X
    oldY = Y
End Sub

'左上角
Private Sub Pic1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Pic1.MousePointer = 8
    Pic1_Move PublicControl, X, Y, Button
End Sub

Private Sub Pic2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    oldX = X
    oldY = Y
End Sub

'上下调整
Private Sub Pic2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Pic2.MousePointer = 7
    Pic2_Move PublicControl, Y, Button
End Sub

Private Sub Pic3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    oldX = X
    oldY = Y
End Sub

'左右调整
Private Sub Pic3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Pic3.MousePointer = 6
    Pic3_Move PublicControl, X, Y, Button
End Sub

Private Sub Pic4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    oldX = X
    oldY = Y
End Sub

'左右调整
Private Sub Pic4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Pic4.MousePointer = 9
    Pic4_Move PublicControl, X, Button
End Sub

Private Sub Pic5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    oldX = X
    oldY = Y
End Sub

'左右移动
Private Sub Pic5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Pic5.MousePointer = 9
    Pic5_Move PublicControl, X, Button
End Sub

Private Sub Pic6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    oldX = X
    oldY = Y
End Sub

'左下角
Private Sub Pic6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Pic6.MousePointer = 6
    Pic6_Move PublicControl, X, Y, Button
End Sub

Private Sub Pic7_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    oldX = X
    oldY = Y
End Sub

'上下调整
Private Sub Pic7_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Pic7.MousePointer = 7
    Pic7_Move PublicControl, Y, Button
End Sub

Private Sub Pic8_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    oldX = X
    oldY = Y
End Sub

'右下角
Private Sub Pic8_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Pic8.MousePointer = 8
    Pic8_Move PublicControl, X, Y, Button
End Sub

Private Sub Text1_GotFocus()
     Set PublicControl = Text1
     Control_Gotfocus Text1
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    oldX = X
    oldY = Y
End Sub

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Control_Move PublicControl, X, Y, Button
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Control_MoveUp PublicControl, X, Y, Button
    Text1_GotFocus
End Sub

'控件获得焦点
Private Sub Control_Gotfocus(ByVal Controlname As Control)
    Pic1.Move Controlname.Left - Pic1.Width / 2, Controlname.Top - Pic1.Height / 2
    Pic2.Move Controlname.Left + Controlname.Width / 2 - Pic2.Width / 2, Controlname.Top - Pic2.Height / 2
    Pic3.Move Controlname.Left + Controlname.Width - Pic3.Width / 2, Controlname.Top - Pic3.Height / 2
    Pic4.Move Controlname.Left - Pic4.Width / 2, Controlname.Top + Controlname.Height / 2 - Pic4.Height / 2
    Pic5.Move Controlname.Left + Controlname.Width - Pic5.Width / 2, Controlname.Top + Controlname.Height / 2 - Pic5.Height / 2
    Pic6.Move Controlname.Left - Pic6.Width / 2, Controlname.Top + Controlname.Height - Pic6.Height / 2
    Pic7.Move Controlname.Left + Controlname.Width / 2 - Pic7.Width / 2, Controlname.Top + Controlname.Height - Pic7.Height / 2
    Pic8.Move Controlname.Left + Controlname.Width - Pic8.Width / 2, Controlname.Top + Controlname.Height - Pic8.Height / 2
End Sub

Private Sub Pic1_Move(ByVal Controlname As Control, ByVal X As Single, ByVal Y As Single, Button As Integer)
    If Controlname.Height - Y + oldY <= 280 Or Controlname.Width + oldX - X <= 280 Then Exit Sub
    If Button = 1 Then
        Controlname.Move Controlname.Left + X - oldX, Controlname.Top + Y - oldY, Controlname.Width - (X - oldX), Controlname.Height - (Y - oldY)
        Pic1.Move Pic1.Left + X - oldX, Pic1.Top + Y - oldY
        Pic2.Move Pic1.Left + Controlname.Width / 2, Pic1.Top
        Pic3.Move Pic3.Left, Pic1.Top
        Pic4.Move Pic1.Left, Pic1.Top + Controlname.Height / 2
        Pic5.Move Pic5.Left, Pic4.Top
        Pic6.Move Pic1.Left, Pic6.Top
        Pic7.Move Pic2.Left, Pic7.Top
    End If
End Sub

Public Sub Pic2_Move(ByVal Controlname As Control, ByVal Y As Single, Button As Integer)
    If Controlname.Height - Y + oldY <= 280 Then Exit Sub
    If Button = 1 Then
        Controlname.Move Controlname.Left, Controlname.Top + Y - oldY, Controlname.Width, Controlname.Height - (Y - oldY)
        Pic2.Move Pic2.Left, Pic2.Top + Y - oldY
        Pic1.Move Pic1.Left, Pic2.Top
        Pic3.Move Pic3.Left, Pic2.Top
        Pic4.Move Pic4.Left, Controlname.Top + Controlname.Height / 2 - Pic4.Height / 2
        Pic5.Move Pic5.Left, Controlname.Top + Controlname.Height / 2 - Pic5.Height / 2
    End If
End Sub

Private Sub Pic3_Move(ByVal Controlname As Control, ByVal X As Single, ByVal Y As Single, Button As Integer)
    If Controlname.Height - Y + oldY <= 280 Or Controlname.Width - oldX + X <= 280 Then Exit Sub
    If Button = 1 Then
        Controlname.Move Controlname.Left, Controlname.Top + Y - oldY, Controlname.Width + (X - oldX), Controlname.Height - (Y - oldY)
        Pic3.Move Pic3.Left + X - oldX, Pic3.Top + Y - oldY
        Pic1.Move Pic1.Left, Pic3.Top
        Pic2.Move Pic1.Left + Controlname.Width / 2, Pic3.Top
        Pic4.Move Pic4.Left, Pic1.Top + Controlname.Height / 2
        Pic5.Move Pic3.Left, Pic4.Top
        Pic7.Move Pic2.Left
        Pic8.Move Pic3.Left
    End If
End Sub

 

 

Public Sub Pic4_Move(ByVal Controlname As Control, ByVal X As Single, Button As Integer)
    If Controlname.Width + oldX - X <= 280 Then Exit Sub
    If Button = 1 Then
        Controlname.Move Controlname.Left + X - oldX, Controlname.Top, Controlname.Width - (X - oldX)
        Pic4.Move Pic4.Left + X - oldX
        Pic1.Move Pic4.Left
        Pic6.Move Pic4.Left
        Pic2.Move Pic1.Left + Controlname.Width / 2
        Pic7.Move Pic2.Left
    End If
End Sub

Public Sub Pic5_Move(ByVal Controlname As Control, ByVal X As Single, Button As Integer)
    If Controlname.Width + X - oldX <= 280 Then Exit Sub
    If Button = 1 Then
        Controlname.Move Controlname.Left, Controlname.Top, Controlname.Width + (X - oldX)
        Pic5.Move Pic5.Left + (X - oldX)
        Pic3.Move Pic5.Left
        Pic8.Move Pic5.Left
        Pic2.Move Pic1.Left + Controlname.Width / 2
        Pic7.Move Pic2.Left
    End If
End Sub

Private Sub Pic6_Move(ByVal Controlname As Control, ByVal X As Single, ByVal Y As Single, Button As Integer)
    If Controlname.Height + Y - oldY <= 280 Or Controlname.Width + oldX - X <= 280 Then Exit Sub
    If Button = 1 Then
        Controlname.Move Controlname.Left + X - oldX, Controlname.Top, Controlname.Width - (X - oldX), Controlname.Height + Y - oldY
        Pic6.Move Pic6.Left + X - oldX, Pic6.Top + Y - oldY
        Pic1.Move Pic6.Left
        Pic2.Move Pic1.Left + Controlname.Width / 2
        Pic4.Move Pic1.Left, Pic1.Top + Controlname.Height / 2
        Pic5.Move Pic5.Left, Pic4.Top
        Pic7.Move Pic2.Left, Pic6.Top
        Pic8.Move Pic8.Left, Pic6.Top
    End If
End Sub

Public Sub Pic7_Move(ByVal Controlname As Control, ByVal Y As Single, Button As Integer)
    If Controlname.Height + Y - oldY <= 280 Then Exit Sub
    If Button = 1 Then
        Controlname.Move Controlname.Left, Controlname.Top, Controlname.Width, Controlname.Height + Y - oldY
        Pic7.Move Pic7.Left, Pic7.Top + Y - oldY
        Pic6.Move Pic6.Left, Pic7.Top
        Pic8.Move Pic8.Left, Pic7.Top
        Pic4.Move Pic4.Left, Controlname.Top + Controlname.Height / 2 - Pic4.Height / 2
        Pic5.Move Pic5.Left, Pic4.Top
    End If
End Sub

Private Sub Pic8_Move(ByVal Controlname As Control, ByVal X As Single, ByVal Y As Single, Button As Integer)
    If Controlname.Height + Y - oldY <= 280 Or Controlname.Width - oldX + X <= 280 Then Exit Sub
    If Button = 1 Then
        Controlname.Move Controlname.Left, Controlname.Top, Controlname.Width + X - oldX, Controlname.Height + Y - oldY
        Pic8.Move Pic8.Left + X - oldX, Pic8.Top + Y - oldY
        Pic3.Move Pic8.Left, Pic3.Top
        Pic4.Move Pic4.Left, Pic3.Top + Controlname.Height / 2
        Pic5.Move Pic8.Left, Pic4.Top
        Pic2.Move Pic1.Left + Controlname.Width / 2
        Pic7.Move Pic2.Left, Pic7.Top + Y - oldY
        Pic6.Move Pic6.Left, Pic8.Top
    End If
End Sub

'控件可以移动
Private Sub Control_Move(ByVal Controlname As Control, ByVal X As Single, ByVal Y As Single, Button As Integer)
    If Button = 1 Then
        Controlname.MousePointer = vbSizeAll
        Controlname.Move Controlname.Left + X - oldX, Controlname.Top + Y - oldY
        Pic1.Visible = False
        Pic2.Visible = False
        Pic3.Visible = False
        Pic4.Visible = False
        Pic5.Visible = False
        Pic6.Visible = False
        Pic7.Visible = False
        Pic8.Visible = False
    End If
End Sub

Private Sub Control_MoveUp(ByVal Controlname As Control, ByVal X As Single, ByVal Y As Single, Button As Integer)
    Controlname.MousePointer = 0
    Pic1.Visible = True
    Pic2.Visible = True
    Pic3.Visible = True
    Pic4.Visible = True
    Pic5.Visible = True
    Pic6.Visible = True
    Pic7.Visible = True
    Pic8.Visible = True
End Sub