Screen Resolution

[jjhobs]

Can anyone tell me the code for getting VB to check whether the screen resolution being used is 800 x 600? Thanks.

 

[HughLerwill]

screen.width/screen.twipsperpixelX
screen.height/screen.twipsperpixelY

These two statements will give you the screen width and height in pixels.

HTH Hugh

 

[jjhobs]

Thanks very much for this, it was very useful. However, I now have another problem - I have a project which runs perfectly on higher resolutions and fills the screen when windowstate is maximised. However, if the screen resolution is 800 x 600 instead of showing the top left of the form, I want it to be centered. In order to do this I have to change the windowstate to normal and then the right side and bottom of the form disappear. Do you know how to solve this please? Thanks.

 

[JAG14]

JJ,

The easiest way to do it i my experience is to check for the screen resolution at form load and then use this fantastic module that has been provided by a guy called Carlo Somigliana, who unfortunately, I am no longer able to contact.
However, per his request the module headers have been left in although I've modified the code slightly. And if you use it, which i'm sure you can, please do the same.

Just save the following code to a .BAS module file in the IDE.

' ========================================================================
' Module:   CtrlResizer
' Author:   Carlo Somigliana (Italy)
' e-mail:   somic@libero.it
' Rel.  :   0.25
' Date  :   11 Aug 2002
' lang. :   Visual Basic 5.0 - 6.0
'
' Description:
'   A VB module to automatically resize controls with forms and
'   ChilForms with their MDI Forms
'   Change Maxf constant to change max AutoResizing forms
'
' Use:
'   -Add 'AutoResize' in the TAG property of the controls you want to
'   automatically resize or Set ResizeAllControls flag to TRUE to
'   automatically resize all the controls in the form.
'   -Add 'NoResize' in the TAG property of the controls you DON'T want
'   to be automatically resized
'   -Add 'NoFontResize' in the TAG property of the controls you DON'T want
'   to automatically resize the Font
'   See sample code
'
' License:
'   Free, at the condition to leave this Module as is or update
'   the Version History at any change and advise me back about it
'   (continuous improvement !?!)
'   Comments and suggestions will be appreciated
'
' Version History
'-------------------------------------------------------------------------------
' Rel.  Date          Author            Description                   Compatible
'
' 0.00  23 Apr 2001   C. Somigliana     First Issue                   -
' 0.10  04 May 2001          "          Modified for MDI Forms        OK
'                                       (req. Gawie Wolmarans)
' 0.11  13 Jul 2001          "          Forms dimensions stored       OK
'                                       only if form visible
' 0.20  11 Nov 2001          "          Fixed Bug with Line control   OK
'                                       (thanks to Massimo Riccardi)
' 0.21  17 Nov 2001          "          Added Form Font Resize        OK
' 0.22  27 Dec 2001          "          Added
'                                       -Hidden Form while Resizing   ---
'                                       -NoFontResize parameter in    OK
'                                       in .Tag to void resizing font
'                                       -DeleteFormStartDimensions    OK
' 0.23  22 Jan 2002          "          -Fixed a bug Iconizing form   OK
' 0.24  28 Apr 2002          "          -Added 'NoResize' and         OK
'                                        'NoFontResize' options
'                                       -Added check if control can't
'                                        be resized (es. Timer)
' 0.24B 02 May 2002          "          -Added SSTab support          90%
'                                       (req. by father Zdzislaw
'                                       Huber-Finland)
' 0.24C 01 Jul 2002   Kipp E. Howard    Fixed a bug in Sub            OK
'                                       SetNewControlsDimensions
'                                       (many thanks)
' 0.25  11 Aug 2002   C. Somigliana     -Hidden Form while Resizing   OK
'                                       only if from is Not Modal
'                                       -Code Cleaned Up
'===========================================================================
Option Explicit
'Forms' variables
Global Const MaxF = 12 'max number of AutoResizing forms
Global frmNames$(MaxF), FormsStored$
Global frmWidthStart&(MaxF), frmHeightStart&(MaxF), frmFontStart(MaxF)
'Controls' variables
Global ctrlLeftStart&(), ctrlTopStart&(), ctrlHeightStart&(), ctrlWidthStart&(), ctrlFontSize&()
Global StdFrmWidthINI&, StdFrmHeightINI& 'for the MDIForm
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Const GWL_STYLE = (-16)
Const GWL_EXSTYLE = (-20)

