View Full Version : Resize and Center Image Frame


ssteinke
07-03-2006, 08:57 PM
This example shows a way to Resize and Center the image frame to fit the image regardless of the image size. Images larger than the frame will be reduced to fit the frame. Images smaller than the frame will remain their normal size. Simply call the function named fResizeImageFrame().

This also provides a way to apply a border to your pictures at runtime.

You must link to a picture in the image frame in order to use this example.

Scott

EDIT: See below for corrected code

CharlesWilliams
07-06-2006, 06:18 AM
:) Could I get a MS Access 2000 version please? :)

ssteinke
07-06-2006, 06:59 AM
here ya go

EDIT: See below for corrected code

ssteinke
07-06-2006, 02:45 PM
The posted sample works fine for a perfectly square image frame, however, it was pointed out that when a frame is wider than an image that is also wide, the function causes the picture to be adjusted outside the boundary of the frame instead of the frame adjusting to the picture.

The following code fixes the issue by calculating a dimensional percentage of the frame and picture and then comparing the two, essentially giving the desired effect of the frame adjusting to the picture, regardless of the size of either.

THIS IS THE CORRECTED CODE:

'This function will resize and center an image frame based on the
'dimensions of any image.
Public Function fResizeImageFrame(ctl As Control)
On Error GoTo Err_fResizeImageFrame

Dim fraLeft As Integer
Dim fraTop As Integer
Dim fraHgt As Integer
Dim fraWdt As Integer
Dim picHgt As Integer
Dim picWdt As Integer
Dim pct As Double
Dim fra As Double
Dim pic As Double

'get dimensions of the image frame
fraLeft = ctl.Left
fraTop = ctl.Top
fraHgt = ctl.Height
fraWdt = ctl.Width

'get dimensions of the image in the frame
picHgt = ctl.ImageHeight
picWdt = ctl.ImageWidth

'get a percent value for the frame and image
'which is based on the dimensions of each
fra = fraWdt / fraHgt
pic = picWdt / picHgt

'pics dimensions smaller than entire frame
If fraHgt > picHgt And fraWdt > picWdt Then
'resize frame to fit pic
ctl.Height = picHgt
ctl.Width = picWdt
'center frame
ctl.Left = fraLeft + ((fraWdt - picWdt) / 2)
ctl.Top = fraTop + ((fraHgt - picHgt) / 2)
'pics dimensions taller than frame dimensions
ElseIf pic < fra Then
'determine percentage the pic is being reduced
pct = fraHgt / picHgt
'calculate the new pic width
picWdt = picWdt * pct
'resize frame to fit pic
ctl.Width = fraWdt - (fraWdt - picWdt)
'center frame
ctl.Left = fraLeft + ((fraWdt - picWdt) / 2)
'pics dimensions wider than frame dimensions
ElseIf pic > fra Then
'determine percentage the pic is being reduced
pct = fraWdt / picWdt
'calculate the new pic height
picHgt = picHgt * pct
'resize frame to fit pic
ctl.Height = fraHgt - (fraHgt - picHgt)
'center frame
ctl.Top = fraTop + ((fraHgt - picHgt) / 2)
End If

Exit_fResizeImageFrame:
Exit Function
Err_fResizeImageFrame:
MsgBox Err.Description, vbCritical, "Error " & Err.Number
Resume Exit_fResizeImageFrame
End Function

To Call:
Call fResizeImageFrame(Me.ImageFrameName)