ImageResize




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)

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











( imageresize.html )- by Paolo Puglisi - Modifica del 17/12/2023