Resize all controls when form resize

I would like to resize all controls when the form size change, so the ratio stays the same.
The first expert who give me the working code (not just  ideas) will receive the points. I can give you more points if this is not enough.
Thanks
maryjmillerAsked:
Who is Participating?
 
DalinCommented:
Try this. Let me know if you have problems.
Remember, some of the controls does not have the property like Left. you may need to modify slightly.
Regards
Dalin

Option Explicit
Private InitWidth As Long       ' Form initial Size
Private InitHeight As Long

Private Sub Form_Load()
InitWidth = ScaleWidth
InitHeight = ScaleHeight
Dim Ctl As Control
' °O¿ý¨C­Ó Control ªº­ì©l¦ì¸m¡B¤j¤p¡B¦r«¬¤j¤p, ©ñ¦b Tag Äݩʤ¤
On Error Resume Next '½T«Oleft, top, width, height, TagÄݩʨS¦³¥þ¦³ªºControl
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 TempPos As Long
Dim StartPos As Long
Dim Ctl As Control
Dim TempVisible As Boolean
Dim ScaleX As Double
Dim ScaleY As Double

ScaleX = ScaleWidth / InitWidth
ScaleY = ScaleHeight / InitHeight
On Error Resume Next
For Each Ctl In Me
    TempVisible = Ctl.Visible
    Ctl.Visible = False
    StartPos = 1
    ' Ū¨ú Control ªº­ì©l¦ì¸m¡B¤j¤p¡B¦r«¬¤j¤p
    For I = 0 To 4
        TempPos = InStr(StartPos, Ctl.Tag, " ", vbTextCompare)
        If TempPos > 0 Then
            D(I) = Mid(Ctl.Tag, StartPos, TempPos - StartPos)
            StartPos = TempPos + 1
        Else
            D(I) = 0
        End If
        ' ®Ú¾Ú¤ñ¨Ò³]©w Control ªº¦ì¸m¡B¤j¤p¡B¦r«¬¤j¤p
        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
0
 
mcixCommented:
Good answer!
0
 
DalinCommented:
Thanks, mcix.
0
Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

 
maryjmillerAuthor Commented:
indeed!
I can't read the comments. Could you can put them in english? I can increase the points.
Thanks
0
 
DalinCommented:
O boy... email me at Dalin_N@MailExcite.Com
0
 
maryjmillerAuthor Commented:
Thanx for all!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.