[RESOLVED] Looking for Favor (image resize)

I am looking for a favor here... I am going to sleep soon, and I just can not get this to work....

Can someone write code which will work will work with the following dimensions:

[/quote]Form Height: 15 000
Form Width: 13 000

picture1.height = 12 000
picture1.width = 13 000

1 label with the percentage that it is shrunk or grew.[/quote]

All I want is a picture load into the picture1 and resized accordingly (and give me the percentage of the resize in the label)... Also, I do not want it stretched too much on one side...

If someone could give me this code I would be grateful...

try doing it this way, coding it is something u'll have to do u're self
get the aspect ratio of the image (x:y)
decrease the width of the image to what u want
now decrease the height of the image accrding to the aspect ratio

as for the percentage, %=(newX/oldX)*100

Try this:

VB Code:

Public Sub LoadPic(ByVal sFileName As String)
    Dim pic As StdPicture
    Dim nWidth As Long
    Dim nHeight As Long
    Dim nWidthOrig As Long
    Dim nHeightOrig As Long
    Dim hDiff As Double, wDiff As Double, nDiff As Double
    
    Set pic = LoadPicture(sFileName)
    With Picture1
        .AutoRedraw = True
        nWidthOrig = .ScaleX(pic.Width, vbHimetric, .ScaleMode)
        nHeightOrig = .ScaleY(pic.Height, vbHimetric, .ScaleMode)
        'The picture box width is assumed to be larger then the height
        If nWidthOrig > .ScaleWidth Or nHeightOrig > .ScaleHeight Then
            wDiff = nWidthOrig / .ScaleWidth
            hDiff = nHeightOrig / .ScaleHeight
            nDiff = IIf(wDiff > hDiff, wDiff, hDiff)
        End If
        If nDiff Then
            nWidth = nWidthOrig / nDiff
            nHeight = nHeightOrig / nDiff
            Label1.Caption = "Ratio: " & (nWidth / nWidthOrig) * 100
        End If
        .Cls
        .PaintPicture pic, (.ScaleWidth - nWidth) \ 2, _
         (.ScaleHeight - nHeight) \ 2, _
         nWidth, nHeight, , , , , vbSrcCopy
    End With
End Sub

VB Code:

Public Sub LoadPic(ByVal sFileName As String)
    Dim pic As StdPicture
    Dim nWidth As Long
    Dim nHeight As Long
    Dim nWidthOrig As Long
    Dim nHeightOrig As Long
    Dim hDiff As Double, wDiff As Double, nDiff As Double
        Set pic = LoadPicture(sFileName)
    With Picture1
        .AutoRedraw = True
        nWidthOrig = .ScaleX(pic.Width, vbHimetric, .ScaleMode)
        nHeightOrig = .ScaleY(pic.Height, vbHimetric, .ScaleMode)
        'The picture box width is assumed to be larger then the height
        If nWidthOrig > .ScaleWidth Or nHeightOrig > .ScaleHeight Then
            wDiff = nWidthOrig / .ScaleWidth
            hDiff = nHeightOrig / .ScaleHeight
            nDiff = IIf(wDiff > hDiff, wDiff, hDiff)
        End If
        If nDiff Then
            nWidth = nWidthOrig / nDiff
            nHeight = nHeightOrig / nDiff
            Label1.Caption = "Ratio: " & (nWidth / nWidthOrig) * 100
        End If
        .Cls
        .PaintPicture pic, (.ScaleWidth - nWidth) \ 2, _
         (.ScaleHeight - nHeight) \ 2, _
         nWidth, nHeight, , , , , vbSrcCopy
    End With
End Sub
 
Private Sub Command1_Click()
LoadPic ("C:\Documents and Settings\Chris\Desktop\IMG\sky13.jpg")
End Sub

When I click on the image I get a invalid procedure or call argument.

The following code is in big bright yellow:

VB Code:

.PaintPicture pic, (.ScaleWidth - nWidth) \ 2, _
         (.ScaleHeight - nHeight) \ 2, _
         nWidth, nHeight, , , , , vbSrcCopy

Is the name of your control Picture1? You shoud use Option Explicit to help you find errors.

Yes I have a picture1 and a label1

Where did you paste the code? It should reside in the same Form as you have the Picture1 picturebox in.

I only have one form.... I have a Picture1, Label1 and a Command1

Command1 has:

