Solved

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

Posted on 2015-01-28
6
165 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 69

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 45

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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 45

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 45

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

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

How to remove superseded packages in windows w60 or w61 installation media (.wim) or online system to prevent unnecessary space. w60 means Windows Vista or Windows Server 2008. w61 means Windows 7 or Windows Server 2008 R2. There are various …
Go is an acronym of golang, is a programming language developed Google in 2007. Go is a new language that is mostly in the C family, with significant input from Pascal/Modula/Oberon family. Hence Go arisen as low-level language with fast compilation…
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.
This video will show you how to get GIT to work in Eclipse.   It will walk you through how to install the EGit plugin in eclipse and how to checkout an existing repository.

708 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now