'this procedure is called by the form that wants to be AutoResizable
'from the Resize Event
Sub ResizeControls(frm As Form, ResizeAllControls&)
Dim f&, AutoRedr As Boolean, varModal As Long

'at the end of Form_Load event, the form is visible and resize if called the last time
If frm.Visible = False Then Exit Sub

If InStr(1, FormsStored, " " + frm.Name + " ", vbTextCompare) = 0 Then
  Call StoreStartControlsDimensions(frm)
Else
  'if iconized, doesn't resize anything
  If frm.WindowState = vbMinimized Then Exit Sub
  
  If frm.Visible Then
    'version Hidding (to improve performances)
    varModal = FormMode(frm.hwnd)
    'Hide the form only if Not Modal to avoid error 405 attempting to show the modal form again
    'this because we should Hide the form and then ReShow it, but the upper frm.Show Modal
    'instruction has not been completed yet, and the Hide/Show operation is not allowed.
    If varModal = 0 Then frm.Visible = False: frm.Refresh
    Call SetNewControlsDimensions(frm, ResizeAllControls&)
    If varModal = 0 Then frm.Show 0
  Else
    Call SetNewControlsDimensions(frm, ResizeAllControls&)
  End If
End If

End Sub
'store the starting control dimensions
'this is done only once at the first call of the ResizeControls subroutine
'the new dimensions are calculated always relatively to the original ones
'
'we could also resize the controls each time relatively to the previous dimensions,
'(avoiding to store the initial dimensions), but it wouldn't work properly with the
'NOT TrueType fonts, because they could alter the resize of the control
'
Sub StoreStartControlsDimensions(frm As Form)
Dim k&, i&, f&, c&, ctrl As Control, FormDeleted As Boolean
Static frmID&, MaxC&, MaxfrmID&

If IsMDIForm(frm) Then
  'store MDI Form dimensions (there can be only one MDI form in the App)
  FormsStored = FormsStored + " " + frm.Name + " "
  StdFrmWidthINI = frm.Width
  StdFrmHeightINI = frm.Height
Else

  FormDeleted = False
  For i = 1 To MaxfrmID
    'if form name doesn't exist in the FormsStored but exists in the array, then it has been deleted
    If frmNames(frmID) = frm.Name Then FormDeleted = True: Exit For
  Next i
  'set or increase form counter
  If FormDeleted Then frmID = i Else frmID = MaxfrmID + 1: MaxfrmID = frmID
  
  frmNames(frmID) = frm.Name
  If frmID > MaxF Then Exit Sub
  
  'eventually redim arrays
  c = frm.Controls.Count
  If c > MaxC Then
    MaxC = c 'eventually redim arrays storing control's dimensions
    ReDim Preserve ctrlFontSize(MaxF, MaxC), ctrlLeftStart(MaxF, MaxC), _
      ctrlTopStart(MaxF, MaxC), ctrlHeightStart(MaxF, MaxC), ctrlWidthStart(MaxF, MaxC)
  End If
  
  'store form's dimensions
  FormsStored = FormsStored + " " + frmNames(frmID) + " "
  frmWidthStart(frmID) = frm.Width
  frmHeightStart(frmID) = frm.Height
  frmFontStart(frmID) = frm.Font.Size
    
  On Error Resume Next 'some properties may not exist for some controls
  'store controls' dimensions
  For k = 0 To c - 1
    Set ctrl = frm.Controls(k)
    
    'check if control can be resized
    'es. Timer, CrystalReport, Menu Then GoTo skipResize
    If Not ResizableControl(ctrl) Then GoTo skipStore
    With ctrl
      If TypeOf ctrl Is Line Then
        ctrlLeftStart&(frmID, k) = .X1
        ctrlTopStart&(frmID, k) = .Y1
        ctrlWidthStart&(frmID, k) = .X2 - .X1
        ctrlHeightStart&(frmID, k) = .Y2 - .Y1
      Else
        ctrlLeftStart&(frmID, k) = .Left
        'SSTab change Left property to Hide the control
        '///
        '/// activate this 3 lines only if you have a SSTab container
        '///
        'If ctrlLeftStart&(frmID, k) < 0 And TypeOf ctrl.Container Is SSTab Then
        '  ctrlLeftStart&(frmID, k) = ctrlLeftStart&(frmID, k) + 75000
        'End If
        ctrlTopStart&(frmID, k) = .Top
        ctrlHeightStart&(frmID, k) = .Height
        ctrlWidthStart&(frmID, k) = .Width
      End If
      ctrlFontSize&(frmID, k) = .Font.Size
    End With
