Resize picture and keep ratio

I have a picturebox on a form. I want to know how I can detect if the picture is larger than the picturebox, then resize it if needed.

Here is the code that I am using to detect if the picture is larger. It doesn't work. It resizes even if the picture is smaller. I don't understand why.

Code:

---

If thepic.Picture.Height > thepic.Height Or thepic.Picture.Width > thepic.Width Then ...

---

Here is the sub I am using to resize the picture. It works, but it does not keep the ratio of the picture.

Code:

---

Private Sub ScalePic(handle As PictureBox)
With handle
    .ScaleMode = 3
    .AutoRedraw = True
    .PaintPicture .Picture, _
    0, 0, .ScaleWidth, .ScaleHeight, _
    0, 0, .Picture.Width / 26.46, _
    .Picture.Height / 26.46
    .Picture = handle.Image
End With
End Sub

---

Quote:

---

Originally Posted by veebee123

Here is the code that I am using to detect if the picture is larger. It doesn't work. It resizes even if the picture is smaller. I don't understand why.

Code:

---

If thepic.Picture.Height > thepic.Height Or thepic.Picture.Width > thepic.Width Then ...

---

---

Perhaps the problem lies in your definition of "smaller". After all, your
If..Then statement has an Or clause. Could it be that one
of the two parts (height or width) is greater than, hence the branch
is entered (even though you sense that it is "smaller") ?

Does that branch work properly when both dimensions of the pic
are larger than the PB (hence, the pic gets resized) ?

Spoo

Here is a test project to try out:

Code:

---

Option Explicit

Public Sub ScalePicture(PB As PictureBox)
    Dim lngHeightB As Long, lngWidthB As Long
    Dim lngHeightP As Long, lngWidthP As Long
    Dim lngNewHeight As Long, lngNewWidth As Long
    With PB
        PB.ScaleMode = vbPixels
        lngWidthB = PB.ScaleWidth
        lngWidthP = PB.ScaleX(.Picture.Width, vbHimetric, vbPixels)
        lngHeightB = PB.ScaleHeight
        lngHeightP = PB.ScaleY(.Picture.Height, vbHimetric, vbPixels)
        .Cls
        If (lngWidthB < lngWidthP) Or (lngHeightB < lngHeightP) Then
            If (lngWidthP >= lngHeightP) Then
                lngNewWidth = lngWidthB
                lngNewHeight = (lngHeightP / lngWidthP) * lngWidthB
            Else
                lngNewWidth = (lngWidthP / lngHeightP) * lngHeightB
                lngNewHeight = lngHeightB
            End If
            If lngNewWidth > lngWidthB Then
                lngNewWidth = lngWidthB
                lngNewHeight = (lngHeightP / lngWidthP) * lngWidthB
            ElseIf lngNewHeight > lngHeightB Then
                lngNewWidth = (lngWidthP / lngHeightP) * lngHeightB
                lngNewHeight = lngHeightB
            End If
            .PaintPicture .Picture, 0, 0, lngWidthB, lngHeightB, 0, 0, 1, 1, vbSrcCopy
            .PaintPicture .Picture, 0, 0, lngNewWidth, lngNewHeight, 0, 0, lngWidthP, lngHeightP, vbSrcCopy
        End If
        .Refresh
    End With
End Sub

Private Sub Form_Load()
    Picture1.AutoRedraw = True
End Sub

Private Sub Form_Resize()
    If WindowState <> vbMinimized Then Picture1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub Picture1_Resize()
    ScalePicture Picture1
End Sub

---

You must of course place a picture to the picture box before running the code.

In order to compare the Height/Width properties of the PictureBox and the Picture, you need to ensure they are using the same unit of measurement.

The values of the PictureBox.Picture.Height/Width properties are in HiMetric units.

For comparison, use the values of the PictureBox.ScaleHeight/ScaleWidth properties which are in the ScaleMode of the PictureBox.

Code:

---

    Dim lngHeight As Long
    Dim lngWidth As Long
   
    lngHeight = Picture1.ScaleY(Picture1.Picture.Height, vbHimetric, Picture1.ScaleMode)
    lngWidth = Picture1.ScaleX(Picture1.Picture.Height, vbHimetric, Picture1.ScaleMode)
   
    If lngHeight > Picture1.ScaleHeight Or lngWidth > Picture1.ScaleWidth Then

---

Here is a similar code i did some time ago for this:
http://www.vbforums.com/showpost.php...56&postcount=2

I am using Merri's scalepicture sub and it seems to be working fine. The picture size detection by brucevde is not working. If I load one picture that is larger, and after that load one that is smaller, it tells me the picture is larger when it is not.

Here is the code I am using to load the picture:

Code:

---

