Resize pic file to a predetermined size

[josephine]

hello all,

my user provides me (the application) with a picture file (jgp/bmp/Etc.).
size = 250x400pxl.

i then need to resize the picture file to a smaller size (!), i.e., make it into a 38x61pxl size. while keeping the right ratio & resolution...
as target size is not very big, i cant afford distortion of picture.


Thanks in advance for any ideas, suggestions, or help references.

gooday,
j.

[mayurvb]

Check StretchBlt API.
I have a sub:
Sub thumbnail(Width As Integer, Height As Integer, Source As PictureBox, dest As PictureBox)
Source.Parent.ScaleMode = vbPixels
dest.Parent.ScaleMode = vbPixels
Source.ScaleMode = vbPixels
dest.ScaleMode = vbPixels
dest.Cls
StretchBlt dest.hDC, 0, 0, dest.ScaleWidth, dest.ScaleHeight, Source.hDC, 0, 0, Source.ScaleWidth, Source.ScaleHeight, SRCCOPY

End sub

[mayurvb]

So, load the Source piture box with your file.
Make the dest picture box of the desired size

[josephine]

tnx 4 your time in replying.

4 some reason i get "variable not defined" msg, relating to SRCCOPY parameter in thumbnail sub.
is there a reference needed?
am i missin something?

[mayurvb]

Declare this:
Public Const SRCCOPY As Long = &HCC0020

[josephine]

have declared...
now i have a "sub or function not defined" message regarding StretchBlt

now?

[Harsh Gupta]

just modified mayur's code a little bit at the highlighted part:

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long _
                                                , ByVal nSrcHeight As Long _
                                                , ByVal dwRop As Long) As Long
                                                
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
 
Sub thumbnail(Width As Integer, Height As Integer, Source As PictureBox, dest As PictureBox)
Source.Parent.ScaleMode = vbPixels
dest.Parent.ScaleMode = vbPixels
Source.ScaleMode = vbPixels
dest.ScaleMode = vbPixels
dest.Cls
StretchBlt dest.hdc, 0, 0, [hl]Width[/hl], [hl]Height[/hl], Source.hdc, 0, 0, Source.ScaleWidth, Source.ScaleHeight, SRCCOPY
 
End Sub
 
Private Sub Command1_Click()
thumbnail 38, 61, Picture1, Picture2
End Sub

[moeur]

Here is another way without using APIs.

Sub ReduceSize(OrigFile As String, BMPFile As String, xWidth As Long, yHeight As Long)
Dim AspectRatio As Single
 
    With Picture1
        .AutoRedraw = True
        .AutoSize = False
        .BorderStyle = 0
        .ScaleMode = vbPixels
        .Parent.ScaleMode = vbPixels
        .AutoSize = True
    
        'load original picture
        'assumes OrigFile is path to picture
        .Picture = LoadPicture(OrigFile)
    
        DoEvents
    
        'resize to your new size
        'assumes xWidth and yHeight contain new size
        'maintains aspect ratio
        AspectRatio = .Width / .Height
    
        If AspectRatio > 1 Then
            .Width = xWidth
            .Height = xWidth / AspectRatio
        Else
            .Height = yHeight
            .Width = yHeight * AspectRatio
        End If
    
        'this takes the place of StretchBlt
        .PaintPicture .Picture, 0, 0, .Width, .Height
 
        'save file to new bmp file
        'Assumes BMPFile contains name of destination file
        SavePicture .Image, BMPFile
    End With
 
End Sub

[josephine]

answers::

1st, thanks so much for your time in replying guys!

unfortunatelly all the above methods of resizing the picture cause distortion of the original file.

attached "target.jpg", is the result of both API and PaintPicture resizing methods.
while "Dunhill_button_red_20s_small.jpg" is an ACDSee genereted resized copy.

you can see the difference.

i think maybe (if its possible at all) i need to include within my VB App an external exe of a picture editing software, (e,g,. AcDSee).
which will handle picture resizing.

doable?

kind regards,
josephine.

[mayurvb]

check this code:
http://www.freevbcode.com/ShowCode.Asp?ID=4997

It is excellent!