Resizing form and textboxes ...

Just for an idea, it is wiser to make a form scrollable rather than making controls tiny when you resize a form a bit small after a certain level of scale. It may also be a challenge, I use scrollable forms in my projects.

i know this is an older thread but why won't this code work for images?

o, i see, i need the stretch property of the image set to true

Dont know if anybody still replies to this post. First of all, I want the form to expand maximum when the form first loads. That possible? How?

Second, are there any explanation to what the code means? I dont understand how it works at all. Here is the code, although I integrated some other code into it about the combo box problem:

Code:

---

Option Explicit


Private Type CtrlProportions
    HeightProportions As Single
    WidthProportions As Single
    TopProportions As Single
    LeftProportions As Single
End Type

Dim ProportionsArray() As CtrlProportions

Sub InitResizeArray()

    Dim I As Integer
   
    On Error Resume Next
   
    ReDim ProportionsArray(0 To Controls.Count - 1)
   
    For I = 0 To Controls.Count - 1
        With ProportionsArray(I)
            .HeightProportions = Controls(I).Height / ScaleHeight
            .WidthProportions = Controls(I).Width / ScaleWidth
            .TopProportions = Controls(I).Top / ScaleHeight
            .LeftProportions = Controls(I).Left / ScaleWidth
        End With
    Next I
   
End Sub
Public Sub ResizeControls()
Dim I As Integer
On Error Resume Next
For I = 0 To Controls.Count - 1
' move and resize controls
Controls(I).Left = ProportionsArray(I).LeftProportions * Me.ScaleWidth
Controls(I).Top = ProportionsArray(I).TopProportions * Me.ScaleHeight
Controls(I).Width = ProportionsArray(I).WidthProportions * Me.ScaleWidth
Controls(I).Height = ProportionsArray(I).HeightProportions * Me.ScaleHeight
Next I

End Sub
'Form initialize event
Private Sub Form_Initialize()

    InitResizeArray
   
End Sub

'Form resize event
Sub Form_Resize()

    ResizeControls
    End Sub

---

Does this ocx work with MDI forms and child forms?

If so a quick explanation would be great how to impliment this. :D

Ok, I have been using MartinLiss's Form Resize code for a long time and lately have encountered a few issues that I have corrected. Most users may never see the issue I have encountered. These issues were due to subclassing controls on the form being resized. Here are the new code changes:

VB Code:

Option Explicit
 
Private Type CtrlProportions
    HeightProportions As Single
    WidthProportions As Single
    TopProportions As Single
    LeftProportions As Single
End Type
 
Dim ProportionsArray() As CtrlProportions
 
' 20080302RJ
 
Dim ArrayInitialized As Boolean
Dim FormScaleMode As Integer
 
 
Private Sub mInitResizeArray(frm As Object)
' Called from Form_Initialize
 
Dim I As Integer
    
    On Error Resume Next
    
    ' 20080302RJ
    ' The form's Load and Resize events will be invoked after execution of this statement
    
    ReDim ProportionsArray(0 To frm.Controls.Count - 1)
    
    ' We will return here after the form's Load and Resize events have been executed.
    ' Since the Form's Resize event will call mResizeControls we had to take precautions in that
    ' sub not to do anything till we have finished this routine. So if ArrayInitialized = false
    ' the mResizeControls will just exit without attempting to do anything and we will return here.
    
    ' Save the form's scale mode because if the app does subclassing the scale mode will change to pixels
    ' then when we attempt to move it we will mess up the form if we don't change it back to the
    ' original value that the proportion calculation were made with.
    
    FormScaleMode = frm.ScaleMode
    
    For I = 0 To frm.Controls.Count - 1
    
        With ProportionsArray(I)
            .HeightProportions = frm.Controls(I).Height / frm.ScaleHeight
            .WidthProportions = frm.Controls(I).Width / frm.ScaleWidth
            .TopProportions = frm.Controls(I).Top / frm.ScaleHeight
            .LeftProportions = frm.Controls(I).Left / frm.ScaleWidth
        End With
        
    Next I
    
    ArrayInitialized = True
    
