本示例构建了一个 ActiveX 控件，允许用户在运行时移动和调整控件的大小。它会自动调整它包含的控件的大小以适应。

请注意，我不一定推荐这种策略。用户最终会做一些愚蠢的事情，例如将控件的大小设为零或将其移出表单，因此请确保您有办法在必要时重置控件。

UserControl 在其右下角包含一个名为 Corner 的小图片框。该控件跟踪其 Mo​​useDown、MouseMove 和 MouseUp 事件。当您拖动该控件时，以下代码会调整 UserControl 的大小，将 Corner 放回右下角，并调整包含的控件的大小以适合。

Option Explicit

'Default Property Values:
Const m_def_Draggable = True
Const m_def_MinWidth = 240
Const m_def_MaxWidth = 100000
Const m_def_MinHeight = 240
Const m_def_MaxHeight = 100000
Const m_def_HandleSize = 45
'Property Variables:
Dim m_Draggable As Boolean
Dim m_MinWidth As Long
Dim m_MaxWidth As Long
Dim m_MinHeight As Long
Dim m_MaxHeight As Long
Dim m_HandleSize As Long

Dim Resizing As Boolean
Dim Moving As Boolean
Dim StartX As Single
Dim StartY As Single
' *********************************************
' Show the About dialog.
' *********************************************
Public Sub ShowAbout()
Dim frm As New AboutDialog

    frm.Show vbModal
    Set frm = Nothing
End Sub

' *********************************************
' Clear this control's size and position
' information from the registry. Use
' "DraggablePositions" as the section. Use the
' control's name to generate keys.
' *********************************************
Public Sub ClearPosition(AppName As String)
Dim key As String

    ' Get the control name.
    key = Extender.Name
    On Error Resume Next
    key = key & "(" & Format$(Extender.Index) & ")"
    On Error GoTo 0
    
    DeleteSetting AppName, "DraggablePositions", _
        key & ".Left"
    DeleteSetting AppName, "DraggablePositions", _
        key & ".Top"
    DeleteSetting AppName, "DraggablePositions", _
        key & ".Width"
    DeleteSetting AppName, "DraggablePositions", _
        key & ".Height"
End Sub

' *********************************************
' Save this control's size and position
' information in the registry. Use
' "DraggablePositions" as the section. Use the
' control's name to generate keys. The items
' are always saved in pixels.
' *********************************************
Public Sub SavePosition(AppName As String)
Dim key As String
Dim parent_mode As Integer

    ' Get the control name.
    key = Extender.Name
    On Error Resume Next
    key = key & "(" & Format$(Extender.Index) & ")"
    On Error GoTo 0
    
    parent_mode = Extender.Parent.ScaleMode
    SaveSetting AppName, "DraggablePositions", _
        key & ".Left", _
        ScaleX(Extender.Left, parent_mode, vbPixels)
    SaveSetting AppName, "DraggablePositions", _
        key & ".Top", _
        ScaleX(Extender.Top, parent_mode, vbPixels)
    SaveSetting AppName, "DraggablePositions", _
        key & ".Width", _
        ScaleX(Extender.Width, parent_mode, vbPixels)
    SaveSetting AppName, "DraggablePositions", _
        key & ".Height", _
        ScaleX(Extender.Height, parent_mode, vbPixels)
End Sub
' *********************************************
' Load this control's size and position
' information from the registry. Use
' "DraggablePositions" as the section. Use the
' control's name to generate keys. The items
' are always saved in pixels.
' *********************************************
Public Sub LoadPosition(AppName As String)
Dim parent_mode As Integer
Dim key As String
Dim txt As String
Dim l As Single
Dim t As Single
Dim w As Single
Dim h As Single

    ' Get the control name.
    key = Extender.Name
    On Error Resume Next
    key = key & "(" & Format$(Extender.Index) & ")"
    On Error GoTo 0
    
    parent_mode = Extender.Parent.ScaleMode
    txt = GetSetting(AppName, _
        "DraggablePositions", _
        key & ".Left", "")
    If txt = "" Then
        l = Extender.Left
    Else
        l = ScaleX(CInt(txt), vbPixels, parent_mode)
    End If
    
    txt = GetSetting(AppName, _
        "DraggablePositions", _
        key & ".Top", "")
    If txt = "" Then
        t = Extender.Top
    Else
        t = ScaleY(CInt(txt), vbPixels, parent_mode)
    End If
    
    txt = GetSetting(AppName, _
        "DraggablePositions", _
        key & ".Width", "")
    If txt = "" Then
        w = Extender.Width
    Else
        w = ScaleX(CInt(txt), vbPixels, parent_mode)
    End If
    
    txt = GetSetting(AppName, _
        "DraggablePositions", _
        key & ".Height", "")
    If txt = "" Then
        h = Extender.Height
    Else
        h = ScaleY(CInt(txt), vbPixels, parent_mode)
    End If
    
    Extender.Move l, t, w, h
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property
' *********************************************
' Start resizing the control.
' *********************************************
Private Sub Corner_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Not Draggable Then Exit Sub
    Resizing = True
    StartX = X
    StartY = Y
