Solved

Resizing form controls as per screen resolution

Posted on 2007-04-03
4
721 Views
Last Modified: 2011-09-20
What is the best way to resize form controls depending on screen resolution ?

At design time, I am designing forms based on 1024 by 768 resolution. But on the client's machine, resolution can be higher or lower.

In .NET, what is the best practice for resizing forms based on screen resolution ? I have LOTS of controls on my form.
0
Comment
Question by:rajesh_khater
  • 2
4 Comments
 
LVL 14

Expert Comment

by:shahprabal
ID: 18843067
Dock the controls... You will need to play with the layout and docking a little to find the best fit...
0
 
LVL 21

Accepted Solution

by:
theGhost_k8 earned 500 total points
ID: 18843090
Here is the code from the Developer's Handbook.  It refers to frmScreenInfo which is nothing more than a way to look and test the various screen sizes for each screen resolution.  There are four forms which show scale testing and screen information.  For obvious reasons, I cannot include them here.

Jim

Option Compare Database
Option Explicit

' From Access 97 Developer's Handbook
' by Litwin, Getz, and Gilbert (Sybex)
' Copyright 1997.  All rights reserved.

' Constants that aren't there, that probably should be.
Const acWindow = 7
Const acSizeToFit = 6
Const acDatasheetView = 2

' Enumerated constants for GetTwips()
Const adhcXAxis = 0
Const adhcYAxis = 1

' The maximum size for a form is 22 inches.
Const adhcMaxTwips = 22 * adhcTwipsPerInch

' Error constants
Const adhcErrDivisionByZero = 11
Const adhcErrInvalidProperty = 2455

Type adhTypeRect
    X1 As Long
    Y1 As Long
    X2 As Long
    Y2 As Long
End Type

' Store group/subform dimensions.
Type adhTypeDimensions
    sglLeft As Single
    sglTop As Single
    sglWidth As Single
    sglHeight As Single
    strCtlName As String
End Type

' Under the Win95 shell (either Win95 or WinNT)
' there's a 2 pixel border. If you need to run on
' the WinNT 3.51 shell, you'll need to find the
' version number, and adjust these values accordingly.
Const adhcBorderWidthX = 2
Const adhcBorderWidthY = 2

Const adhcTop = "Top"
Const adhcLeft = "Left"
Const adhcRight = "Right"
Const adhcBottom = "Bottom"

Function adhGetCoords(strApp As String, frm As Form)

    ' This is the entry point for retrieving form info.
    ' Call this from the form's Open event.

    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    Dim rct As adhTypeRect
    Dim strName As String

    On Error GoTo adhGetCoordsErr

    ' Use the name of the application as the highest
    ' level, and the form's name as the next level.
    ' This way, you could have multiple forms in the same
    ' app use this code.
    strName = frm.Name
    With rct
        .Y1 = GetSetting(strApp, strName, adhcTop, 0)
        .X1 = GetSetting(strApp, strName, adhcLeft, 0)
        .Y2 = GetSetting(strApp, strName, adhcBottom, 0)
        .X2 = GetSetting(strApp, strName, adhcRight, 0)
       
        ' Only muck with the form's size if
        ' you get values for bottom and right
        ' that make sense.
        If .X2 > 0 And .Y2 > 0 Then
            Call SetFormSize(frm, rct)
        End If
    End With

adhGetCoordsExit:
    Exit Function

adhGetCoordsErr:
    MsgBox "Unable to retrieve all coordinates.", _
     vbInformation, "Get Coords"
    Resume adhGetCoordsExit
End Function

Function adhSaveCoords(strApp As String, frm As Form)

    ' This is the entry point for saving form info.
    ' Call this from the form's Close event.
   
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    Dim rct As adhTypeRect
    Dim strName As String

    On Error GoTo adhSaveCoordsErr

    ' Get the form's current size and position.
    GetFormSize frm, rct
    strName = frm.Name

    ' Use the name of the application as the highest
    ' level, and the form's name as the next level.
    ' This way, you could have multiple forms in the same
    ' app use this code.
    With rct
        SaveSetting strApp, strName, adhcTop, .Y1
        SaveSetting strApp, strName, adhcLeft, .X1
        SaveSetting strApp, strName, adhcBottom, .Y2
        SaveSetting strApp, strName, adhcRight, .X2
    End With

adhSaveCoordsExit:
    Exit Function

adhSaveCoordsErr:
    MsgBox "Unable to save all coordinates.", _
     vbInformation, "Save Coords"
    Resume adhSaveCoordsExit
End Function