End Sub
 
Private Sub mResizeControls(frm As Object)
Dim I As Long
Dim ctl As Control
' Called from Form_Resize
 
    ' 20080302RJ
    ' Added to insure that we don't attempt to process the form before it is loaded.
    ' When mInitResizeArray is called in the form's Initialize event the first time it accesses
    ' any object/method of the form then Form's Load and Resize Event are invoked before we finish the
    ' mInitResizeArray sub and we will get here before we have initialized the ProportionsArray array.
    ' This causes weird effects on the calling form in certain instances because the array will be full
    ' of zeros and all controls will be relocated to the top of the container they are in if we allow this
    ' routine to operate.
    
    If Not ArrayInitialized Then Exit Sub ' Return to mInitResizeArray sub
    
    On Error Resume Next
        
    ' Return the original scale mode of the form because this is the mode that was used
    ' to calculate the proportions.
    
    frm.ScaleMode = FormScaleMode
    
    For I = LBound(ProportionsArray) To UBound(ProportionsArray) ' 20080302RJ
'    For I = 0 To frm.Controls.Count - 1
    
        Set ctl = frm.Controls(I)
        
        ' 20060403RJ
        ' if we don't want a control to be resized it's tag field will contain "NoResize"
        
        If LCase(ctl.Tag) <> LCase("NoResize") Then
 
            With ProportionsArray(I)
                ' move and resize controls
                ctl.Move CLng(.LeftProportions * frm.ScaleWidth), _
                CLng(.TopProportions * frm.ScaleHeight), _
                CLng(.WidthProportions * frm.ScaleWidth), _
                CLng(.HeightProportions * frm.ScaleHeight)
            End With
 
        End If
 
     Next I
      
     Set ctl = Nothing
     
End Sub
 
Public Sub InitResizeArray(frm As Object)
    mInitResizeArray frm
End Sub
 
Public Sub ResizeControls(frm As Object)
    mResizeControls frm
End Sub

This is a control.

Here is the code.

vb Code:

Private Declare Function LockWindowUpdate Lib "user32" _
    (ByVal hwnd As Long) As Long
 
Dim lpara As Long
Private Const CB_SETITEMHEIGHT = &H153
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
 
 
Public Reset As Boolean
 
' if True, also fonts are resized
'Public ResizeFont As Boolean
' if True, form's height/width ratio is preserved
Public KeepRatio As Boolean
 
Private Type TControlInfo
    ctrl As Control
    Left As Single
    Top As Single
    Width As Single
    Height As Single
    FontSize As Single
End Type
 
' this array holds the original position
' and size of all controls on parent form
Dim Controls() As TControlInfo
 
' a reference to the parent form
Private WithEvents ParentForm As Form
' parent form's size at load time
Private ParentWidth As Single
Private ParentHeight As Single
' ratio of original height/width
Private HeightWidthRatio As Single
'Default Property Values:
Const m_def_ResizeFont = 0
'Property Variables:
Dim m_ResizeFont As Boolean
 
Sub LockWindow(hwnd As Long)
    LockWindowUpdate hwnd
End Sub
 
Sub UnlockWindow()
    LockWindowUpdate 0
End Sub
 
Private Sub ParentForm_Activate()
On Error Resume Next
ParentForm.Left = GetSetting(App.EXEName, ParentForm.Name, "Left", ParentForm.Left)
ParentForm.Top = GetSetting(App.EXEName, ParentForm.Name, "Top", ParentForm.Top)
ParentForm.Height = GetSetting(App.EXEName, ParentForm.Name, "Height", ParentForm.Height)
ParentForm.Width = GetSetting(App.EXEName, ParentForm.Name, "Width", ParentForm.Width)
End Sub
 
Private Sub ParentForm_Load()
    ' the ParentWidth variable works as a flag
    ParentWidth = 0
    ' save original ratio
    HeightWidthRatio = ParentForm.Height / ParentForm.Width
 
End Sub
Private Sub ParentForm_Unload(Cancel As Integer)
 
