Resize Form to Fit Screen Resolution

[rtoro]

Hi

Does any of you know how can I resize a form to fit the screen resolution of the user?

Thanks

[HeSaidJoe]

'not perfect as fonts can still come in to play
'I think but it works for me so far

'resize as per secreen resolution
'general declaration of form

'==================================================================
'create a class module and put this code into it
'set the name property of the object as clsElasticForms
'save as clsElastic

Option Explicit

' Title:    Elastic Forms
' Author:   Leigh Bowers
' Email:    [email protected]
' WWW:      http://www.esheep.freeserve.co.uk/compulsion
' Version:  1.01
' Date:     19th June 1999
' Requires: N/A
' License:  Freely Distributable (non-commercial use)

Private fForm As Form

Private lOriginalWidth As Long
Private lOriginalHeight As Long

Private lMinWidth As Long
Private lMinHeight As Long

Private Type udtControl
    lLeft As Long
    lTop As Long
    lWidth As Long
    lHeight As Long
End Type
Private aControls() As udtControl

Public Property Let Form(ByVal fPassForm As Form)
    
Dim iCount As Integer
Dim cControl As Control

    Set fForm = fPassForm
    
    ' Store form's original Width & Height
    
    lOriginalWidth = fForm.Width
    lOriginalHeight = fForm.Height

    ' Use error trapping to ignore components that don't
    ' support certain properties being read at run-time

    On Error Resume Next

    ' Store the form's component's properties

    iCount = 0
    ReDim aControls(fForm.Controls.Count)

    For Each cControl In fForm.Controls
        iCount = iCount + 1
        With aControls(iCount)
            If TypeOf cControl Is Line Then
                .lLeft = cControl.X1
                .lTop = cControl.Y1
                .lWidth = cControl.X2
                .lHeight = cControl.Y2
            Else
                .lLeft = cControl.Left
                .lTop = cControl.Top
                .lWidth = cControl.Width
                .lHeight = cControl.Height
            End If
        End With
    Next ' Each

End Property

Public Sub FormResize()

    ' v1.01 (19/06/1999)
    '
    ' bDisableResize:
    ' Used to avoid unnecessary *recursive* resizing
    '
    ' lPreviousWidth/Height:
    ' Used to avoid unnecessary resizing

    ' Resize the form's controls

Dim iCount As Integer
Dim cControl As Control
Dim iTaskBarHeight As Integer
Dim sOriginalWidthUnit As Single
Dim sOriginalHeightUnit As Single
Static bDisableResize As Boolean
Static lPreviousWidth As Long
Static lPreviousHeight As Long

    If fForm Is Nothing Or bDisableResize Then Exit Sub

    ' Don't process minimized forms
    
    If fForm.WindowState = vbMinimized Then Exit Sub

    ' Check form size against minimums
    
    bDisableResize = True
    If fForm.Width < lMinWidth Then fForm.Width = lMinWidth
    If fForm.Height < lMinHeight Then fForm.Height = lMinHeight
    bDisableResize = False
    
    ' Ensure form size has changed
    
    If lPreviousWidth = fForm.Width And lPreviousHeight = fForm.Height Then Exit Sub
    lPreviousWidth = fForm.Width
    lPreviousHeight = fForm.Height

    ' Perform calculations in advance (speed increase)

    iTaskBarHeight = 28 * Screen.TwipsPerPixelY ' Standard height
    sOriginalWidthUnit = lOriginalWidth / fForm.Width
    sOriginalHeightUnit = (lOriginalHeight - iTaskBarHeight) / (fForm.Height - iTaskBarHeight)

    ' Use error trapping to ignore components that don't
    ' support certain properties being set at run-time

    On Error Resume Next

    ' Do the resize...
    
    iCount = 0

    For Each cControl In fForm.Controls
        iCount = iCount + 1
        With cControl
            If TypeOf cControl Is Line Then
                .X1 = Int(aControls(iCount).lLeft / sOriginalWidthUnit)
                .Y1 = Int(aControls(iCount).lTop / sOriginalHeightUnit)
                .X2 = Int(aControls(iCount).lWidth / sOriginalWidthUnit)
                .Y2 = Int(aControls(iCount).lHeight / sOriginalHeightUnit)
            Else
                .Left = Int(aControls(iCount).lLeft / sOriginalWidthUnit)
                .Top = Int(aControls(iCount).lTop / sOriginalHeightUnit)
                .Width = Int(aControls(iCount).lWidth / sOriginalWidthUnit)
                .Height = Int(aControls(iCount).lHeight / sOriginalHeightUnit)
            End If
        End With
    Next ' Each

