Solved

How to build a form with controls that can work with any screen resolution or size.

Posted on 2015-01-28
6
168 Views
Last Modified: 2015-01-28
How to build a form with controls that can work with any screen resolution or size.
I have Visual studio 2012 and use VB
0
Comment
Question by:avalonwgi
  • 3
  • 2
6 Comments
 
LVL 70

Expert Comment

by:Éric Moreau
ID: 40576567
WPF will handle it better than WinForms for sure. But even that said, if you have a form that shows correctly on a 13" monitor (laptop), it will be horrible on a 32"
0
 
LVL 46

Expert Comment

by:Martin Liss
ID: 40576646
What Eric said is no doubt true, but one point to keep in mind is that you should design it to look good on the smallest screen you need to support.
0
 

Author Comment

by:avalonwgi
ID: 40576670
Yes I understand, but what techniques, properties, etc. do I need to use to accomplish this.  I have only done fixed in the past for a specific screen size/resolution.  Humor me, but I need some meat on this topic please.  Thanks.
0
Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

 
LVL 46

Accepted Solution

by:
Martin Liss earned 500 total points
ID: 40576678
I'm a VB6/VBA programmer and I could attach a VB6 project that does the resizing, but unless you have VB6 the project won't do you any good. Basically you need to store the height, width and top properties of every control in your project before they are shown on the screen. Then you need to calculate a ratio of the size of the current screen to the size of the original screen and adjust those 3 properties accordingly.

For what it's work here is the code and a link to my article on the subject

In a form:
Private clsResize As CResizer

Private Sub Form_Resize()
    clsResize.ResizeControls Me
End Sub

Private Sub Form_Load()
    
    Set clsResize = New CResizer
    clsResize.Initialize Me
    ' Optional: move but don't resize or change the font size of the OK button
    clsResize.SetActions "cmdOK", , False
    ' Optional: resize and change the fontsize, but don't move the Close button
    clsResize.SetActions "cmdClose", False, True, True
    ' Optional: resize, move and change the font size of Text1
    clsResize.SetActions "Text1", , , True
    
    '******* 1.02 Start *******
    'Truncate the command button Caption
    clsResize.SetActions "Command1", , , , True
    '******* 1.02 End *********
 End Sub

Open in new window

In a class module:
Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
Private Declare Function MulDiv Lib "kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long

Private Const LOGPIXELSY As Long = 90
Private Type SIZE
    cx As Long
    cy As Long
End Type
Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * 32
End Type
'******* 1.02 End *********

Private Type CtrlProportions
    Name As String
    Move As Boolean
    Resize As Boolean
    AdjustFont As Boolean
    '******* 1.02 Start *******
    Truncate As Boolean
    Captn As String
    '******* 1.02 End *********
    HeightProportions As Single
    WidthProportions As Single
    TopProportions As Single
    LeftProportions As Single
End Type

Private mProportionsArray() As CtrlProportions
Private mlngFormScaleHeight As Long

'******* 1.02 Start *******
' GetTextSize
' -> Measures the size in pixels of a string, given a particular font. This uses
'    the GetTextExtentPoint32 API to measure the string. The API is defined as
'    follows:
'
'      GetTextExtendPoint(ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE)
'        hdc:       The device context which is attached to the font to be used
'        lpsz:      The string to measure, based on the font contained in the hdc specified
'        cbString:  The length of the string which was passed in 'lpsz'
'        lpSize:    The SIZE structure which the measurements will be returned to
'
'
Private Function GetTextSize(text As String, font As StdFont) As SIZE
    Dim tempDC As Long
    Dim tempBMP As Long
    Dim f As Long
    Dim lf As LOGFONT
    Dim textSize As SIZE
    
    ' Create a device context and a bitmap that can be used to store a
    ' temporary font object
    tempDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0)
    tempBMP = CreateCompatibleBitmap(tempDC, 1, 1)
    
    ' Assign the bitmap to the device context
    DeleteObject SelectObject(tempDC, tempBMP)
    
    ' Set up the LOGFONT structure and create the font
    lf.lfFaceName = font.Name & Chr$(0)
    lf.lfHeight = -MulDiv(font.SIZE, GetDeviceCaps(GetDC(0), LOGPIXELSY), 72)
    lf.lfItalic = font.Italic
    lf.lfStrikeOut = font.Strikethrough
    lf.lfUnderline = font.Underline
    If font.Bold Then lf.lfWeight = 800 Else lf.lfWeight = 400
    f = CreateFontIndirect(lf)
    
    ' Assign the font to the device context
    DeleteObject SelectObject(tempDC, f)
    
    ' Measure the text, and return it into the textSize SIZE structure
    GetTextExtentPoint32 tempDC, text, Len(text), textSize
    
    ' Clean up (very important to avoid memory leaks!)
    DeleteObject f
    DeleteObject tempBMP
    DeleteDC tempDC
    
    ' Return the measurements
    GetTextSize = textSize