Function adhResizeForm(frm As Form, ByVal fDoResize As Variant, _
 rctOriginal As adhTypeRect)

    ' Called from the Resize event of forms.
    ' Attempt to resize the form and all its
    ' controls.  Don't do anything if the
    ' current height of the form is 0, or if it's iconic.

    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    ' In:
    '    frm: A reference to the form in question
    '    fDoResize: Yes/No (Actually do the resize, or just track the information?)
    '    rctOriginal: the original coordinates
    ' Out:
    '    Nothing

    Dim rctNew As adhTypeRect
    Dim intWidth As Integer
    Dim intHeight As Integer
    Dim sglFactorX As Single
    Dim sglFactorY As Single

    On Error GoTo adhResizeWindowError
    ' Make sure the user hasn't sized this thing down
    ' to the nubs.  If the client area is 0 height,
    ' it's time to call it quits.
    adh_apiGetClientRect frm.hwnd, rctNew
    intHeight = (rctNew.Y2 - rctNew.Y1)
    If intHeight = 0 Or adh_apiIsIconic(frm.hwnd) Then
        Exit Function
    End If
   
    ' Now get the actual window height and width.
    adh_apiGetWindowRect frm.hwnd, rctNew

    ' Get the current width and height.
    intHeight = (rctNew.Y2 - rctNew.Y1)
    intWidth = (rctNew.X2 - rctNew.X1)

    ' Calc the scaling factor, given the current
    ' height/width and the previous height/width.
    ' Could be that rctOriginal has not yet been
    ' initialized, so trap for that error.

    sglFactorX = intWidth / (rctOriginal.X2 - rctOriginal.X1)
    sglFactorY = intHeight / (rctOriginal.Y2 - rctOriginal.Y1)

sglFactorOK:
    ' Store away the current values for
    ' the next time through here.
    With rctOriginal
        .X1 = rctNew.X1
        .X2 = rctNew.X2
        .Y1 = rctNew.Y1
        .Y2 = rctNew.Y2
    End With
    ' If the ratios are 1, there's nothing to do.
    If (sglFactorX <> 1) Or (sglFactorY <> 1) Then
        ' If you actually want to do some resizing, do it now.
        If fDoResize Then
            SetFormSize frm, sglFactorX, sglFactorY, rctNew, False
        End If
    End If

adhResizeWindowExit:
    Exit Function

adhResizeWindowError:
    If Err = adhcErrDivisionByZero Then
        sglFactorX = 1
        sglFactorY = 1
        Resume sglFactorOK
    Else
        HandleError "adhResizeForm", Err.Number, Err.Description
        Resume Next
    End If
End Function

