• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1172
  • Last Modified:

Resizing Forms

I'd like to let forms and their controls to automatically adapt to various screentypes, screen sizes and resolutions (1024x768, 800x600, etc.). The goal is that a form occupies exactly the available screen space for a maximized window with all controls visible as it was designed for the original screen-size and -resolution. I.e. that it should shrink for smaller screens and enlarge for bigger ones.I tried out a method given here as answer to a similar question (which I cannot find any more here on EE). It took the original screen resolution and determined the actual screen resolution and calculated a factor (y / yOld) with which to size the form/control:

For Each iControl In Me.Controls
    With iControl
         .Height = .Height * y / yOld

Although this works the result is not satisfyingly: From a higher resolution (1024x768) to a lower resolution (800x600) the form is only a bit too big (450 pixels, twips or what ever is the unit). From 1024x768 to 640x480 the form is  much too big. From 1024x768 to 2048x1024 it is much too small. I did the experiments for 1024x768 to 800x600 on different machines. The 1024x768 was a normal 19" CRT whereas the 800x600 was the LCD-screen of my laptop. I guess that not taking the physical pixel size of the different screens into account is one of perhaps many reasons why this method doesn't work. I determined the GetDeviceCaps(hDCcaps, LOGPIXELSX) and
GetDeviceCaps(hDCcaps, LOGPIXELSY)only to find them to be the same on CRTs and LCDs. Only GetDeviceCaps(hDCcaps, VERTSIZE)and
GetDeviceCaps(hDCcaps, HORZSIZE) delievered different values for the different screen types and resolutions.

I'm sure that the task can be accomplished 'cause it is built in into Visual Basic. Any hint will be very much appreciated.

0
cgikb2
Asked:
cgikb2
1 Solution
 
JimMorganCommented:
cqikb2:

Well, you can do it yourself or you can seek help through some third party tools.  Peter's Software offers a resizer completely written in Access and VBA as an addin you can buy and FMS Inc. offers an ActiveX control which you can buy.  I've tried both and they both work - the ActiveX control a lot faster than the all Access unit.

However we were developing a commercial application and felt that the added cost for Peter's ShrinkerStretcher http://www.peterssoftware.com was too much of an unknown.  The cost for a single copy is less than $40 and will dynamically work with the resize event but statically (according to screen resolution) will only work with an MDB.  Since we were going to create MDE's, this would not work for us.

FMS's component kit, http://www.fmsinc.com has a resizer as well as sliders, etc. which will dynamically resize all components when the user resizes the screen.  Cost is $149 for runtime.  However, unless the DB is opened initially in less than full screen mode, the forms will not resize to fill the screen until the user opens the window to full screen.

FMS also has a Resizer control for VB6.  They have never tried to use it with Access but it might just work.  I have not had time to try it out for myself.  I'm just shipping our first release of the product set for 800 x 600 resolution.

All the third party tools that I've found do take up a lot of resources.  So while we were in development, beta, and first release mode, we turned resizing off.  It was just one less factor to have to worry about at the time.

If you want to try to do it yourself, the first place to start is pickup a copy of "Access 97 Developer's Handbook" from Sybex.  Chapter 8 has quite a bit of information about screen resolution and distributing forms.  There is also code in the included CD.

For example, different resolutions not only have different pixel sizes but also different numbers of twips/pixel.  You can go by a direct math formula based on resolution comparisons.  There has to be offsets and scaling factors to calculate.  A 400 x 120 twip control in 640 x 480 would have to change to 512 x 154 in 1024 x 768 to maintain the same apparent screen ratio.  Not only do you have to consider form and control sizes, relative positions, offsets, etc., you also have to deal with changing the font sizes as the forms change.

Other factors are based on if toolbars, menus, or taskbars are being used.  I gave up trying to predetermine the exact Y offset as I would have no way of knowing how the user would be setting up Windows and gave them a utility to set the Y offset for the application.

It is not simple but it can be accomplished.  I took the code from the CD and made some extensive modifications for my apps.  All the API calls are included but I have not turned on all the features.  I was successful is using the calls to dynamically change the size of forms and subforms but I eventually found a better way to do that.  Because of a practical limitation of the number of controls which are active using Tabs, I used the code to devise a way to have synced pop up forms which move in conjuction with main form movement.  They look like subforms but they are not.

I see that you are using the API GetDeviceCaps call but what are you doing with it?  You will need to have the X and Y resolution, Screen DPI, the twips per pixel ratio factors, and more.

I don't know what code you have but here is some sample code for various items.  I'm making the assumption that you have all the API calls and the constants needed.

First you need the information context handle for the current screen display driver.

lngIC = apiCreateIC("Display", vbNullString, vbNullString, vbNullString)

This appears to be the same as your hDCcaps in your formulas.

Screen resolution used the GetSystemMetrics API call.