Private Sub loadfile_Click()
Dim yorn As Integer
Dim lngHeight As Long
Dim lngWidth As Long
lngHeight = thepic.ScaleY(thepic.Picture.Height, vbHimetric, thepic.ScaleMode)
lngWidth = thepic.ScaleX(thepic.Picture.Height, vbHimetric, thepic.ScaleMode)
With comdlg
    .DialogTitle = "Open Picture File"
    .Filter = "Bitmap (*.bmp)|*.bmp|JPG (*.jpg)|*.jpg|GIF (*.gif)|*.gif|All Files (*.*)|*.*|"
    .Flags = cdlOFNHideReadOnly
    .ShowOpen
    If Len(.FileName) <> 0 Then
        thepic.Picture = LoadPicture(.FileName)
        If lngHeight > thepic.ScaleHeight Or lngWidth > thepic.ScaleWidth Then
            yorn = MsgBox("The picture you selected is larger than the picture box. Would you like it resized?", vbQuestion + vbYesNo, "Picture too large")
            If yorn = vbYes Then
                ScalePicture thepic 'Calls Merri's Sub
            Else
                MsgBox "The picture's size won't be changed.", vbInformation, "Not changed"
            End If
        End If
    End If
End With
End Sub

---

I uploaded the project I am testing it with (not the actual project I am using it in).

Quote:

---

lngWidth = Picture1.ScaleX(Picture1.Picture.Height, vbHimetric, Picture1.ScaleMode)

---

The code should have been Picture1.Picture.Width

I changed that but it still doesn't work.

try this:

Code:

---

Private Sub ScalePic(handle As PictureBox)
With handle
    .AutoRedraw = True
    If .Width > .Height Then
        .PaintPicture .Picture, 0, 0, .ScaleHeight * .Picture.Width _
            / .Picture.Height, .ScaleHeight
    Else
      .PaintPicture .Picture, 0, 0, .ScaleWidth, .ScaleWidth * _
            .Picture.Height / .Picture.Width
    End If
    .Refresh
End With
End Sub

---

Scalemode is not an issue. (That's what she said) Paintpicture compensates for that. The issue is ratios and scaling (cross-multiplication).

The scalepic sub works fine. The problem is with the size detection. Download the test program I uploaded on my previous post. Open a picture that is bigger than the picturebox, it won't ask if you want to resize. Then open a picture that is smaller, it will ask. That is the problem.

This is the part that is not working correctly.

Code:

---

Private Sub loadfile_Click()
Dim yorn As Integer
Dim lngHeight As Long
Dim lngWidth As Long
lngHeight = thepic.ScaleY(thepic.Picture.Height, vbHimetric, thepic.ScaleMode)
lngWidth = thepic.ScaleX(thepic.Picture.Height, vbHimetric, thepic.ScaleMode)
With comdlg
    .DialogTitle = "Open Picture File"
    .Filter = "Bitmap (*.bmp)|*.bmp|JPG (*.jpg)|*.jpg|GIF (*.gif)|*.gif|All Files (*.*)|*.*|"
    .Flags = cdlOFNHideReadOnly
    .ShowOpen
    If Len(.FileName) <> 0 Then
        thepic.Picture = LoadPicture(.FileName)

        'THE COMPUTER ENTERS THIS IF STATEMENT EVEN IF THE PICTURE IS SMALLER WHY?????????????

        If lngHeight > thepic.ScaleHeight Or lngWidth > thepic.ScaleWidth Then
            yorn = MsgBox("The picture you selected is larger than the picture box. Would you like it resized?", vbQuestion + vbYesNo, "Picture too large")
            If yorn = vbYes Then
                ScalePicture thepic 'Calls Merri's Sub
            Else
                MsgBox "The picture's size won't be changed.", vbInformation, "Not changed"
            End If
        End If
    End If
End With
End Sub

---

Oh that's all, that's because your asking the size of the picture before you load it. Try loading first then setting lngHeight & lngWidth

And there is always:

Code:

---

Private Sub LoadScaled(ByVal Pic As PictureBox, ByVal FileName As String)
    Dim ImgFile As WIA.ImageFile
    Dim ImgProc As WIA.ImageProcess
    Dim SavedMode As Integer
   
    With Pic
        SavedMode = .ScaleMode
        .ScaleMode = vbPixels
        Set ImgFile = New WIA.ImageFile
        With ImgFile
            .LoadFile FileName
            Set ImgProc = New WIA.ImageProcess
            With ImgProc
                .Filters.Add .FilterInfos!Scale.FilterID
                With .Filters(1).Properties
                    !PreserveAspectRatio = True
                    !MaximumWidth = Pic.ScaleWidth
                    !MaximumHeight = Pic.ScaleHeight
                End With
                Set Pic.Picture = .Apply(ImgFile).FileData.Picture
            End With
        End With
        .ScaleMode = SavedMode
    End With
End Sub

---

You can also use PaintPicture to center the image if desired of course.

Quote:

---

Originally Posted by technorobbo

Oh that's all, that's because your asking the size of the picture before you load it. Try loading first then setting lngHeight & lngWidth

---

Thanks. I don't know why I didn't think of that.