If Not ParentForm.WindowState = vbMinimized Then
 
    If ParentForm.Left > -1000 Then SaveSetting App.EXEName, ParentForm.Name, "Left", ParentForm.Left
 
    If ParentForm.Top > -1000 Then SaveSetting App.EXEName, ParentForm.Name, "Top", ParentForm.Top
 
    If ParentForm.Height > 1000 Then SaveSetting App.EXEName, ParentForm.Name, "Height", ParentForm.Height
 
    If ParentForm.Width > 1000 Then SaveSetting App.EXEName, ParentForm.Name, "Width", ParentForm.Width
End If
 
On Error Resume Next
 
If Reset = True Then DeleteSetting (App.EXEName)
End Sub
 
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
     m_ResizeFont = PropBag.ReadProperty("ResizeFont", m_def_ResizeFont)
   If Ambient.UserMode = False Then Exit Sub
    ' store a reference to the parent form and
    ' start receiving events
    Set ParentForm = Parent
End Sub
 
Private Sub UserControl_Resize()
    ' refuse to resize
    Image1.Move 0, 0
    UserControl.Width = Image1.Width
    UserControl.Height = Image1.Height
End Sub
 
' trap the parent form's Resize event
' this include the very first resize event
' that occurs soon after form's load
 
Private Sub ParentForm_Resize()
If ParentForm.WindowState = 1 Then Exit Sub
    If ParentWidth = 0 Then
        Rebuild
    Else
        Refresh
    End If
End Sub
' save size and position of all controls on parent form
' you should manually invoke this method each time you add a new control
' to the form (through Load method of a control array)
Sub Rebuild()
' rebuild the internal table
Dim i As Integer, ctrl As Control
' this is necessary for controls that don't support
' all properties (e.g. Timer controls)
On Error Resume Next
 
If Ambient.UserMode = False Then Exit Sub
' save a reference to the parent form, and its initial size
Set ParentForm = UserControl.Parent
ParentWidth = ParentForm.ScaleWidth
ParentHeight = ParentForm.ScaleHeight
' read the position of all controls on the parent form
ReDim Controls(ParentForm.Controls.Count - 1) As TControlInfo
Dim Ctl As Control
On Error Resume Next
' Put the code here to resize the controls
 
For i = 0 To ParentForm.Controls.Count - 1
 
    With Controls(i)
 
        '        Set .ctrl = ctrl
 
        If ParentForm.Controls(i).Left < -1000 Then  'For controls on diferent tab
        Debug.Print ParentForm.Controls(i).Name
            .Left = ParentForm.Controls(i).Left + 75000
        Else
            .Left = ParentForm.Controls(i).Left
        End If
 
        .Top = ParentForm.Controls(i).Top
        .Width = ParentForm.Controls(i).Width
        .Height = ParentForm.Controls(i).Height
        .FontSize = ParentForm.Controls(i).Font.Size
 
    End With
 
Next
 
End Sub
' update size and position of controls on parent form
Sub Refresh()
Dim i As Integer, ctrl As Control
Dim widthFactor As Single, heightFactor As Single
Dim minFactor As Single
' inhibits recursive calls if KeepRatio = True
Static executing As Boolean
 
If executing Then Exit Sub
 
If Ambient.UserMode = False Then Exit Sub
 
If KeepRatio And ParentForm.WindowState = 0 Then
    executing = True
    ' we must keep original ratio
    ParentForm.Height = HeightWidthRatio * ParentForm.Width
    executing = False
End If
 
' this is necessary for controls that don't support
' all properties (e.g. Timer controls)
On Error Resume Next
widthFactor = ParentForm.ScaleWidth / ParentWidth
heightFactor = ParentForm.ScaleHeight / ParentHeight
' take the lesser of the two
 
If widthFactor < heightFactor Then
    minFactor = widthFactor
Else
    minFactor = heightFactor
End If
 
Dim Ctl As Control
LockWindow (ParentForm.hwnd)
' this is a regular resize
 