End Function
'******* 1.02 End *********
Public Sub Initialize(frm As Form)

    Dim I As Integer
    Dim lngLeft As Long
    Dim lngLeftOffset As Long

    On Error Resume Next
    
    mlngFormScaleHeight = frm.ScaleHeight
    ReDim mProportionsArray(0 To frm.Controls.Count - 1)
    
    For I = 0 To frm.Controls.Count - 1
        With mProportionsArray(I)
            .Name = frm.Controls(I).Name
            .Move = True
            .Resize = True

            .HeightProportions = frm.Controls(I).Height / frm.ScaleHeight
            .WidthProportions = frm.Controls(I).Width / frm.ScaleWidth
            .TopProportions = frm.Controls(I).Top / frm.ScaleHeight

            ' Controls on certain tab controls have -75000 added to their .Left prop to make them invisible.
            lngLeftOffset = 0
            lngLeft = frm.Controls(I).Left
            ' This line may need to be modified to add other tab control types
            If (frm.Controls(I).Container.Name = "SSTab" Or frm.Controls(I).Container.Name = "SSTab1") And lngLeft < 0 Then
                lngLeftOffset = 75000
            End If
            .LeftProportions = (lngLeft + lngLeftOffset) / frm.ScaleWidth
            '******* 1.02 Start *******
            If TypeName(frm.Controls(I)) = "CommandButton" Then
                .Captn = frm.Controls(I).Caption
            End If
            '******* 1.02 End *********
        End With
    Next I

End Sub


Public Sub ResizeControls(frm As Form)
    
    Dim lngCtl As Long
    Dim lngLeftOffset As Long
    Dim dblFontSize As Double
    

    On Error Resume Next 'comboboxes and perhaps other controls don't have a height property
    dblFontSize = 8.5 * (frm.ScaleHeight / mlngFormScaleHeight)
    
    For lngCtl = 0 To frm.Controls.Count - 1
        With mProportionsArray(lngCtl)
            ' move and resize objcontrols
            If .Move Then
                lngLeftOffset = 0
                ' This line may need to be modified to add other tab control types
                If (frm.Controls(lngCtl).Container.Name = "SSTab" Or frm.Controls(lngCtl).Container.Name = "SSTab1") _
                            And frm.Controls(lngCtl).Left < 0 Then
                    lngLeftOffset = 75000
                End If
                frm.Controls(lngCtl).Left = .LeftProportions * frm.ScaleWidth - lngLeftOffset
                frm.Controls(lngCtl).Top = .TopProportions * frm.ScaleHeight
            End If
            If .Resize Then
                frm.Controls(lngCtl).Width = .WidthProportions * frm.ScaleWidth
                frm.Controls(lngCtl).Height = .HeightProportions * frm.ScaleHeight
            End If
            If .AdjustFont Then
'******* 1.01a Start *******
'                frm.Controls(lngCtl).FontSize = dblFontSize
                frm.Controls(lngCtl).font.SIZE = dblFontSize
'******* 1.01a End *********
            End If
            '******* 1.02 Start *******
            If .Truncate Then
                ' Check to see if the width of the caption's text is greater than the width of the command button.
                ' The 200 is a fudge factor needed probably because of the bevel width of the command button
                If (GetTextSize(frm.Controls(lngCtl).Caption, frm.Controls(lngCtl).font).cx) * Screen.TwipsPerPixelX > frm.Controls(lngCtl).Width - 200 Then
                    ' It's too wide to fit so truncate by a character
                    frm.Controls(lngCtl).Caption = Left(.Captn, Len(frm.Controls(lngCtl).Caption) - 1)
                Else
                    ' Check to see if one character will fit
                    If (GetTextSize(Left(.Captn, Len(frm.Controls(lngCtl).Caption) + 1), frm.Controls(lngCtl).font).cx) * Screen.TwipsPerPixelX < frm.Controls(lngCtl).Width - 200 Then
                        ' It does so add the character
                        If frm.Controls(lngCtl).Caption <> .Captn Then
                           frm.Controls(lngCtl).Caption = Left(.Captn, Len(frm.Controls(lngCtl).Caption) + 1)
                        End If
                    End If
                End If
            End If
            '******* 1.02 End *********
        End With
    Next lngCtl
    
End Sub

'******* 1.02 Start *******
'Public Sub SetActions(strControlName As String, Optional bMove As Boolean = True, _
'                                                Optional bResize As Boolean = True, _
'                                                Optional bAdjustFont As Boolean = False)
Public Sub SetActions(strControlName As String, Optional bMove As Boolean = True, _
                                                Optional bResize As Boolean = True, _
                                                Optional bAdjustFont As Boolean = False, _
                                                Optional bTruncate As Boolean = False)
'******* 1.02 End *********

    Dim I As Integer
    
    For I = 0 To UBound(mProportionsArray())
'******* 1.01b Start *******
'        If mProportionsArray(I).Name = strControlName Then
        If UCase(mProportionsArray(I).Name) = UCase(strControlName) Then
'******* 1.01b End *********
            mProportionsArray(I).Move = bMove
            mProportionsArray(I).Resize = bResize
            mProportionsArray(I).AdjustFont = bAdjustFont
            '******* 1.02 Start *******
            mProportionsArray(I).Truncate = bTruncate
            '******* 1.02 End *********
        End If
    Next I
            
End Sub

Open in new window

0
 

Author Closing Comment

by:avalonwgi
ID: 40576704
I will use this example to see if I can get something going.  Thanks.
0
 
LVL 46

Expert Comment

by:Martin Liss
ID: 40576713
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014
0

Featured Post

Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Put text in a picture ASP.NET C# 2 57
Copy a row 12 62
How to hault or freeze parent form when a 2d form is open in vb6 3 37
Adjust the position 3 60
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
When we want to run, execute or repeat a statement multiple times, a loop is necessary. This article covers the two types of loops in Python: the while loop and the for loop.
The goal of the tutorial is to teach the user how to use functions in C++. The video will cover how to define functions, how to call functions and how to create functions prototypes. Microsoft Visual C++ 2010 Express will be used as a text editor an…
The viewer will learn how to use the return statement in functions in C++. The video will also teach the user how to pass data to a function and have the function return data back for further processing.

770 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