skipStore:
  Next k
  On Error GoTo 0
End If
  
End Sub

'set new (or original) controls' dimensions
Sub SetNewControlsDimensions(frm As Form, AllControls&, Optional OriginalSize)
Dim k&, DHp#, DWp#, Dc#, c&, f&, ctrl As Control, StdFrm As Form
'Dim ActCtrl As Control, H2&, W2&, L2&, T2&


If IsMissing(OriginalSize) Then OriginalSize = False

If IsMDIForm(frm) Then
  'look for the index of the MDI Form (Parent)
  'to calc form's dimensions variation
  For f = 0 To MaxF
    Set StdFrm = Forms(f)
    If IsMDIForm(StdFrm) Then
      If OriginalSize Then
        If StdFrm.WindowState <> 0 Then StdFrm.WindowState = 0
        StdFrm.Width = StdFrmWidthINI
        StdFrm.Height = StdFrmHeightINI
      End If
      'calc form's dimensions variation
      DWp = StdFrm.Width / StdFrmWidthINI
      DHp = StdFrm.Height / StdFrmHeightINI
      Exit For
    End If
  Next f
  
  'resize all the forms in the MDI Form
  For f = 0 To Forms.Count - 1
    Set StdFrm = Forms(f)
    If IsChildForm(StdFrm) Then
      If AllControls Or InStr(1, StdFrm.Tag, "AutoResize", vbTextCompare) > 0 _
        And InStr(1, StdFrm.Tag, "NoResize", vbTextCompare) = 0 Then
      If StdFrm.WindowState <> 0 Then Exit For
      With StdFrm
        'font first
        If InStr(1, StdFrm.Tag, "NoFontResize", vbTextCompare) = 0 Then
          .Font.Size = frmFontStart(f) * DHp 'FontSize follows the Height property
        End If
        'resizing must be in this order
        .Height = frmHeightStart(f) * DHp
        .Width = frmWidthStart(f) * DWp
      End With
      End If
    End If
  Next f
