Proportion an Image to Fit within a Form

in Visual Basic®

by Rick Meyer

Home

The Image Control has a Stretch property that allows you to place any size picture within it. However this will lead to distortion if the height to width ratio of the picture is not the same as the control.

This demo shows how to proportionally fit a picture that is larger than the Form (container) so that the largest possible picture will be shown in the Form.

If the picture is not larger than the Form, the actual size is used and it is centered in the Form.

The Picture Control does not have a Stretch property.

  Instructions for Building this Project:

1. Start a new standard exe.
2. On Form1 put an Imagebox named Image1.
3. In Project->Components add Microsoft CommonDialog Control
4. On Form1 put a CommonDialog named CommonDialog1.

There is no need to position or size the above controls.
You may size the Form as desired.

When you run the program, click on the Form to bring up the Common Dialog window. You will then be able to choose a picture file to view. Click again to load another picture.
Now you are ready for the code. Select all of the following code (by clicking on the word 'Option' three times) and copy it to the clipboard [Ctrl][Insert]. Then paste it into the code window of Form1 with [Shift][Insert]. Variable Key
% As Integer
& As Long
! As Single
# As Double
$ As String 
Option Explicit

Private Sub ShowPic(picfile$)
    Dim cp$, fh!, fw!, ph!, pw!
    Dim reread As Boolean
    
    On Error GoTo sp1
    
    fw = ScaleWidth
    fh = ScaleHeight
    
    With Image1
        .Visible = False
        .Move 0, 0, fw, fh
        Set .Picture = LoadPicture(picfile)
    
        ph = Fix(ScaleY(.Picture.Height, _
                    vbHimetric, vbTwips))
        pw = Fix(ScaleX(.Picture.Width, _
                    vbHimetric, vbTwips))
        cp = "  Actual " & picSize(pw, ph)
    
        If pw > fw Then
            If ph > fh Then
                'both dimensions > container
                If (pw / fw) > (ph / fh) Then
                    'if the ratio of the
                    'width > ratio of height
                    'then we need to limit
                    'the image height to
                    'maintain proportion
                    .Height = ph * fw / pw
                Else
                    'vice versa
                    .Width = pw * fh / ph
                End If
            Else
                'just the width > container
                .Height = ph * fw / pw
            End If
            reread = True
        ElseIf ph > fh Then
            'just the height > container
            .Width = pw * fh / ph
            reread = True
        Else
            'image will fit in container
            '  without change
            .Height = ph
            .Width = pw
        End If
    
        ph = .Height: pw = .Width
    
        'Center the image in the frame
        If ph < fh Then .Top = (fh - ph) / 2
        If pw < fw Then .Left = (fw - pw) / 2
    
        If reread Then
            Set .Picture = LoadPicture(picfile)
            cp = cp & "  Shown " & picSize(pw, ph)
        End If
        
        .Visible = True
    End With
    
    Caption = picfile & cp
    GoTo sp2
    
sp1: Resume sp2
sp2: On Error GoTo 0
End Sub

Private Function picSize$(w!, h!)
    picSize = CStr(Fix(w / 15 + 0.5)) & "W x " & _
                CStr(Fix(h / 15 + 0.5)) & "H"
End Function

Private Sub Image1_Click()
    Form_Click
End Sub

Private Sub Form_Click()
    Const FLTR = "Pictures|*.jpg*;*.jpeg*;" & _
                    "*.gif*;*.bmp;*.ico"
    On Error GoTo er1
    
    With CommonDialog1
        .CancelError = True
        .Filter = FLTR
        .ShowOpen
        ShowPic .filename
    End With
    
    GoTo er2
    
er1: Resume er2
er2: On Error GoTo 0
End Sub

Private Sub Form_Load()
    Image1.Stretch = True
End Sub