intScreenResX = apiGetSystemMetrics(SM_CXFullScreen)
intScreenResY = apiGetSystemMetrics(SM_CYFullScreen)

Now you can start the calculation of the resolution ratio based on the created resolutions and the current resolution.

sglFactorX = intScreenResX / intInitialResX
sglFactorY = intScreenResY / intInitialResY

Adjust for the difference in the twips per pixel.

sglFactorX = sglFactorX * (intInitialDPIX / apiGetDeviceCaps(intIC, LogPixelsX)
sglFactorY = sglFactorY * (intInitialDPIY / apiGetDeviceCaps(intIC, LogPixelsY)


With these two values, you have the information for better scaling of the form.

To properly scale the contents is a lot more code and information.  But you are probably getting the idea of what is going on here.  Get the book, play with the code here and on the CD, and then I or some other expert can help you refine the process.

Jim


0
 
BrianWrenCommented:
I think the reason that you are having less than satisfying results is that you are not actually working with the full screen.  Part of the screen is taken up by borders, etc., which shrink considerably as the resolution goes up.
0
 
DedushkaCommented:
As a temporary easy decision you can create 2 sets of the same forms for 2 different resolutions. On the startup form you should place a checkbox or radiobutton for choosing a desired screen resolution.
After realising JimMorgans suggestions, you can leave this temporary solution.
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
JimMorganCommented:
Another suggestion is to make your original forms 800 x 600 or 1024 x 768.  They resize the best to other resolutions.  640 x 480 is the hardest.

If there aren't many forms to deal with, the simplest solution may be to design the forms in each resolution and put them in their own DBs.  When the application is opened, determine the screen resolution and then opening the DB with the correct presized forms.  Only the forms and their required code would be in each DB or you could have the entire DB for each resolution.

Just a thought.

Jim
0
 
cgikb2Author Commented:
Thanks to all who answered so far. Well, using 3rd party tools is unacceptable. Getting the book Jim mentioned is only the last solution if nothing else works. Creating the forms in two or more diffrent resoltuions ... guys, that would be electronic data processing with hammer and chisels :-(

So why not let us find the answer together ? Lets start with the code we have so far:

Private Sub Form_Current()
On Error GoTo Err_Form_Current

Dim hDesktopWnd As Long
Dim hDCcaps As Long
Dim intScreenResY  As Integer
Dim intScreenResX  As Integer
Dim intInitialResX As Integer
Dim intInitialResY As Integer
Dim lngPixelsPerInchX As Long
Dim lngPixelsPerInchY As Long
Dim iRtn As Integer
Dim DB As Database
Dim sglFactorX As Single
Dim sglFactorY As Single
Dim iControl As Control


intInitialResX = 1024
intInitialResY = 768

hDesktopWnd = WM_apiGetDesktopWindow() 'get handle to desktop
hDCcaps = WM_apiGetDC(hDesktopWnd) 'get display context for desktop
intScreenResY = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES)  ' Get vertical resolution
intScreenResX = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES)  'Get horizontal resolution
lngPixelsPerInchX = WM_apiGetDeviceCaps(hDCcaps, WU_LOGPIXELSX) 'Get horizontal logical pixels per Inch
lngPixelsPerInchY = WM_apiGetDeviceCaps(hDCcaps, WU_LOGPIXELSY) 'Get vertical logical pixels per Inch

iRtn = WM_apiReleaseDC(hDesktopWnd, hDCcaps) 'release display context

sglFactorX = intScreenResX / intInitialResX 'calculation of the resolution ratio based on the created resolutions and the current resolution
sglFactorY = intScreenResY / intInitialResY

'calculation of the resolution ratio based on the created resolutions and the current resolution
'sglFactorX = sglFactorX * (intInitialDPIX / apiGetDeviceCaps(intIC, LogPixelsX)
'sglFactorY = sglFactorY * (intInitialDPIY / apiGetDeviceCaps(intIC, LogPixelsY)

     Set DB = CurrentDb
     For Each iControl In Me.Controls
          With iControl                             ' resize all the controls on the form
             .Height = .Height * sglFactorY
             .Width = .Width * sglFactorX
             .Left = .Left * sglFactorX
             .Top = .Top * sglFactorY
             On Error Resume Next
             .FontSize = .FontSize * sglFactorY
             If .FontSize < 8 Then
                .FontSize = 8
             End If
          End With
     Next

   Me.Detailbereich.Height = Me.Detailbereich.Height * sglFactorY   ' resize the form itself, Detailsection
   Me.Formularkopf.Height = Me.Formularkopf.Height * sglFactorY     ' Headersection
   Me.Formularfuß.Height = Me.Formularfuß.Height * sglFactorY       ' Footer
   Me.Width = Me.Width * sglFactorX
   
   Exit Sub
         
Err_Form_Current:
             MsgBox Err.Description
             Resume Exit_Form_Current
         
Exit_Form_Current:
          Exit Sub


End Sub

The declarations for the API function calls are not shown. This code works with the imperfection I described in the original question. Surely you noticed I commented the following 2 lines out:
'sglFactorX = sglFactorX * (intInitialDPIX / apiGetDeviceCaps(intIC, LogPixelsX)
'sglFactorY = sglFactorY * (intInitialDPIY / apiGetDeviceCaps(intIC, LogPixelsY)

Jim, what is intInitialDPIX  and intInitialDPIY ? Should it be the original value for LogPixelsX and LogPixelsY ? Well, if yes I already found them to be the same for my CRT and my LCD-screen of the laptop, so it doesn't make much sense.

I guess the following statement from Jim's comment is the key to success: "...different resolutions not only have different pixel sizes but also different numbers of twips/pixel.  You can go by a direct math formula based on resolution comparisons.  There has to be offsets and scaling factors to calculate.  A 400 x 120 twip control in 640 x 480 would have to change to 512 x 154 in 1024 x 768 to maintain the same apparent screen ratio.". So how to implement this ?
0
 
JimMorganCommented:
cqikb2:  intInitialDPIX and DIPY are found by finding the apiGetDeviceCaps(intIC, LogPixelsX) and PixelsY on the original form size.  When you set up the form initially, you could determine the DPI's and hard code those as global constants.

You would use the original LogPixelsX & Y when you first get the initial DPI values.  Later when the resolution has changed size, you would use the current resolution's LogPixelsX & Y to determine the current DPI.

I'll post the code from the Developer's Handbook in my next comment.

Jim
0
 
AlexVirochovskyCommented:
Hi, cgikb2!
I prepose, you use my code.It is OK,
and code is right, exepting one thing:
for GroupBox must use a bit other metod,
becouse GroupBox changed during changings his Controls. I save old values of GroupBox, change other controls, and to 2-nd Loop change
GroupBox using his old(not new!) values.

 
0
 
JimMorganCommented:
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
 
cgikb2Author Commented:
Hi Jim,

thank you for posting the code from the book here. But did you ever tried out the code ? After fixing a few minor bugs I cannot resolve the error when calling the CreateIC function within the GetScreenScale function: Access cannot find the entry point for this function in the gdi32.dll, although it should be there according to "Platform SDK: Windows GDI" in the MSDN. Did you ever had this problem ?

Hi Alex,

thank you for your comment. As you can see from the other comments we trying to create a new routine for this problem. I'm looking forward to your comments, too.
0
 
JimMorganCommented:
I rewrote the code for my own use.  So, no I did not use the native code from the book.  I'm sure that I did use the CreateIC function as it is used over and over.

I'll check my code and get back to you.

Yes, I do use that function and it is working fine.  Here is the api call that I use:

' Windows API declarations.
Declare Function adh_apiCreateIC Lib "gdi32" _
 Alias "CreateICA" (ByVal lpDriverName As String, _
 ByVal lpDeviceName As String, ByVal lpOutput As String, _
 lpInitData As Any) As Long

Does that match with yours?

The version of my GDI32.DLL is 4.10.1998.

Jim
0
 
cgikb2Author Commented:
Hi Jim,

thanks for your reply. I declared the function as "CreateIC" and not as "CreateICA" - that was the mistake. So that mystery is solved. So now I got a running version. Experimenting with it I found that the line:

intScreenX = GetSystemMetrics(adhcSM_CXFULLSCREEN)

produces the expected values e.g. 1024, 800 etc. but the line:

intScreenY = GetSystemMetrics(adhcSM_CYFULLSCREEN)

returns 721 for the 1024x768 and 549 for the 800x600 resolution. This results in a sglFactorY less than 1 on the machine with the CRT for which the form originally was designed to and the form is displayed too small in the height. If I change the original Y value (768 in this case) to 721 it is ok for the original machine. But on the LCD-Display the form is either too short or too large. So there are two questions now:

1. Why does the GetSystemMetrics(adhcSM_CYFULLSCREEN) - Systemcall returns not the expected value ?

2. What need to be changed so that the form is dislayed correct (without scroll bars in a maximized window) on all screens/resolutions ?
0
 
JimMorganCommented:
1. There are things like the SysTray which are not writeable areas of the screen.  So you will get a reduced horizontal reading if it is turned on any there.  Try moving the systray to the side and see if the reading change.

2. That has a lot to do with screen drivers and video cards.  We tried to come up with a univeral solution but after working with a dozen or so different systems, we decided that we had to make a system depend Y screen offset.  We accomplished this as part of the first time startup routine.  We produce a form with a white box and a blue box.  If the top of the boxes are not lined up, the user presses an Up or Down icon to line them up.  After they hit save, the setting is put in a system table and used for an additional Y offset to compensate for the driver and card differences.

I'm sure that there is some more elegant way but after a lot of work, we gave up on it and went with the brute force method.  Works beautifully.

Jim
0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now