1 Attachment(s)
[RESOLVED] Resize image proportionally?
hi
I have the following simple form which allows the user to select and view an image. However currently all images are set to stretch to fit the space given. I want to be able to resize the image in proportion to fit inside the space.
Any help would be great.
Here's the code:
Code:
Private Sub Dir1_Change()
File1.Path = Dir1.Path 'Update files.
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive 'Update directory path.
End Sub
Private Sub File1_Click()
If Right(File1.Path, 1) <> "\" Then
Label1.Caption = File1.Path & "\" & File1.FileName
Else 'If root directory
Label1.Caption = File1.Path & File1.FileName
End If
frmPhoto.Open.Picture = LoadPicture(Label1.Caption)
End Sub
Private Sub cmdSave_Click()
If Right(File1.Path, 1) <> "\" Then
pic = File1.Path & "\" & File1.FileName
Else 'If root directory
pic = File1.Path & File1.FileName
End If
frmEmployee.txtPhoto.Text = pic
'-----Add notice to lblNotice on frmMain
frmMain.lblNotice.Caption = ""
frmMain.lblNotice.Caption = "Photo Added"
Unload Me
End Sub
edit: vbcode tags not working for some reason
... and the form:
Re: Resize image proportionally?
add an invisible Picture box to your form and fill the image in this form.
Then, using BitBlt, transform the image from the invisble picture box to your Open picture box
Re: Resize image proportionally?
Sorry, forgot to mention, BitBlt is an Win32 API function.
Public Declare Function BitBlt Lib "gdi32.dll" ( _
ByVal hDestDC As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Re: Resize image proportionally?
So how exactly do I put that into the above code? (I'm a bit of a noob at VB)
Re: Resize image proportionally?
Is that the simplest way (the bitblt thing) while still being reasonably fast? ... still not sure how to use it though, any help?
Re: Resize image proportionally?
Just used a simple thing:
VB Code:
Private Sub File1_Click()
If Right(File1.Path, 1) <> "\" Then
txtPath.Text = File1.Path & "\" & File1.FileName
Else 'If root directory
txtPath.Text = File1.Path & File1.FileName
End If
On Error GoTo handleit
frmPhoto.Open.Stretch = False
frmPhoto.Open.Picture = LoadPicture(txtPath.Text)
If frmPhoto.Open.Height >= 4875 Or frmPhoto.Open.Width >= 7600 Then
Do While frmPhoto.Open.Height >= 4875 Or frmPhoto.Open.Width >= 7600
frmPhoto.Open.Height = frmPhoto.Open.Height * 0.95
frmPhoto.Open.Width = frmPhoto.Open.Width * 0.95
Loop
frmPhoto.Open.Stretch = True
End If
frmPhoto.Open.Left = (Frame1.Width - frmPhoto.Open.Width) \ 2
frmPhoto.Open.Top = (Frame1.Height - frmPhoto.Open.Height) \ 2
handleit:
Exit Sub
End Sub