Form Rescaling

[Treason]

I want to have my forms resize to fit the users Screen Resolution. I know this has been asked before and I have read the old threads. Unfortunately all the code I have found to do this either doesn't work, or Cost money... which I have none. Does any one have any free code to accomplish this task.

 

[ghudson]

It is not perfect but it does work...

'Module by Jamie Czernik 31st March 2000 {JSCzernik@Hotmail.com}'
'Please feel free to use or distribute this module as you see fit.'
'If you have any useful code that you wish to share then please email it to me'
'www.FilmInformation.co.uk - my web site :-)'

'USE: Design your form to fit 800 * 600 resolution and import this module into your project.'
'Call as "Resizeform Me" on the form's On Open event'
'You might use Form.Visble=False before and Form.Visible=true after the call to stop the '
'Screen flicker when the controls resize. Email me and let me know how you get on.....Jamie'

Option Compare Database
Option Explicit

'Module Declarations'
Global Const WM_HORZRES = 8
Global Const WM_VERTRES = 10

Dim Width As Integer
Dim Factor As Single 'Used as multiplier for current size properties'

Declare Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long
Declare Function WM_apiGetDC Lib "user32" Alias "GetDC" (ByVal hWnd As Long) As Long
Declare Function WM_apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Function WM_apiGetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Function GetScreenResolution() As String

    'returns the height and width'
    Dim DisplayHeight As Integer
    Dim DisplayWidth As Integer
    Dim hDesktopWnd As Long
    Dim hDCcaps As Long
    Dim iRtn As Integer
    
    'API call get current resolution'
    hDesktopWnd = WM_apiGetDesktopWindow() 'get handle to desktop
    hDCcaps = WM_apiGetDC(hDesktopWnd) 'get display context for desktop
    DisplayHeight = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES)
    DisplayWidth = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES)
    iRtn = WM_apiReleaseDC(hDesktopWnd, hDCcaps) 'release display context
    
    GetScreenResolution = DisplayWidth & "x" & DisplayHeight
    Width = DisplayWidth
    
    'MsgBox GetScreenResolution 'ghudson

End Function

Public Sub ResizeForm(frm As Form)

    Dim ctl As Control
    Dim I As Integer
    
    On Error Resume Next
    SetFactor 'Call to procedure SetFactor'
    With frm
        .Width = frm.Width * Factor
    End With
    For Each ctl In frm.Controls
        With ctl
        .Height = ctl.Height * Factor
        .left = ctl.left * Factor
        .Top = ctl.Top * Factor
        .Width = ctl.Width * Factor
        .FontSize = .FontSize * Factor
        End With
    Next ctl

End Sub

Sub SetFactor()

    GetScreenResolution 'Call to function GetScreenResolution'
    If Width = 640 Then
        Factor = 0.75 'ghudson added this to shrink the form
    Else
        If Width = 800 Then
            Factor = 1 '1.25 original ghudson
        Else
            If Width = 1024 Then
                Factor = 1.3 '1.6 original ghudson
            Else
                If Width = 1152 Then
                    Factor = 1.6 '1.8 original ghudson
                Else: Factor = 1
                End If
            End If
        End If
    End If

End Sub

You need to leave enough room around your form objects (text boxes, ect.), do not cram the objects too closely.

HTH

 

[Treason]

Thanks for the code ghudson, but apparently the best things in life aren't free. My buttons and fonts are all wierd. So I guess I have to pay or create 3 versions of my App for each resolution.

 

[Autoeng]

Jamie's example is OK but like you said it's not perfect. For a "perfect" example go to www.developershandbook.com and look under downloads. It is a little complicated but if you take your time and read all of the documentation you'll get it. A warning though. Whenever you need to change ANYTHING on your forms first go to the VBA editor and place an ' before the lines of code having to do with the resizer. If you don't you form will resize during editing and you'll have to go back and change everything again. I always work on a "working" copy of the db so if I forget I can just go back to the original and start over instead of having to resize everything again.

Autoeng

 

[Rich]

Whenever you need to change ANYTHING .....................
is this newer versions? I don't get this problem with 97

 

[Autoeng]

I don't know. I use A2K and whenever I move / add / delete anything from my form with the resizer on is saves the resized version of the form and mess with the layout, and, or text wrapping on buttons or in fields. Who knows????

Autoeng

 

[mission2java_78]

Or just buy ShrinkerStretcher...I use it with my app and its only like 30 bucks...

www.peterssoftware.com

 

[Autoeng]

I bought 30 bucks worth of beer instead.

Autoeng

 

[mission2java_78]

Well I dont drink so I think that's your problem not mine .
Jon