Redimensionar Controles de Usuario

[jericosoft]

Esto te redimensiona Todos Los Controles que tengas en tu form

incluido tu shape circulo , con los tres botones enmedio y a escala :

Espero te sirva


Private lngFormWidth As Long
Private lngFormHeight As Long

Private Sub Form_Load()

Dim Ctl As Control

lngFormWidth = ScaleWidth
lngFormHeight = ScaleHeight


On Error Resume Next

For Each Ctl In Me
Ctl.Tag = Ctl.Left & " " & Ctl.Top & " " & Ctl.Width & " " & Ctl.Height & " "
Ctl.Tag = Ctl.Tag & Ctl.FontSize & " "
Next Ctl

On Error GoTo 0

End Sub

Private Sub Form_Resize()

Dim D(4) As Double
Dim i As Long

Dim TempPoz As Long
Dim StartPoz As Long

Dim Ctl As Control
Dim TempVisible As Boolean

Dim ScaleX As Double
Dim ScaleY As Double


ScaleX = ScaleWidth / lngFormWidth
ScaleY = ScaleHeight / lngFormHeight

On Error Resume Next


For Each Ctl In Me
TempVisible = Ctl.Visible
Ctl.Visible = False
StartPoz = 1


For i = 0 To 4
TempPoz = InStr(StartPoz, Ctl.Tag, " ", vbTextCompare)

If TempPoz > 0 Then
D(i) = Mid(Ctl.Tag, StartPoz, TempPoz - StartPoz)
StartPoz = TempPoz + 1
Else
D(i) = 0
End If


Ctl.Move D(0) * ScaleX, D(1) * ScaleY, D(2) * ScaleX, D(3) * ScaleY
Ctl.Width = D(2) * ScaleX
Ctl.Height = D(3) * ScaleY


If ScaleX < ScaleY Then
Ctl.FontSize = D(4) * ScaleX
Else
Ctl.FontSize = D(4) * ScaleY
End If

Next i

Ctl.Visible = TempVisible

Next Ctl

On Error GoTo 0

End Sub