[COLOR="DarkGreen"]'This function will resize and center an image frame based on the
'dimensions of any image.[/COLOR]
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
[COLOR="DarkGreen"]'get dimensions of the image frame[/COLOR]
fraLeft = ctl.Left
fraTop = ctl.Top
fraHgt = ctl.Height
fraWdt = ctl.Width
[COLOR="darkgreen"]'get dimensions of the image in the frame[/COLOR]
picHgt = ctl.ImageHeight
picWdt = ctl.ImageWidth
[COLOR="darkgreen"]'get a percent value for the frame and image
'which is based on the dimensions of each[/COLOR]
fra = fraWdt / fraHgt
pic = picWdt / picHgt
[COLOR="darkgreen"]'pics dimensions smaller than entire frame[/COLOR]
If fraHgt > picHgt And fraWdt > picWdt Then
[COLOR="darkgreen"]'resize frame to fit pic[/COLOR]
ctl.Height = picHgt
ctl.Width = picWdt
[COLOR="darkgreen"]'center frame[/COLOR]
ctl.Left = fraLeft + ((fraWdt - picWdt) / 2)
ctl.Top = fraTop + ((fraHgt - picHgt) / 2)
[COLOR="darkgreen"]'pics dimensions taller than frame dimensions[/COLOR]
ElseIf pic < fra Then
[COLOR="darkgreen"]'determine percentage the pic is being reduced[/COLOR]
pct = fraHgt / picHgt
[COLOR="darkgreen"]'calculate the new pic width[/COLOR]
picWdt = picWdt * pct
[COLOR="darkgreen"]'resize frame to fit pic[/COLOR]
ctl.Width = fraWdt - (fraWdt - picWdt)
[COLOR="darkgreen"]'center frame[/COLOR]
ctl.Left = fraLeft + ((fraWdt - picWdt) / 2)
[COLOR="darkgreen"]'pics dimensions wider than frame dimensions[/COLOR]
ElseIf pic > fra Then
[COLOR="darkgreen"]'determine percentage the pic is being reduced[/COLOR]
pct = fraWdt / picWdt
[COLOR="darkgreen"]'calculate the new pic height[/COLOR]
picHgt = picHgt * pct
[COLOR="darkgreen"]'resize frame to fit pic[/COLOR]
ctl.Height = fraHgt - (fraHgt - picHgt)
[COLOR="darkgreen"]'center frame[/COLOR]
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