请教：怎样动态改变控件大小，实现动态缩放？

Question

问题: 如何在运行时通过鼠标拖拽改变控件大小?
解答:
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
        Dim Pnt As POINTAPI
        Dim CurX As Long
        Dim CurY As Long
        Dim DistX As Long
        Dim DistY As Long
        Const mDist = 150 '150 twips
        GetCursorPos Pnt
        ScreenToClient Me.hwnd, Pnt
        CurX = Pnt.x * Screen.TwipsPerPixelX
        CurY = Pnt.y * Screen.TwipsPerPixelY
        DistX = VBA.Abs(CurX - (Text1.Left + Text1.Width))
        DistY = VBA.Abs(CurY - (Text1.Top + Text1.Height))
        If DistX <= mDist And DistY <= mDist Then
           Form1.MousePointer = vbSizeNWSE
        ElseIf DistX <= mDist And DistY > mDist Then
           If CurY > Text1.Top And CurY < Text1.Top + Text1.Height Then
              Form1.MousePointer = vbSizeWE
           Else
              Form1.MousePointer = vbDefault
           End If
        ElseIf DistX > mDist And DistY <= mDist Then
           If CurX > Text1.Left And CurX < Text1.Left + Text1.Width Then
              Form1.MousePointer = vbSizeNS
           Else
              Form1.MousePointer = vbDefault
           End If
        Else
           Form1.MousePointer = vbDefault
        End If
        If Button = vbLeftButton Then
           If Form1.MousePointer = vbSizeNWSE Then
              Text1.Width = CurX - Text1.Left
              Text1.Height = CurY - Text1.Top
           End If
           If Form1.MousePointer = vbSizeWE Then
              Text1.Width = CurX - Text1.Left
           End If
           If Form1.MousePointer = vbSizeNS Then
              Text1.Height = CurY - Text1.Top
           End If
        End If
End Sub
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
        Form1.MousePointer = vbDefault
End Sub

Answer 1

To playyuer:
谢谢你的回答！不过那样只是能实现右边框和下边框的缩放而改变大小，现在我还需要实现左边框也能象右边框那样能缩放，怎样实现？

Answer 2

see thisOption Explicit
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongDim r() As RECT
Dim mywnd As RECTPrivate Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPrivate Sub Command1_Click()
    ShellExecute Me.hwnd, vbNullString, "www.csdn.net", vbNullString, vbNullString, 0
End SubPrivate Sub Form_Load()
    Dim i As Integer
    Dim j As Integer
    i = Me.Controls.Count - 1
    ReDim r(0 To i)
    GetWindowRect Me.hwnd, mywnd
    For j = 0 To i
        GetWindowRect Me.Controls(j).hwnd, r(j)
    Next j
End SubPrivate Sub Form_Resize()
    If Me.WindowState = 1 Then
        Exit Sub
    End If
    Dim i As Integer
    Dim j As Integer
    Dim w As Integer
    Dim h As Integer
            
    w = mywnd.Right - mywnd.Left
    h = mywnd.Bottom - mywnd.Top
    
    i = Me.Controls.Count - 1
    For j = 0 To i
        SetWindowPos Me.Controls(j).hwnd, 0, (r(j).Left - mywnd.Left) * Me.ScaleWidth / w / 15, (r(j).Top - mywnd.Top) * Me.ScaleHeight / h / 15, (r(j).Right - r(j).Left) * Me.ScaleWidth / w / 15, (r(j).Bottom - r(j).Top) * Me.ScaleHeight / h / 15, 0
    Next j
End Sub

Answer 3

改窗体风格就行了
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Const GWL_STYLE = (-16)Private Const WS_THICKFRAME = &H40000    Dim TempLng As Long
    
    TempLng = GetWindowLong(Text1.hwnd, GWL_STYLE)
    TempLng = TempLng Or WS_THICKFRAME '使用可改变大小的边框
    SetWindowLong Text1.hwnd, GWL_STYLE, TempLng