VB Code:

LoadPic ("C:\Documents and Settings\Chris\Desktop\IMG\sky13.jpg")

The rest of the code was just copy/pasted

And you are using VB6?

yes...6.0.8169

I just put a picturebox, a label and a command button on a Form. In the click event of the command button I call the above procedure and it works just fine.

Can you upload the project then?

Right from the very beginning I had a bad felling this image thing would screw me in at every corner (hence why I quickly gave up on it after 1-2 hours and posted this tread)...

OK, here is my test project.

Quote:

---

Originally Posted by Joacim Andersson

OK, here is my test project.

---

That doesn't give me a error... But it doesnt work when I make the window bigger (I use 2048 by 1536)

Sorry, but I don't understand when you say "it doesn't work when I make the window bigger"??? Do you mean that if you maximize the window and then it doesn't work???

Sry, I was wrong... The bug with that code is if the image is smaller then the picture box it will not be displayed.

Oh yeah... Try this:

VB Code:

Public Sub LoadPic(ByVal sFileName As String)
    Dim pic As StdPicture
    Dim nWidth As Long
    Dim nHeight As Long
    Dim nWidthOrig As Long
    Dim nHeightOrig As Long
    Dim hDiff As Double, wDiff As Double, nDiff As Double
        Set pic = LoadPicture(sFileName)
    With Picture1
        .AutoRedraw = True
        nWidthOrig = .ScaleX(pic.Width, vbHimetric, .ScaleMode)
        nHeightOrig = .ScaleY(pic.Height, vbHimetric, .ScaleMode)
        nWidth = nWidthOrig
        nHeight = nHeightOrig
        'The picture box width is assumed to be larger then the height
        If nWidthOrig > .ScaleWidth Or nHeightOrig > .ScaleHeight Then
            wDiff = nWidthOrig / .ScaleWidth
            hDiff = nHeightOrig / .ScaleHeight
            nDiff = IIf(wDiff > hDiff, wDiff, hDiff)
        End If
        If nDiff Then
            nWidth = nWidthOrig / nDiff
            nHeight = nHeightOrig / nDiff
            Label1.Caption = "Ratio: " & (nWidth / nWidthOrig) * 100
        End If
        .Cls
        .PaintPicture pic, (.ScaleWidth - nWidth) \ 2, _
         (.ScaleHeight - nHeight) \ 2, _
         nWidth, nHeight, , , , , vbSrcCopy
    End With
End Sub

Tnx man (takes Advil)...

Hopefully Ill finish my application tonight.

Quote:

---

Originally Posted by Joacim Andersson

Oh yeah... Try this:

VB Code:

Public Sub LoadPic(ByVal sFileName As String)
    Dim pic As StdPicture
    Dim nWidth As Long
    Dim nHeight As Long
    Dim nWidthOrig As Long
    Dim nHeightOrig As Long
    Dim hDiff As Double, wDiff As Double, nDiff As Double
        Set pic = LoadPicture(sFileName)
    With Picture1
        .AutoRedraw = True
        nWidthOrig = .ScaleX(pic.Width, vbHimetric, .ScaleMode)
        nHeightOrig = .ScaleY(pic.Height, vbHimetric, .ScaleMode)
        nWidth = nWidthOrig
        nHeight = nHeightOrig
        'The picture box width is assumed to be larger then the height
        If nWidthOrig > .ScaleWidth Or nHeightOrig > .ScaleHeight Then
            wDiff = nWidthOrig / .ScaleWidth
            hDiff = nHeightOrig / .ScaleHeight
            nDiff = IIf(wDiff > hDiff, wDiff, hDiff)
        End If
        If nDiff Then
            nWidth = nWidthOrig / nDiff
            nHeight = nHeightOrig / nDiff
            Label1.Caption = "Ratio: " & (nWidth / nWidthOrig) * 100
        End If
        .Cls
        .PaintPicture pic, (.ScaleWidth - nWidth) \ 2, _
         (.ScaleHeight - nHeight) \ 2, _
         nWidth, nHeight, , , , , vbSrcCopy
    End With
End Sub

---

hi joacim,

your code works well. i currently need help from the similar senario. your code work perfectly when i insert a huge file and it load beatifully in to teh picturebox .how can i rescale a smaller image to fit the picturebox(stretching of smaller image to fit a bigger picture box?

???
ocw