VB6: Resizing Images

[Lost.Prophet]

I am having trouble getting images to fit inside either an image box or a picture box. I want to scale the picture to fit in side the box, without distortion. I found a post here that suggested a subroutine, but I this appeared to do nothin when the picture was loaded. Can anyone help? having an imagebox inside a picturebox, I used this code:

Private Sub SetImageBoxSize (ImageBox As Image, _
Optional ImageReductionA mount As Long = 0)
Dim ParentRatio As Single
Dim PictureRatio As Single
Dim ContainerWidth As Single
Dim ContainerHeight As Single
Dim ContainerContro l As Control
With ImageBox
.Visible = False
PictureRatio = .Width / .Height
On Error Resume Next
ContainerWidth = .Container.Scal eWidth
If Err.Number Then
ContainerWidth = .Container.Widt h
ContainerHeight = .Container.Heig ht
Else
ContainerHeight = .Container.Scal eHeight
End If
ParentRatio = ContainerWidth / ContainerHeight
If ParentRatio < PictureRatio Then
.Width = ContainerWidth - 2 * ImageReductionA mount
.Height = .Width / PictureRatio
Else
.Height = ContainerHeight - 2 * ImageReductionA mount
.Width = .Height * PictureRatio
End If
.Move (ContainerWidth - .Width) \ 2, _
(ContainerHeigh t - .Height) \ 2
.Visible = True
End With
End Sub

It resizes the image box to a correct ratio, but the picture inside stays at it's full size so you only see part of it.

[Pragash]

in my computer don't have vb so i could check this code but u can check this.
but if u understand the concept u can easly correct it.


image box name is "img"
picture box name is "pic"
commond button name is "cmd"
place the image control into picturebox and change the image control streach property to true.

Private Sub cmd_Click()
img.width = img.picture.wid th
img.height = img.picture.hei ght
if pic.width < img.width then
img.width = pic.width
img.height = img.height/(img.picture.wi dth/img.width)
end if

if pic.height < img.height then
img.height = pic.height
img.width = img.width/(img.picture.he ight/img.height)
end if
img.left = 0
img.top = 0
End Sub

[BowlandHack]

in my computer don't have vb so i could check this code but u can check this.
but if u understand the concept u can easly correct it.


image box name is "img"
picture box name is "pic"
commond button name is "cmd"
place the image control into picturebox and change the image control streach property to true.

Private Sub cmd_Click()
img.width = img.picture.wid th
img.height = img.picture.hei ght
if pic.width < img.width then
img.width = pic.width
img.height = img.height/(img.picture.wi dth/img.width)
end if

if pic.height < img.height then
img.height = pic.height
img.width = img.width/(img.picture.he ight/img.height)
end if
img.left = 0
img.top = 0
End Sub

I have tried the following code and it works well...


Public Sub ScaleIMG(PicFle )

' This Sub-routine is designed as a physical add-in module
' {i.e. one which is copied into the parent application}

' PURPOSE
' The purpose of this subroutine is to proportionally scale any pictures
' down to the maximum size of a PictureBox Control inserted on a form,
' whilst maintaining the aspect ratio of the original picture! Pictures
' which are smaller than the PictureBox control are shown at their
' natural size.

' METHODOLOGY
' The Picture filename "PicFle" is derived within the main application
' and passed to this sub-routine as a parameter.

' The main application MUST HAVE:-
' =========

' 1. A Picture Box named <PicScale> on the default form whose
' width & height define the maximum dimensions of any image
' to be displayed.

' 2. An Image Box named <ImgScale> must be drawn WITHIN <PicScale>.
' This Image Box can be of any size and can lie anywhere within
' the Picture Box <PicScale>

' Pictures which are too large for the Picture Box will be scaled down to
' the dimensions of the Picture Box, whilst maintaining the aspect ratio
' of the image. Landscape oriented pictures will be constrained by the
' PicScale Width set at design time and portrait oriented pictures will
' be constrained to the height of PicScale. PicScale's dimensions are
' then changed to match the image being shown.

' Pictures which are smaller than PicScale will be shown at their natural
' size.

' ############### ############### ############### ############### ##############

Static Init, DefH, DefW 'Static variables defined for this sub only

If Init = 0 Then
' ___This is the first time this session that this subroutine has been called
Init = 1 '<< Prevents this "If Then..." statement being called again this session
DefH = PicScale.Height '__ Save Original Picture Box Height at Design time value
DefW = PicScale.Width '__ Save Original Picture Box Width at Design time value
End If

'__ Restore Picture Box's Default Height & Width
PicScale.Height = DefH
PicScale.Width = DefW


'__Load Picture into ImageBox and stretch to it's natural size
ImgScale.Stretc h = False
ImgScale.Pictur e = LoadPicture(Pic Fle)
ImgScale.Stretc h = True

Iw = ImgScale.Width ' Width of picture loaded into Img
Ih = ImgScale.Height ' Height of Picture loaded into Img

Pw = PicScale.Width ' Width of Picture Box
Ph = PicScale.Height ' Height of Picture Box


If Iw > Ih Then
'____ Format = Landscape
Fcr = Pw / Iw ' Scale on width
Else
'____ Format = Square or Portait
Fcr = Ph / Ih ' Scale on height
End If


If Fcr < 1 Then
'__ i.e. The Image is larger than the Picture Box and we must
' shrink it, otherwise we leave it the same size!
ImgScale.Width = ImgScale.Width * Fcr
ImgScale.Height = ImgScale.Height * Fcr
End If


'__Re-assign PictureBox dimensions to fit the image
PicScale.Width = ImgScale.Width
PicScale.Height = ImgScale.Height

'__Position the Top LH corner of the ImageBox
' into the top LH corner of the PictureBox
ImgScale.Left = 0
ImgScale.Top = 0

ImgScale.Visibl e = True


End Sub

[xiogster]

in my computer don't have vb so i could check this code but u can check this.
but if u understand the concept u can easly correct it.


image box name is "img"
picture box name is "pic"
commond button name is "cmd"
place the image control into picturebox and change the image control streach property to true.

Private Sub cmd_Click()
img.width = img.picture.wid th
img.height = img.picture.hei ght
if pic.width < img.width then
img.width = pic.width
img.height = img.height/(img.picture.wi dth/img.width)
end if

if pic.height < img.height then
img.height = pic.height
img.width = img.width/(img.picture.he ight/img.height)
end if
img.left = 0
img.top = 0
End Sub

If img.Width > img.Height Then
img.Width = pic.Width
img.Height = img.Height / (img.Picture.Wi dth / img.Width)

Else
img.Height = pic.Height
img.Width = img.Width / (img.Picture.He ight / img.Height)


End If

img.Left = 0
img.Top = 0