For i = 0 To ParentForm.Controls.Count - 1
 
    With Controls(i)
 
        ' the change of font must occur *before* the resizing
        ' to account for companion scrollbar of listbox
        ' and other similar controls
 
        If ResizeFont And (TypeOf ParentForm.Controls(i) Is TDBGrid) = False Then
            ParentForm.Controls(i).Font.Size = .FontSize * minFactor
        End If
 
        ' move and resize the controls - we can't use a Move
        ' method because some controls do not support the change
        ' of all the four properties (e.g. Height with comboboxes)
 
        If ParentForm.Controls(i).Left < -1000 Then
        Debug.Print ParentForm.Controls(i).Name
            ParentForm.Controls(i).Left = .Left * widthFactor
            ParentForm.Controls(i).Left = ParentForm.Controls(i).Left - 75000
        Else
            ParentForm.Controls(i).Left = .Left * widthFactor
        End If
 
        ParentForm.Controls(i).Top = .Top * heightFactor
        ParentForm.Controls(i).Width = .Width * widthFactor
 
        If TypeOf ParentForm.Controls(i) Is ComboBox Then
            lpara = ((.Height * heightFactor) \ Screen.TwipsPerPixelX) - 6
            Call SendMessage(ParentForm.Controls(i).hwnd, CB_SETITEMHEIGHT, -1&, ByVal lpara)
        Else
            ParentForm.Controls(i).Height = .Height * heightFactor
        End If
 
    End With
 
Next
 
UnlockWindow
End Sub
 
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
'    m_ResizeFont = m_def_ResizeFont
    m_ResizeFont = m_def_ResizeFont
End Sub
 
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("ResizeFont", m_ResizeFont, m_def_ResizeFont)
End Sub
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,1
Public Property Get ResizeFont() As Boolean
    ResizeFont = m_ResizeFont
End Property
 
Public Property Let ResizeFont(ByVal New_ResizeFont As Boolean)
    m_ResizeFont = New_ResizeFont
    PropertyChanged "ResizeFont"
End Property

Thanks Martin verry much.
But with Sreadsheet which rows and column fixed wich a litte is not zoom full in spread.
Only Spread zoom fullscreen. Rows and column not fixed in Spread zoom mode.

Can you help me. Thanks very much.

Soon hope you reply me answer.

Super Tool.
Great, help me a lot.

Very good tool.

Great tool MarkT fantastic job.

i just have one question for the OCX control. im using a Main form that has a picturebox on it into which i load the "sub" forms at runtime. if i add the OCX control to the main form, how would i get the current visible "sub" form to also re-size?

im using this method to load the "sub" form into the Main forms picturebox

Code:

---

        UnloadForms
        Load frmRulesMain
        SetParent frmRulesMain.hwnd, picDock.hwnd
        frmRulesMain.Move 0, 0, 500, 1500
        frmRulesMain.Visible = True

---

i have attempted to solve this issue by firstly creating a String called stActiveWindow in the Main Form, this string is populated by the "sub" forms Name property when it is loaded. then under the Main Forms resize event i had;

Code:

---

Private Sub Form_Resize()
    Dim frm As Form
    For Each frm In Forms
        If frm.Name = stActiveWindow Then
            frm.WindowState = 2
        End If
    Next
End Sub

---

in an attempt to try and make the "sub" form now maximise to the Main form. However this is not the case and the "sub" form stays at its normal size. Is anyone able to advise me of a solution to make the "sub" form resize at the same time as the Main form resize?

additionally this only problem occurs to the current visible "sub" form, if i resize the Main form then open another "sub" form, the new "sub" form WILL maximise correctly. What im trying to achieve is when the Main form is resized the visible/loaded "sub" form resizes at the same time.

Keep Smiling

I know this is an old post but I just want to say thanks. I added this to my program and it works a treat :)

I know it's a very old post, but since it's not marked as resolved, and last entry was 2012, and my question is usefull: here I go.
I continued this post here: http://www.vbforums.com/showthread.p...65#post4568065
saying (with attached images) that since MarkT OCX contrl works perfectly for adapting your form to a bigger screen, it has a problem adapting a form to a smaller screen, basically because VB6 itself resize the form to 'fit' the screen, and part of it is lost. (If you want, follow the link and comment there).

Sorry for reopen an old post and thank you!