The picture loaded always stays the same. It is loaded into a bitmap and paintet to the image controls "screen" whenever it is refreshed.
If the image control is resized, and stretch is on, then the image from the bitmap is painted bigger or smaller, but the bitmap itself remains unchanged.
Therefore on the first view your task is not too trivial.
I'd say there could be some API calls which you might use...
I have to make changes to the code. The .image returns only the part within the rect of the picturebox so we have to resize the control to our desired picture size. Here's my code that works with any scalemode of the picturebox. It also takes into account if the picturebox has a border.
Code:
Dim pic As StdPicture
Const sizeX As Integer = 200, sizeY As Integer = 200
Set pic = LoadPicture("<SOURCE FILENAME HERE>")
With Picture1
.Width = (sizeX * Screen.TwipsPerPixelX) + .Width - .ScaleX(.ScaleWidth, .ScaleMode, vbTwips)
.Height = (sizeY * Screen.TwipsPerPixelY) + .Height - .ScaleY(.ScaleHeight, .ScaleMode, vbTwips)
.AutoRedraw = True
.Cls
Call .PaintPicture(pic, 0, 0, .ScaleWidth, .ScaleHeight)
.AutoRedraw = False
Call SavePicture(.Image, "<DESTINATION FILENAME HERE>")
End With
You can make the picturebox invisible so users won't see it
And even without any extra control because they are made on the go.
the only thing you need is a form thats called frmMain or if you wish you can change that to another name
Code:
Public Function Create_Thumb(sImagePath As String,sDestPath as string, Optional lPixWidth As Long = 95, Optional lPixHeight As Long = 95) As String
Dim iTwipHeight As Long, iTwipWidth As Long
iTwipWidth = ConvertPixelsToTwips(lPixWidth)
iTwipHeight = ConvertPixelsToTwips(lPixHeight, 1)
Dim picTemp As Control, picImage As Control
Set picTemp = frmMain.Controls.Add("vb.picturebox", "picTemp", frmMain)
Set picImage = frmMain.Controls.Add("vb.picturebox", "picImage", frmMain)
picTemp.AutoSize = True
picImage.AutoSize = True
picImage.AutoRedraw = True
picTemp.Picture = LoadPicture(sImagePath)
picImage.Picture = LoadPicture()
If picTemp.Width > iTwipWidth Or picTemp.Height > iTwipHeight Then
Dim cRatio As Currency
picImage.Width = iTwipWidth
picImage.Height = iTwipHeight
If picTemp.Width > picTemp.Height Then
cRatio = picTemp.Width / picImage.Width
Else
cRatio = picTemp.Height / picImage.Height
End If
picImage.Width = picTemp.Width / cRatio
picImage.Height = picTemp.Height / cRatio
picImage.PaintPicture picTemp.Picture, 0, 0, picImage.Width, picImage.Height
picImage.Picture = picImage.Image
Else
picImage.Width = picTemp.Width
picImage.Height = picTemp.Height
picImage.Picture = picTemp.Picture
End If
picImage.Refresh
picTemp.Picture = LoadPicture
frmMain.Controls.Remove "picTemp"
Call SavePicture(picimage.picture,sDestPath)
'-clear data
ClearData:
picImage.Picture = LoadPicture
frmMain.Controls.Remove "picImage"
End Function
* The Best Reasons to Target Windows 8
Learn some of the best reasons why you should seriously consider bringing your Android mobile development expertise to bear on the Windows 8 platform.