End Sub

' *********************************************
' Resize the control.
' *********************************************
Private Sub Corner_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dw As Single
Dim dh As Single
Dim wid As Single
Dim hgt As Single
Dim w As Single
Dim h As Single

    ' Do nothing unless we're resizing.
    If Not Resizing Then Exit Sub
    
    dw = X - StartX
    dh = Y - StartY
    If dw = 0 And dh = 0 Then Exit Sub
    
    wid = Width + dw
    ' Make sure we will fit on the form.
    w = ScaleX(wid, ScaleMode, Parent.ScaleMode)
    If w > Parent.ScaleWidth - Extender.Left Then
        w = Parent.ScaleWidth - Extender.Left
        wid = ScaleX(w, Parent.ScaleMode, ScaleMode)
    End If
    ' Stay between MinWidth and MaxWidth.
    If wid < m_MinWidth Then wid = m_MinWidth
    If wid > m_MaxWidth Then wid = m_MaxWidth
    
    hgt = Height + dh
    ' Make sure we will fit on the form.
    h = ScaleX(hgt, ScaleMode, Parent.ScaleMode)
    If h > Parent.ScaleHeight - Extender.Top Then
        h = Parent.ScaleHeight - Extender.Top
        hgt = ScaleY(h, Parent.ScaleMode, ScaleMode)
    End If
    ' Stay between MinHeight and MaxHeight.
    If hgt < m_MinHeight Then hgt = m_MinHeight
    If hgt > m_MaxHeight Then hgt = m_MaxHeight

    Size wid, hgt
End Sub
' *********************************************
' Stop resizing the control.
' *********************************************
Private Sub Corner_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Resizing = False
End Sub

' *********************************************
' Start moving the control.
' *********************************************
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Not Draggable Then Exit Sub
    Moving = True
    StartX = X
    StartY = Y
End Sub

' *********************************************
' Move the control.
' *********************************************
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dl As Single
Dim dt As Single
Dim l As Single
Dim t As Single
Dim wid As Single
Dim hgt As Single

    ' Do nothing unless we're moving.
    If Not Moving Then Exit Sub
    
    dl = X - StartX
    dt = Y - StartY
    If dl = 0 And dt = 0 Then Exit Sub
    
    l = Extender.Left + ScaleX(dl, ScaleMode, Parent.ScaleMode)
    t = Extender.Top + ScaleY(dt, ScaleMode, Parent.ScaleMode)
    If l < 0 Then l = 0
    If t < 0 Then t = 0
    wid = ScaleX(Width, ScaleMode, Parent.ScaleMode)
    hgt = ScaleY(Height, ScaleMode, Parent.ScaleMode)
    If l > Parent.ScaleWidth - wid Then l = Parent.ScaleWidth - wid
    If t > Parent.ScaleHeight - hgt Then t = Parent.ScaleHeight - hgt

    Extender.Move l, t
End Sub
' *********************************************
' Stop moving the control.
' *********************************************
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Moving = False
End Sub

UserControl 也在其自己的表面上跟踪 MouseDown、MouseMove 和 MouseUp 事件。当您在 UserControl 上单击并拖动时，代码会确定该控件的位置并调用 Extender.Move 以适当地移动 UserControl。

该控件还包括在注册表中保存和恢复大小和位置的例程，因此程序可以轻松地在程序运行之间保持其大小和位置。

有关其他详细信息，请参阅代码。