• Home
 · 
• Graphics
 · 
• Fits and centers an image on a form.

Fits and centers an image on a form.

Fits and centers an image on a form.

API Declarations


' You need a form called Form1 with an image control called Image1
' Modify the argument to loadImage in the Form_Load() method with
' an existing file and press f5



Rate Fits and centers an image on a form.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Private Sub Form_Load()

  ScaleMode = vbPixels
  BackColor = vbBlack

  loadImage "c:\MyJpeg.jpg"

End Sub

Private Sub Form_Resize()

  fitImage

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = KeyCodeConstants.vbKeyEscape Then
    Unload Me
  End If
End Sub

Private Sub loadImage(imageFile As String)
On Error Resume Next

  Image1.Picture = LoadPicture(imageFile)
  fitImage

If Err.Number Then
  MsgBox _
    Err.Source & ".loadImage()" & vbLf & _
    Err.Description, _
    vbApplicationModal + vbMsgBoxSetForeground, _
    "Error " & Err.Number
End If
End Sub

Private Function getWidth() As Single
  If BorderStyle = vbSizable Then
    getWidth = Abs((Width - 8 * Screen.TwipsPerPixelX) / Screen.TwipsPerPixelX)
  Else
    getWidth = Width / Screen.TwipsPerPixelX
  End If
End Function

Private Function getHeight() As Single
  If BorderStyle = vbSizable Then
    ' why 28 ? i have no idea
    getHeight = Abs((Height - 28 * Screen.TwipsPerPixelY) / Screen.TwipsPerPixelY)
  Else
    getHeight = Height / Screen.TwipsPerPixelY
  End If
End Function

Private Sub fitImage()
On Error GoTo ERR_HANDLE

  Dim w As Single, h As Single, sw As Single, sh As Single
  Dim rw As Single, rh As Single
  Dim r As Single
  Dim b As Boolean

  sw = getWidth()
  sh = getHeight()

  w = Image1.Width
  h = Image1.Height

  rw = sw / w
  rh = sh / h

  ' box
  If (w = h) Then

    r = IIf(sh < sw, rh, rw)

  ' landscape
  ElseIf (w > h) Then

    r = IIf(h * rw > sh, rh, rw)

  ' portrait
  Else

    r = IIf(w * rh > sw, rw, rh)

  End If

  w = w * r
  h = h * r

  Image1.Move (sw - w) * 0.5, (sh - h) * 0.5, w, h
  Image1.Stretch = True
EXIT_HANDLE:

Exit Sub

ERR_HANDLE:
  If Err.Number <> 5 Then
    MsgBox _
      Err.Description, _
      vbApplicationModal + vbMsgBoxSetForeground, _
      "Error #" & Err.Number
  End If
  Err.Clear
  GoTo EXIT_HANDLE

End Sub

' end form code