End Sub


Private Sub Class_Terminate()

    Set fForm = Nothing

End Sub




Public Property Let MinWidth(ByVal lPassMinWidth As Long)

    lMinWidth = lPassMinWidth

End Property
Public Property Let MinHeight(ByVal lPassMinHeight As Long)

    lMinHeight = lPassMinHeight

End Property

'====================================================================
 
' in the general declarations of each form in your application

Option Explicit

Private clsElastic As clsElasticForms

'====================================================================

'this goes in the form load event of each form in app

    Set clsElastic = New clsElasticForms
    clsElastic.Form = Me
    clsElastic.MinHeight = 1950
    clsElastic.MinWidth = 6960

'====================================================================

'this goes in the form resize event of each form in app
'resize as per secreen resolution
   
clsElastic.FormResize

'====================================================================

'this goes in the Form_Unload(Cancel As Integer) of each form
'in the app
'resize as per secreen resolution
   
Set clsElastic = Nothing

'====================================================================

[donnah]

There appear to be 15 twips per pixel. Does this matter in running GetSystemMetrics(SM_CXSCREEN) & GetSystemMetrics(SM_CYSCREEN)As String

which returns information about screen resolution in pixels?

[agent]

What most people don't realize is that twips is based on the current system (i.e. there are 14 twips per pixel on my system.) to get the actual dimensions of the form in pixels, use:

W = ScaleX(Me.Width, vbTwips, vbPixels)
H = ScaleY(Me.Height, vbTwips, vbPixels)
T = ScaleY(Me.Top, vbTwips, vbPixels)
L = ScaleX(Me.Left, vbTwips, vbPixels)

[donnah]

The code you have given us for changing form sizes makes sense. But I first must get the screen resolution of the various machines using my forms. Do I put this code into the class module? Help!

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
' Declare constants
Private Const SM_CXSCREEN = 0 'width in pixels
Private Const SM_CYSCREEN = 1 'height in pixels
ScaleMode = 3 'pixels

Dim lOriginalWidth As Long
Dim lOriginalHeight As Long

lOriginalWidth = GetSystemMetrics(SM_CXSCREEN)
lOriginalHeight = GetSystemMetrics(SM_CYSCREEN)

[jgomes]

Can't you just use Screen.width????

***?

Maybe I'm wrong but I think u can :>

Just make sure u convert the twips

Don't Flame me if I'm wrong :>

-Justin

[HeSaidJoe]

you shouldn't have to adjust the code
I use it against any screen resolution and it
does its thing. Just build an app and use it and set
your screen resolution to different factors and run the
app...it should adjust no matter the resolution'

'You can use the following small piece of code to
'detect the current screen resolution and
'then act on the information -
'for instance; resizing form objects to suit the user's resolution.
'

Option Explicit
'
'form event code
'==============================
Dim x, y As Integer

x = Screen.Width / Screen.TwipsPerPixelX
y = Screen.Height / Screen.TwipsPerPixelY

'whatever you want to do goes here
'message user

Dim msg
msg = "Screen Width = " & x & " TwipsPerPixel" & vbCrLf
msg = msg & "Screen Height = " & y & " TwipsPerPixel"
MsgBox msg

[Edited by HeSaidJoe on 08-29-2000 at 12:03 PM]

[donnah]

With or without my added code, I cannot get my forms to resize according to varying screen resolutions. Have you set special project references or components? (I set Sys Info, for instance).

[donnah]

Actually I guess I just need to resize the objects on my forms...because the large forms are not totally visible with low resolution.

[HeSaidJoe]

I just cut and pasted the code from this q & a and it works fine.
1st. check to make sure you have the module code in a
Class Module and not a Bass Module and that
all code is where it should be.

It you still have trouble email me and I will zip this little sample I tested with and send it to you for comparison.

Wayne

[PJB]

I got tired of trying to solve that problem and went and bought Larkum and Young's Resize OCX V3.7

[agent]

Try setting your scalemode to a realworld unit, such as inches or centimeters, as tell all the controls/forms/etc to be a certain number of inches. They will occupy the same percentage of space on the screen. However, fonts (lables and captions) may not resize properly.