Else
  
  'look for the index of the actual form
  For f = 1 To MaxF
    If frmNames(f) = frm.Name Then
      If OriginalSize Then
        If frm.WindowState <> 0 Then frm.WindowState = 0
        frm.Width = frmWidthStart(f)
        frm.Height = frmHeightStart(f)
      End If
      'calc form's dimensions variation
      DWp = frm.Width / frmWidthStart(f)
      DHp = frm.Height / frmHeightStart(f)
      Dc = DWp 'Sqr(DHp * DWp)
      If InStr(1, frm.Tag, "NoFontResize", vbTextCompare) = 0 Then
        frm.Font.Size = frmFontStart(f) * Dc
          '.Font.Size = frmFontStart(f) * DHp 'FontSize follows the Width property
      End If

      Exit For
    End If
  Next f
  
  
  'count controls
  c = frm.Controls.Count
  On Error Resume Next 'some properties are ReadOnly for some controls
  'cycle trou the controls on the form
  For k = 0 To c - 1
    Set ctrl = frm.Controls(k)
    If AllControls Or InStr(1, ctrl.Tag, "AutoResize", vbTextCompare) > 0 _
              And InStr(1, ctrl.Tag, "NoResize", vbTextCompare) = 0 Then
      'check if control can be resized
      'es. Timer, CrystalReport, Menu Then GoTo skipResize
      If Not ResizableControl(ctrl) Then GoTo skipResize
  
      With ctrl
        'font first
        Dc = DWp 'Sqr(DHp * DWp)
        If InStr(1, ctrl.Tag, "NoFontResize", vbTextCompare) = 0 Then
          .Font.Size = ctrlFontSize(f, k) * Dc
        End If
        'resizing must be in this order
        If TypeOf ctrl Is Line Then
          .X1 = ctrlLeftStart(f, k) * DWp
          .Y1 = ctrlTopStart(f, k) * DHp
          .X2 = .X1 + ctrlWidthStart(f, k) * DWp
          .Y2 = .Y1 + ctrlHeightStart(f, k) * DHp
        Else
          'ctrl.Move L2, T2, W2, H2'Move doesn't work properly
          
          .Height = ctrlHeightStart(f, k) * DHp
          .Width = ctrlWidthStart(f, k) * DWp
          'only if >=0 because if negative it is not visible.
          'some controls (es. SSTab) put this corrdinate negative to hide the control
          If .Left >= 0 Then .Left = ctrlLeftStart(f, k) * DWp
          .Top = ctrlTopStart(f, k) * DHp
        End If
      End With
skipResize:
    End If
  Next k
  frm.Refresh
  
  On Error GoTo 0

End If

End Sub

Sub ResetControlsDimensions(frm As Form)
  
  Call SetNewControlsDimensions(frm, True, True)

End Sub
Function IsChildForm&(frm As Form)
  Dim c&
  
  On Error Resume Next
  'this property exist only in Standard forms
  c = frm.MDIChild
  If Err = 0 Then IsChildForm = True Else IsChildForm = False
  On Error GoTo 0

End Function


Function IsMDIForm&(frm As Form)
  
  IsMDIForm& = Not IsChildForm(frm)

End Function

'delete form name from the list of stored forms
Sub DeleteFormStartDimensions(FName$)
Dim pos&, st$

  pos = InStr(1, FormsStored, FName, vbTextCompare)
  If pos > 0 Then
    st = Mid$(FormsStored, 1, pos - 1) + Mid$(FormsStored, pos + Len(FName) + 1)
  End If

  FormsStored = st
End Sub

'check if control can be resized
'es. Timer, CrystalReport, Menu Then GoTo skipResize
Function ResizableControl(ctrl As Control) As Boolean
Dim test&

  On Error Resume Next
  
  Err = 0
  test = ctrl.Left  'this instruction gives error if the control is not resizable or it is a graphical object
  If Err = 0 Then
    ResizableControl = True
  Else
    Err = 0
    test = ctrl.X1 'control is a graphical object
    If Err = 0 Then
      ResizableControl = True
    Else
      ResizableControl = False
    End If
  End If
  On Error GoTo 0
End Function

' return form mode (0=Not Modal, 1=Modal)
' Note: if an application has only one visible
'       form, this function considers it as Not Modal
'       correctly, because it can be hidden without
'       stopping the execution
        
Function FormMode(hwnd As Long) As Long
    Const NotModalStyle = &H40000 'NotModalStyle
                
    FormMode = -((GetWindowLong(hwnd, GWL_EXSTYLE) And NotModalStyle) = 0)

End Function

Then use in your form_load routine

ResizeControls Me, True

or, to set it to maximized first..

Me.WindowState = vbMaximized
ResizeControls Me, True

Hope it helps, tell me if it has, it's done wonders for me...

JaG

[tt]'Very funny, Scotty... Now Beam down my clothes.'[/tt]
​