Solved

Resizing form controls as per screen resolution

Posted on 2007-04-03
4
735 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

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A while ago, I was working on a Windows Forms application and I needed a special label control with reflection (glass) effect to show some titles in a stylish way. I've always enjoyed working with graphics, but it's never too clever to re-invent …
Microsoft Reports are based on a report definition, which is an XML file that describes data and layout for the report, with a different extension. You can create a client-side report definition language (*.rdlc) file with Visual Studio, and build g…
This video shows how to quickly and easily add an email signature for all users on Exchange 2016. The resulting signature is applied on a server level by Exchange Online. The email signature template has been downloaded from: www.mail-signatures…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

791 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