Function adhScaleForm(frm As Form, intX As Integer, intY As Integer, _
 intDPIX As Integer, intDPIY As Integer, rctOriginal As adhTypeRect)

    ' Called from the Open event of forms.
    ' Attempts to scale the form appropriately
    ' for the given screen size, as compared
    ' to the size screen on which it was designed.
    '
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    ' In:
    '     frm: A reference to the form in question
    '     intX: the horizontal screen resolution at which the form was designed.
    '     intY: the vertical screen resolution at which the form was designed.
    '     rctOriginal: original coordinates
    '
    ' Out:
    '     Nothing
    ' Comments:
    '     Use a function call like this:
    '       intRetval = adhScaleForm(Me, 640, 480, rctOriginal)
    '     to autoscale a form created at 640x480 resolution.

    Dim sglFactorX As Single
    Dim sglFactorY As Single

    GetScreenScale intX, intY, intDPIX, intDPIY, sglFactorX, sglFactorY

    ' Whether or not this form gets rescaled,
    ' you'll need to store away the current size
    ' for later.  The reason you must call GetFormSize
    ' here, rather than adh_apiGetClientRect, is that
    ' you need the screen positioning information
    ' which you don't get with GetClientRect.
    GetFormSize frm, rctOriginal

    ' If the x and y factors are both 1, there's nothing
    ' to do, so get out here.
    If (sglFactorX = 1) And (sglFactorY = 1) Then Exit Function

    ' If you don't want forms to expand (they were created on a
    ' lower-resolution device than the current device), but only
    ' shrink (they were created on a higher-resolution device
    ' than the current device), then uncomment the next line.
    'If (sglFactorX > 1) And (sglFactorY > 1) Then Exit Sub
    DoCmd.RepaintObject
    SetFormSize frm, sglFactorX, sglFactorY, rctOriginal, True
End Function

Private Sub SetFormSize(frm As Form, rct As adhTypeRect)

    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    Dim intWidth As Integer
    Dim intHeight As Integer
    Dim intSuccess As Integer

    With rct
        intWidth = (.X2 - .X1)
        intHeight = (.Y2 - .Y1)
   
       ' No sense even trying if either is less than 0.
        If (intWidth > 0) And (intHeight > 0) Then
            ' You would think the MoveSize action
            ' would work here, but that requires actually
            ' SELECTING the window first.  That seemed like
            ' too much work, when this procedure will
            ' move/size ANY window.
            intSuccess = adh_apiMoveWindow(frm.hwnd, _
             .X1 - adhcBorderWidthX, .Y1 - adhcBorderWidthY, _
             intWidth, intHeight, True)
        End If
    End With
End Sub

Private Function ChangeFont(ctl As Control) As Boolean

    ' Decide whether or not to change the font,
    ' based on the control type.

    Dim fDoit As Boolean
    fDoit = False
    Select Case ctl.ControlType
        Case acTextBox, acComboBox, acListBox, acLabel, _
         acCommandButton, acToggleButton
            fDoit = True
        Case Else
            fDoit = False
    End Select
    ChangeFont = fDoit
End Function

Private Function ChangeHeight(ctl As Control) As Boolean

    ' Decide whether or not to change the height,
    ' based on the control type.

    Dim fDoit As Boolean
    fDoit = True
    Select Case ctl.ControlType
        Case acCheckBox, acOptionButton, acPageBreak
            fDoit = False
        Case Else
            fDoit = True
    End Select
    ChangeHeight = fDoit
End Function

Private Function FixGroups(frm As Form, aGroups() As adhTypeDimensions, sglFactorX As Single, sglFactorY As Single)

    ' Store away information about controls that
    ' contain other controls (subforms/subgroups/tabs).
    ' Return the number of these controls that
    ' were found.

    Dim fDoit As Boolean
    Dim intGroups As Integer
    Dim ctl As Control

    intGroups = 0
    For Each ctl In frm.Controls
        With ctl
            Select Case .ControlType
                Case acOptionGroup, acSubForm, acTabCtl
                    fDoit = True
                Case Else
                    fDoit = False
            End Select
            If fDoit Then
                intGroups = intGroups + 1
                ReDim Preserve aGroups(intGroups)
           
                aGroups(intGroups).strCtlName = .Name
                aGroups(intGroups).sglLeft = .Left * sglFactorX
                aGroups(intGroups).sglTop = .Top * sglFactorY
                aGroups(intGroups).sglWidth = .Width * sglFactorX
                aGroups(intGroups).sglHeight = .Height * sglFactorY
            End If
        End With
    Next ctl
    FixGroups = intGroups
End Function

Private Sub FixSections(frm As Form, sglFactorY As Single)

    ' Loop through all the sections of the form,
    ' up to 5 sections, setting the height of
    ' each.  If a section isn't there, just keep
    ' on going.

    Dim intI As Integer
    Dim varTemp As Variant

    ' There are 5 possible sections in a form,
    ' but they might not all be there.
    On Error Resume Next
    With frm
        For intI = 0 To 4
            varTemp = .Section(intI).Height * sglFactorY
            .Section(intI).Height = IIf(varTemp > adhcMaxTwips, _
             adhcMaxTwips, varTemp)
        Next intI
    End With
End Sub

Private Sub GetFormSize(frm As Form, rct As adhTypeRect)

    ' Fill in rct with the coordinates of the window.

    Dim hWndParent As Long
    Dim rctParent As adhTypeRect

    ' Find the position of the window in question, in
    ' relation to its parent window (the Access desktop,
    ' the MDIClient window).
    hWndParent = adh_apiGetParent(frm.hwnd)

   ' Get the coordinates of the current window and its parent.
    adh_apiGetWindowRect frm.hwnd, rct

    ' Catch the case where the form is Popup (that is,
    ' its parent is NOT the Access main window.)  In that
    ' case, don't subtract off the coordinates of the
    ' Access MDIClient window.
    If hWndParent <> Application.hWndAccessApp Then
        adh_apiGetWindowRect hWndParent, rctParent

        ' Subtract off the left and top parent coordinates, since you
        ' need coordinates relative to the parent for the adh_apiMoveWindow()
        ' function call.
        With rct
            .X1 = .X1 - rctParent.X1
            .Y1 = .Y1 - rctParent.Y1
            .X2 = .X2 - rctParent.X1
            .Y2 = .Y2 - rctParent.Y1
        End With
    End If
End Sub

Private Sub GetScreenScale(ByVal intX As Integer, ByVal intY As Integer, _
 ByVal intDPIX As Integer, ByVal intDPIY As Integer, _
 ByRef sglFactorX As Single, ByRef sglFactorY As Single)

    ' In:  intX, intY:  x and y screen resolutions
    '                   when the form was created.
    '      intDPIX, intDPIY: DPI measurements where form
    '                   was created. Use frmScreenInfo
    '                   to get these values.
    ' Out: sglFactorX, sglFactorY:  scaling factors for
    '                               the x and y directions.

    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    Dim intScreenX As Integer
    Dim intScreenY As Integer

    Dim lngIC As Long

    On Error GoTo GetScreenScaleError

    ' Get the information context you need to find the screen info.
    lngIC = adh_apiCreateIC("DISPLAY", vbNullString, _
     vbNullString, vbNullString)

    ' If the call to CreateIC didn't fail, then get the info.
    If lngIC <> 0 Then
        ' Find the number of pixels in both directions on the
        ' screen, (640x480, 800x600, 1024x768, 1280x1024?). This
        ' also takes into account the size of the task bar, whereever
        ' it is.
        intScreenX = adh_apiGetSystemMetrics(adhcSM_CXFULLSCREEN)
        intScreenY = adh_apiGetSystemMetrics(adhcSM_CYFULLSCREEN)
       
        ' Get the ratio of the current screen size to the design-time
        ' screen size.
        sglFactorX = intScreenX / intX
        sglFactorY = intScreenY / intY

        ' Finally, take into account the differences in the display
        ' resolutions.  At 640x480, you get more twips per pixel (15)
        ' as opposed to 12 at higher resolutions.
        sglFactorX = sglFactorX * (intDPIX / adh_apiGetDeviceCaps(lngIC, adhcLOGPIXELSX))
        sglFactorY = sglFactorY * (intDPIY / adh_apiGetDeviceCaps(lngIC, adhcLOGPIXELSY))

        ' Release the information context.
        adh_apiDeleteDC lngIC
    End If

GetScreenScaleExit:
    Exit Sub

GetScreenScaleError:
    Select Case Err.Number
        Case adhcErrDivisionByZero
            ' It seems that the first time you call
            ' GetDeviceCaps under Win95 after you've done
            ' a quick change on the resolution, it returns 0
            ' for the screen size.  This will hopefully correct
            ' that problem.
            Resume
        Case Else
            HandleError "GetScreenScale", Err.Number, Err.Description
            Resume GetScreenScaleExit
    End Select
End Sub

Private Sub HandleError(strFunction As String, intErr As Integer, strError As String)
    MsgBox "Error: " & strError & " (" & intErr & ")", vbExclamation, strFunction
End Sub

Private Sub SetFormSize(frm As Form, sglFactorX As Single, sglFactorY As Single, _
 rct As adhTypeRect, fMove As Integer)

    ' Actually do the work to resize all the controls
    ' on the given form, and then resize the form
    ' itself.

    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    Dim intTemp As Integer
    Dim intWidth As Integer
    Dim intHeight As Integer
    Dim ctl As Control
    Dim sglFontSize As Single
    Dim intI As Integer
    Dim intGroups As Integer
    Dim aGroups() As adhTypeDimensions
    Dim colGroups As New Collection
    Dim varTemp As Variant
   
    On Error GoTo SetFormSizeError

    DoCmd.Hourglass True
    frm.Painting = False

    ' If the form is growing vertically, then need to
    ' fix up the section heights now.  If it's shrinking,
    ' fix up the heights AFTER you place the controls.
    ' The same goes for the form width.
    If sglFactorY > 1 Then
        ' Fix up all the section heights.
        FixSections frm, sglFactorY
        varTemp = frm.Width * sglFactorX
        If varTemp > adhcMaxTwips Then
            frm.Width = adhcMaxTwips
        Else
            frm.Width = varTemp
        End If
    End If

    ' Now deal with all the controls
    ' Go through and deal with all the groups and subforms first.
    intGroups = FixGroups(frm, aGroups(), sglFactorX, sglFactorY)

    ' Now go back and deal with all the rest of the controls.
    For Each ctl In frm.Controls
        Select Case ctl.ControlType
            Case acOptionGroup, acTabCtl, acPage
                GoTo NextCtl
            Case acSubForm
                ' If you've got a subform, then recurse on down into this
                ' routine again, dealing with all the controls inside of
                ' that subform.
                SetFormSize ctl.Form, sglFactorX, sglFactorY, rct, False
                GoTo NextCtl
        End Select

        ' So the control isn't a subform and it's not a group.
        ' Therefore, just scale it to the correct size.

        ' First, fix up the font, if this control has a font
        ' that needs to be fixed up.
        If ChangeFont(ctl) Then
            sglFontSize = ctl.FontSize * sglFactorY
        Else
            sglFontSize = -1
        End If

        ' Set the top, left and width values.
        If frm.CurrentView <> acDatasheetView Then
            ctl.Top = ctl.Top * sglFactorY
            ctl.Left = ctl.Left * sglFactorX
            ctl.Width = ctl.Width * sglFactorX
        End If

        ' Change the height, if that's required.
        If ChangeHeight(ctl) Then
            ctl.Height = ctl.Height * sglFactorY
        End If

        ' Only attempt to change the font size for
        ' certain types of controls.
        If sglFontSize >= 1 And sglFontSize <= 127 Then
            ctl.FontSize = sglFontSize
        End If
NextCtl:
    Next ctl

    ' Go through and fix up the option groups/subforms,
    ' which may have been distorted by changes to
    ' the internal controls.
    For intI = 1 To intGroups
        With frm(aGroups(intI).strCtlName)
            .Top = aGroups(intI).sglTop
            .Left = aGroups(intI).sglLeft
            .Width = aGroups(intI).sglWidth
            .Height = aGroups(intI).sglHeight
        End With
    Next intI

    ' If the form is shrinking vertically, fix up the
    ' section heights now that all the controls have been
    ' placed.  The same goes for the form width.
    If sglFactorY < 1 Then
        ' Fix up all the section heights.
        FixSections frm, sglFactorY
        frm.Width = frm.Width * sglFactorX
    End If

    If fMove Then
        intWidth = Int((rct.X2 - rct.X1) * sglFactorX)
        intHeight = Int((rct.Y2 - rct.Y1) * sglFactorY)

        rct.X1 = Int(rct.X1 * sglFactorX)
        rct.Y1 = Int(rct.Y1 * sglFactorY)
        rct.X2 = rct.X1 + intWidth
        rct.Y2 = rct.Y1 + intHeight

        intTemp = adh_apiMoveWindow(frm.hwnd, rct.X1, rct.Y1, intWidth, intHeight, True)
        DoCmd.RunCommand acCmdSizeToFitForm
    End If

SetFormSizeExit:
    frm.Painting = True
    DoCmd.Hourglass False
    Exit Sub

SetFormSizeError:
    Select Case Err
        Case adhcErrInvalidProperty
            Resume Next
        Case Else
            HandleError "SetFormSize", Err.Number, Err.Description
            Resume Next
            Resume
    End Select
End Sub

Private Sub GetFormSize(frm As Form, rct As adhTypeRect)

    ' Fill in rct with the coordinates of the window.

    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    Dim hWndParent As Long
    Dim rctParent As adhTypeRect

    ' Find the position of the window in question, in
    ' relation to its parent window (the Access desktop,
    ' the MDIClient window).
    hWndParent = adh_apiGetParent(frm.hwnd)
   
   ' Get the coordinates of the current window and its parent.
    adh_apiGetWindowRect frm.hwnd, rct
   
    ' Catch the case where the form is Popup (that is,
    ' its parent is NOT the Access main window.)  In that
    ' case, don't subtract off the coordinates of the
    ' Access MDIClient window.
    If hWndParent <> Application.hWndAccessApp Then
        adh_apiGetWindowRect hWndParent, rctParent

        ' Subtract off the left and top parent coordinates, since you
        ' need coordinates relative to the parent for the adh_apiMoveWindow()
        ' function call.
        With rct
            .X1 = .X1 - rctParent.X1
            .Y1 = .Y1 - rctParent.Y1
            .X2 = .X2 - rctParent.X1
            .Y2 = .Y2 - rctParent.Y1
        End With
    End If
End Sub
0
 
LVL 1

Author Comment

by:rajesh_khater
ID: 18853063
Isn't there a simpler and more elegant way of doing this ?
0
 
LVL 21

Expert Comment

by:theGhost_k8
ID: 19170517
hmmm.. simpler...!!?? i'd be happy if you find it for me and post it here...
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Article by: jpaulino
XML Literals are a great way to handle XML files and the community doesn’t use it as much as it should.  An XML Literal is like a String (http://msdn.microsoft.com/en-us/library/system.string.aspx) Literal, only instead of starting and ending with w…
Calculating holidays and working days is a function that is often needed yet it is not one found within the Framework. This article presents one approach to building a working-day calculator for use in .NET.
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now