resize image box or picture box?

[redshirtme]

Is there any way to load a picture(.jpg file) to picture/image box and resize it proportionally? (the scale of length/width remains the same as orginal picture)


thanks

[RhinoBull]

You may use either Image control with Stretch = True or use sample below for Picturebox.
Also KIM that image might not be as of original quality.

Public Sub ZoomPicture(pct As PictureBox, zoom As Double)
    With pct
        .Width = .Width * zoom
        .Height = .Height * zoom
        .PaintPicture .Picture, 0, 0, .ScaleWidth, .ScaleHeight
    End With
End Sub

Ratio (zoom level) should be calculated based on original versus new size:

OriginalWidth / NewWidth or something like that.

[redshirtme]

thanks,
but I tried this sample, why is that the original image is obviously the different shape(one is square which means the width and height are same,the other one is very narrow), but after resize they all come up with same size/shape as my picture box, with a little distorted

[RhinoBull]

As I said image will be distorted ... Try this another quick sample and let me know if it works for you:

Private Sub Command1_Click()
'============================
Dim pctTemp As PictureBox
Dim blnHigher As Boolean
Dim dRatio As Double
 
    Set pctTemp = Controls.Add("VB.Picturebox", "picTemp")
    pctTemp.AutoSize = True
    pctTemp.Visible = False
    pctTemp.Picture = LoadPicture("C:\My Documents\Images\JPG\someimage.jpg")
    
    blnHigher = IIf(pctTemp.Height > pctTemp.Width, True, False)
    dRatio = pctTemp.Height / pctTemp.Width
    
    With Picture1
        .AutoRedraw = True
        If blnHigher Then
            .Height = 3000
            .Width = 3000 / dRatio
        Else
            .Width = 3000
            .Height = 3000 * dRatio
        End If
        .PaintPicture pctTemp.Picture, 0, 0, .ScaleWidth, .ScaleHeight
        Set .Picture = .Image
    End With
    
    Controls.Remove "picTemp"
    Set pctTemp = Nothing
 
End Sub