Results 1 to 2 of 2

Thread: Loading forms based on screen resolution

  1. #1

    Thread Starter
    Member
    Join Date
    Jun 2000
    Posts
    34

    Question

    I was wondering if its possible to code your program and/or forms so that at run time they retrieve the current screen resolution and load the program and/or forms accordingly.

    I WOULD GREATLY APPRECIATE ANY RESPONSE, THANKS,
    Adrian Wickenheiser

  2. #2
    _______ HeSaidJoe's Avatar
    Join Date
    Jun 1999
    Location
    Canada
    Posts
    3,946

    ..I use this..works for me...

    '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

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

    "A myth is not the succession of individual images,
    but an integerated meaningful entity,
    reflecting a distinct aspect of the real world."

    ___ Adolf Jensen

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width