• Home
 · 
• Custom Controls/Forms/Menus
 · 
• Image Resizing

Image Resizing

To automatically resize an image control in a frame control to view at an acceptable size. The full image is on screen even if the image is bigger than the screen.

Inputs
n/a

Assumes
What an Image and Frame control is. How pixels and functions work.

Returns
n/a

Side Effects
n/a

API Declarations
n/a

Rate Image Resizing

• 1
• 2
• 3
• 4
• 5

(38(38 Vote))

Option Explicit
Public Sub PicShow(ByVal PixPath As String, fForm As Form)
On Error GoTo noshow
Dim dHeight, dIHeight
Dim dWidth, dIWidth
Dim dPercent
With fForm
  .ViewImage.Visible = False
  .ViewImage.Stretch = False
  .Caption = App.Title & " - " & UCase(PixPath)
  .ViewImage.Picture = LoadPicture(PixPath)
    If .ViewImage.Height < .PicBack.Height And .ViewImage.Width < .PicBack.Width Then
      .ViewImage.Visible = True
      Exit Sub
    End If
  dHeight = .ViewImage.Height
  dWidth = .ViewImage.Width
  dIHeight = .PicBack.Height - 1
  dIWidth = .PicBack.Width - 1
  .ViewImage.Stretch = True
  .ViewImage.Height = .PicBack.Height - 2
  dPercent = (.PicBack.Height - 2) / dHeight * 100
  .ViewImage.Width = dWidth / 100 * dPercent
    If .ViewImage.Width > (.PicBack.Width - 2) Then
      .ViewImage.Stretch = False
      dHeight = .ViewImage.Height
      dWidth = .ViewImage.Width
      dIHeight = .PicBack.Height - 1
      dIWidth = .PicBack.Width - 1
      .ViewImage.Stretch = True
      .ViewImage.Width = .PicBack.Width - 1
      dPercent = (.PicBack.Width - 1) / dWidth * 100
      .ViewImage.Height = dHeight / 100 * dPercent
    End If
  .ViewImage.Visible = True
  MidPic frmMain2000
End With
Exit Sub
noshow:
Resume noshow1
noshow1:
End Sub
Public Sub MidPic(ByVal fForm As Form)
  fForm.ViewImage.Move (fForm.PicBack.Width - fForm.ViewImage.Width) / 2, (fForm.ViewImage.Height - fForm.ViewImage.Height) / 2
End Sub
'How to call the function
Call PicShow("c:\image.jpg", frmName)