LoadImage() to Fit
It's a single function, without API's, that loads an image and puts it in a destination PictureBox. If the source image is bigger that the destination PictureBox, then it will resized to fit in (mantaining the ratio). In other words, the image loaded will nicely fit the destination, but will not be deformed. If the source is smaller, then it will remain that size... This function is an upgrade (in speed, error trapping and results) of Jason Monroe original post. Thanks Janson.
AI
AI Summary: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.
Source Code
Upload
Option Explicit
Public Function LoadImage(FilePath$, picTemp As PictureBox, picMain As PictureBox, imgMain As Image) As Integer
Dim X As Long
Dim xo As Long
Dim Y As Long
Dim yo As Long
'vars to save the user initial picture boxes and images settings
Dim pMainSM As Integer
Dim pTempSM As Integer
Dim pMainAS As Boolean
Dim pTempAS As Boolean
Dim iMainST As Boolean
'saves the initial conditions of picture boxes and images, for future reposition
pMainSM = picMain.ScaleMode
pMainAS = picMain.AutoSize
pTempSM = picTemp.ScaleMode
pTempAS = picTemp.AutoSize
iMainST = imgMain.Stretch
'set the necessary conditions to picture boxes and image
picMain.ScaleMode = vbTwips
picMain.AutoSize = False
picTemp.ScaleMode = vbTwips
picTemp.AutoSize = True
imgMain.Stretch = True
'while sizing, make destination image invisible
imgMain.Visible = False
On Error Resume Next
picTemp.Picture = LoadPicture(FilePath)
If Err Then 'the image was not loaded, so set the image to blank and exit sub
imgMain.Picture = LoadPicture()
LoadImage = Err 'return the error code
Exit Function
End If
'obtain the loaded image size
xo = picTemp.Width
yo = picTemp.Height
' First shrink the image so the sides fit
If xo > picMain.Width Then
X = picMain.Width
Y = yo - (xo - X)
End If
' if the image is still too tall, shrink it some more
yo = Y
If Y > picMain.Height Then
Y = picMain.Height
X = X - (yo - Y)
End If
'Now we have the X and Y that have the best fit, so set the destination to that size
imgMain.Width = X
imgMain.Height = Y
' Center the image(imgmain) in the main picture box(picmain)
imgMain.Top = (picMain.Height \ 2) - (imgMain.Height \ 2)
imgMain.Left = (picMain.Width \ 2) - (imgMain.Width \ 2)
' Now copy the image from the start picbox(picstart) into the
' display image field (imgmain)
imgMain.Picture = picTemp.Picture
picTemp.Picture = LoadPicture() 'clar the temp picture, because it's not necessary
imgMain.Visible = True 'make the destination visible
'restore the initial user settings
picMain.ScaleMode = pMainSM
picMain.AutoSize = pMainAS
picTemp.ScaleMode = pTempSM
picTemp.AutoSize = pTempAS
imgMain.Stretch = iMainST
LoadImage = 0 'and returns 0, the image was sucessfuly loaded
End Function
Original Comments (3)
Recovered from Wayback Machine