Solved

JPEG Compression

Posted on 2004-10-25
6,062 Views
Last Modified: 2013-11-19
Hello experts! I need again your help!

I use the following code to save the contents of a picture box onto a JPG file:

SavePicture Picture1.Image, "C:/image.jpg"

I want to know how to control the compression level (quality) of the JPG file, because the generated one is too big.

I found some examples for VB.NET, but nothing in VB6. I appreciate any help!

Thanks!
0
Question by:HyMaX_2003
    9 Comments
     
    LVL 85

    Expert Comment

    by:Mike Tomlinson
    Hi HyMax_2003,

    I hate to bust your bubble, but the SavePicture() function doesn't save in JPG format.  What you actually have after the operation is a BMP file with a JPG extension (because that is the name you gave it).

    From the remarks on SavePicture():

    If a graphic was loaded from a file to the Picture property of an object, either at design time or at run time, and it’s a bitmap, icon, metafile, or enhanced metafile, it's saved using the same format as the original file. If it is a GIF or JPEG file, it is saved as a bitmap file.

    Graphics in an Image property are always saved as bitmap (.bmp) files regardless of their original format.

    ~IM
    0
     
    LVL 16

    Expert Comment

    by:jimbobmcgee
    I think the SavePicture routine only saves to BMP, despite your filename being .JPG

    You could probably use GDI+ to save to .JPG...
           http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdicpp/gdiplus/gdiplus.asp
    0
     
    LVL 16

    Expert Comment

    by:jimbobmcgee
    IM:

    Beat me to it again...!!

    :)
    0
     
    LVL 85

    Expert Comment

    by:Mike Tomlinson
    Well, at least you gave an alternative solution.

    I was just the bringer of bad news...

    ~IM
    0
     
    LVL 85

    Expert Comment

    by:Mike Tomlinson
    Here is another PAQ with lots of great links and resources on image resizing/manipulation:
    http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_21118795.html

    ~IM
    0
     
    LVL 1

    Author Comment

    by:HyMaX_2003
    OK GDI sounds cool!
    (I'm still laughing with the 'I was just the bringer of bad news...') :)

    This code looks good, but the image is TOO smooth, and the size of the file is still too big:



    '-----
    Form frmMain
    '-----
    Option Explicit

    Dim token As Long ' Needed to close GDI+

    Private Sub Form_Load()
       Dim sFile As String
       ' Load the GDI+ Dll
       Dim GpInput As GdiplusStartupInput
       GpInput.GdiplusVersion = 1
       If GdiplusStartup(token, GpInput) <> Ok Then
          MsgBox "Error loading GDI+!", vbCritical
          Unload Me
       End If
       Me.Show
       sFile = InputBox("Image File", , "D:\_UnicodeScreenShots\UniGrid3.bmp")
       Me.Refresh
       DrawThumbnail sFile, 128, 128 '(BrowseFolder("Select image file"))
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
       ' Unload the GDI+ Dll
       Call GdiplusShutdown(token)
    End Sub


    Private Sub DrawThumbnail(ByVal sFile As String, ByVal lngThumbWidth As Long, ByVal lngThumbHeight As Long)
       
       Dim graphics As Long
       Dim img As Long
       Dim imgThumb As Long
       Dim encoderCLSID As CLSID

       ' Initializations
       GdipCreateFromHDC Me.hdc, graphics  ' Initialize the graphics class - required for all drawing
       GdipLoadImageFromFile StrConv(sFile, vbUnicode), img     ' Load the image
       
       ' Create the thumbnail
       GdipGetImageThumbnail img, lngThumbWidth, lngThumbHeight, imgThumb

       ' Draw the thumbnail image unaltered
       GdipDrawImageRectI graphics, imgThumb, 10, 10, lngThumbWidth, lngThumbHeight
       
       ' Get the CLSID of the PNG encoder
       GetEncoderClsid "image/png", encoderCLSID

       ' Save as a PNG file. There are no encoder parameters for PNG images, so we pass a NULL.
       GdipSaveImageToFile imgThumb, StrConv(App.Path & "\Thumb.png", vbUnicode), encoderCLSID, ByVal 0

       ' Cleanup
       GdipDisposeImage img   ' Delete the image
       GdipDisposeImage imgThumb   ' Delete the thumbnail image
       GdipDeleteGraphics graphics
    End Sub

    '-----
    Module modGDIPlusAPI
    '-----
    Option Explicit

    Public Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long) As Long
    Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long

    Public Type GdiplusStartupInput
       GdiplusVersion As Long              ' Must be 1 for GDI+ v1.0, the current version as of this writing.
       DebugEventCallback As Long          ' Ignored on free builds
       SuppressBackgroundThread As Long    ' FALSE unless you're prepared to call
                                           ' the hook/unhook functions properly
       SuppressExternalCodecs As Long      ' FALSE unless you want GDI+ only to use
                                           ' its internal image codecs.
    End Type

    Public Type CLSID
       Data1 As Long
       Data2 As Integer
       Data3 As Integer
       Data4(0 To 7) As Byte
    End Type

    Public Type ImageCodecInfo
       ClassID As CLSID
       FormatID As CLSID
       CodecName As Long      ' String Pointer; const WCHAR*
       DllName As Long        ' String Pointer; const WCHAR*
       FormatDescription As Long ' String Pointer; const WCHAR*
       FilenameExtension As Long ' String Pointer; const WCHAR*
       MimeType As Long       ' String Pointer; const WCHAR*
       flags As ImageCodecFlags   ' Should be a Long equivalent
       Version As Long
       SigCount As Long
       SigSize As Long
       SigPattern As Long      ' Byte Array Pointer; BYTE*
       SigMask As Long         ' Byte Array Pointer; BYTE*
    End Type

    Public Enum GpStatus   ' aka Status
       Ok = 0
       GenericError = 1
       InvalidParameter = 2
       OutOfMemory = 3
       ObjectBusy = 4
       InsufficientBuffer = 5
       NotImplemented = 6
       Win32Error = 7
       WrongState = 8
       Aborted = 9
       FileNotFound = 10
       ValueOverflow = 11
       AccessDenied = 12
       UnknownImageFormat = 13
       FontFamilyNotFound = 14
       FontStyleNotFound = 15
       NotTrueTypeFont = 16
       UnsupportedGdiplusVersion = 17
       GdiplusNotInitialized = 18
       PropertyNotFound = 19
       PropertyNotSupported = 20
    End Enum

    ' Information flags about image codecs
    Public Enum ImageCodecFlags
       ImageCodecFlagsEncoder = &H1
       ImageCodecFlagsDecoder = &H2
       ImageCodecFlagsSupportBitmap = &H4
       ImageCodecFlagsSupportVector = &H8
       ImageCodecFlagsSeekableEncode = &H10
       ImageCodecFlagsBlockingDecode = &H20

       ImageCodecFlagsBuiltin = &H10000
       ImageCodecFlagsSystem = &H20000
       ImageCodecFlagsUser = &H40000
    End Enum

    Public Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
    Public Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
    Public Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, graphics As Long) As GpStatus
    Public Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus
    Public Declare Function GdipDrawImageRectI Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long) As GpStatus
    Public Declare Function GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, size As Long) As GpStatus
    Public Declare Function GdipGetImageEncoders Lib "gdiplus" (ByVal numEncoders As Long, ByVal size As Long, encoders As Any) As GpStatus
    Public Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, image As Long) As GpStatus
    Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus
    Public Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal image As Long, ByVal filename As String, clsidEncoder As CLSID, encoderParams As Any) As GpStatus
    Public Declare Function GdipGetImageThumbnail Lib "gdiplus" (ByVal image As Long, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As Long, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As GpStatus

    Public Sub GetEncoderClsid(strMimeType As String, ClassID As CLSID)

       Dim num As Long, size As Long, I As Long
       Dim ICI() As ImageCodecInfo
       Dim buffer() As Byte
       
       ' Get the encoder array size
       GdipGetImageEncodersSize num, size
       If size = 0 Then Exit Sub      ' Failed!

       ' Allocate room for the arrays dynamically
       ReDim ICI(1 To num) As ImageCodecInfo
       ReDim buffer(1 To size) As Byte

       ' Get the array and string data
       GdipGetImageEncoders num, size, buffer(1)
       ' Copy the class headers
       CopyMemory ICI(1), buffer(1), (Len(ICI(1)) * num)

       ' Loop through all the codecs
       For I = 1 To num
          ' Must convert the pointer into a usable string
          If StrComp(PtrToStrW(ICI(I).MimeType), strMimeType, vbTextCompare) = 0 Then
             ClassID = ICI(I).ClassID   ' Save the class id
             Exit For
          End If
       Next
       ' Free the memory
       Erase ICI
       Erase buffer
    End Sub

    'Dereference Unicode string pointer
    Public Function PtrToStrW(ByVal lpsz As Long) As String
        Dim sOut As String
        Dim lLen As Long

        lLen = lstrlenW(lpsz)

        If (lLen > 0) Then
            sOut = StrConv(String$(lLen, vbNullChar), vbUnicode)
            Call CopyMemory(ByVal sOut, ByVal lpsz, lLen * 2)
            PtrToStrW = StrConv(sOut, vbFromUnicode)
        End If
    End Function



    How can I make a smaller file and not so smooth? Thx!
    0
     
    LVL 32

    Accepted Solution

    by:
    Smaller...

    Add the following to a module in your project:

    '==MODULE CODE==
    'GDI+ Declares and types used in saving an image to JPEG in VB6
    ''' Translated by Avery P. - 7/29/2002
    ''' From the module GDIPLUS API.BAS
    ''' Available at psc.com
    ''' Edited by Erick37 October, 2004
    ''' experts-exchange.com

    Option Explicit

    ' NOTE: Enums evaluate to a Long
    Public Enum GpStatus   ' aka Status
       Ok = 0
       GenericError = 1
       InvalidParameter = 2
       OutOfMemory = 3
       ObjectBusy = 4
       InsufficientBuffer = 5
       NotImplemented = 6
       Win32Error = 7
       WrongState = 8
       Aborted = 9
       FileNotFound = 10
       ValueOverflow = 11
       AccessDenied = 12
       UnknownImageFormat = 13
       FontFamilyNotFound = 14
       FontStyleNotFound = 15
       NotTrueTypeFont = 16
       UnsupportedGdiplusVersion = 17
       GdiplusNotInitialized = 18
       PropertyNotFound = 19
       PropertyNotSupported = 20
    End Enum

    Public Type GdiplusStartupInput
       GdiplusVersion As Long              ' Must be 1 for GDI+ v1.0, the current version as of this writing.
       DebugEventCallback As Long          ' Ignored on free builds
       SuppressBackgroundThread As Long    ' FALSE unless you're prepared to call
                                           ' the hook/unhook functions properly
       SuppressExternalCodecs As Long      ' FALSE unless you want GDI+ only to use
                                           ' its internal image codecs.
    End Type

    Public Type CLSID
       Data1 As Long
       Data2 As Integer
       Data3 As Integer
       Data4(0 To 7) As Byte
    End Type

    ' Information flags about image codecs
    Public Enum ImageCodecFlags
       ImageCodecFlagsEncoder = &H1
       ImageCodecFlagsDecoder = &H2
       ImageCodecFlagsSupportBitmap = &H4
       ImageCodecFlagsSupportVector = &H8
       ImageCodecFlagsSeekableEncode = &H10
       ImageCodecFlagsBlockingDecode = &H20

       ImageCodecFlagsBuiltin = &H10000
       ImageCodecFlagsSystem = &H20000
       ImageCodecFlagsUser = &H40000
    End Enum

    Public Type ImageCodecInfo
       ClassID As CLSID
       FormatID As CLSID
       CodecName As Long      ' String Pointer; const WCHAR*
       DllName As Long        ' String Pointer; const WCHAR*
       FormatDescription As Long ' String Pointer; const WCHAR*
       FilenameExtension As Long ' String Pointer; const WCHAR*
       MimeType As Long       ' String Pointer; const WCHAR*
       flags As ImageCodecFlags   ' Should be a Long equivalent
       Version As Long
       SigCount As Long
       SigSize As Long
       SigPattern As Long      ' Byte Array Pointer; BYTE*
       SigMask As Long         ' Byte Array Pointer; BYTE*
    End Type


    ' Image encoder parameter related types
    Public Enum EncoderParameterValueType
       EncoderParameterValueTypeByte = 1              ' 8-bit unsigned int
       EncoderParameterValueTypeASCII = 2             ' 8-bit byte containing one 7-bit ASCII
                                                       ' code. NULL terminated.
       EncoderParameterValueTypeShort = 3             ' 16-bit unsigned int
       EncoderParameterValueTypeLong = 4              ' 32-bit unsigned int
       EncoderParameterValueTypeRational = 5          ' Two Longs. The first Long is the
                                                       ' numerator the second Long expresses the
                                                       ' denomintor.
       EncoderParameterValueTypeLongRange = 6         ' Two longs which specify a range of
                                                       ' integer values. The first Long specifies
                                                       ' the lower end and the second one
                                                       ' specifies the higher end. All values
                                                       ' are inclusive at both ends
       EncoderParameterValueTypeUndefined = 7         ' 8-bit byte that can take any value
                                                       ' depending on field definition
       EncoderParameterValueTypeRationalRange = 8      ' Two Rationals. The first Rational
                                                       ' specifies the lower end and the second
                                                       ' specifies the higher end. All values
                                                       ' are inclusive at both ends
    End Enum

    ' Encoder Parameter structure
    Public Type EncoderParameter
       GUID As CLSID                          ' GUID of the parameter
       NumberOfValues As Long                 ' Number of the parameter values; usually 1
       type As EncoderParameterValueType      ' Value type, like ValueTypeLONG  etc.
       value As Long                          ' A pointer to the parameter values
    End Type

    ' Encoder Parameters structure
    Public Type EncoderParameters
       count As Long                          ' Number of parameters in this structure; Should be 1
       Parameter As EncoderParameter          ' Parameter values; this CAN be an array!!!! (Use CopyMemory and a string or byte array as workaround)
    End Type

    Public Const EncoderQuality           As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"

    Public Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
    Public Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
    Public Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, bitmap As Long) As GpStatus
    Public Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal image As Long, ByVal filename As String, clsidEncoder As CLSID, encoderParams As Any) As GpStatus
    Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus
    Public Declare Function GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, size As Long) As GpStatus
    Public Declare Function GdipGetImageEncoders Lib "gdiplus" (ByVal numEncoders As Long, ByVal size As Long, encoders As Any) As GpStatus
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long
    Private Declare Function lstrlenA Lib "kernel32" (ByVal psString As Any) As Long
    Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpszProgID As Long, pCLSID As CLSID) As Long
    '
    '
    'Needed for GDI+
    Private token As Long

    '
    '
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'By Erick37
    Public Function SaveAsJPEG(pb As PictureBox, ByVal filename As String, Optional ByVal Quality As Long = 80) As Long
        '
        'Saves picturebox image as JPEG using GDI+
        '
        Dim stat As GpStatus
        Dim bm As Long
        Dim encoderCLSID As CLSID
        Dim encoderParams As EncoderParameters
        Dim lQuality As Long
       
        'get the picture into a GDI+ image
        stat = GdipCreateBitmapFromHBITMAP(pb.Picture.Handle, pb.Picture.hpal, bm)
       
        ' Get the CLSID of the JPEG encoder
        Call GetEncoderClsid("image/jpeg", encoderCLSID)
       
        ' Setup the encoder paramters for JPEG quality
        If (stat = Ok) Then
            lQuality = Quality
            encoderParams.count = 1    ' Only one element in this Parameter array
            With encoderParams.Parameter
                .NumberOfValues = 1     ' Should be one
                .type = EncoderParameterValueTypeLong
                ' Set the GUID to EncoderQuality
                .GUID = DEFINE_GUID(EncoderQuality)
                .value = VarPtr(lQuality)  ' Remember: The value expects only pointers!
            End With

            ' Now save the bitmap as JPEG
            stat = GdipSaveImageToFile(bm, StrConv(filename, vbUnicode), encoderCLSID, encoderParams)
           
        End If
       
        SaveAsJPEG = stat
       
        ' Cleanup
        Call GdipDisposeImage(bm)
    End Function

    Public Function gdipLoad() As Boolean
       
        ' Load the GDI+ Dll
        '
        'Return True for success, False for failure
        '
        Dim GpInput As GdiplusStartupInput
       
        gdipLoad = False
        GpInput.GdiplusVersion = 1
        If GdiplusStartup(token, GpInput) = Ok Then
            gdipLoad = True
        End If
       
    End Function

    Public Sub gdipUnLoad()
        ' Unload the GDI+ Dll
        Call GdiplusShutdown(token)
    End Sub

    Public Function GetEncoderClsid(strMimeType As String, ClassID As CLSID)
       Dim num As Long, size As Long, I As Long
       Dim ICI() As ImageCodecInfo
       Dim buffer() As Byte
       
       GetEncoderClsid = -1 'Failure flag

       ' Get the encoder array size
       Call GdipGetImageEncodersSize(num, size)
       If size = 0 Then Exit Function ' Failed!

       ' Allocate room for the arrays dynamically
       ReDim ICI(1 To num) As ImageCodecInfo
       ReDim buffer(1 To size) As Byte

       ' Get the array and string data
       Call GdipGetImageEncoders(num, size, buffer(1))
       ' Copy the class headers
       Call CopyMemory(ICI(1), buffer(1), (Len(ICI(1)) * num))

       ' Loop through all the codecs
       For I = 1 To num
          ' Must convert the pointer into a usable string
          If StrComp(PtrToStrW(ICI(I).MimeType), strMimeType, vbTextCompare) = 0 Then
             ClassID = ICI(I).ClassID   ' Save the class id
             GetEncoderClsid = I        ' return the index number for success
             Exit For
          End If
       Next
       ' Free the memory
       Erase ICI
       Erase buffer
    End Function

    ' Courtesy of: Dana Seaman
    ' Helper routine to convert a CLSID(aka GUID) string to a structure
    Public Function DEFINE_GUID(ByVal sGuid As String) As CLSID
       ' Example ImageFormatBMP = {B96B3CAB-0728-11D3-9D7B-0000F81EF32E}
       Call CLSIDFromString(StrPtr(sGuid), DEFINE_GUID)
    End Function

    ' From www.mvps.org/vbnet...i think
    '   Dereferences an ANSI or Unicode string pointer
    '   and returns a normal VB BSTR
    Public Function PtrToStrW(ByVal lpsz As Long) As String
        Dim sOut As String
        Dim lLen As Long

        lLen = lstrlenW(lpsz)

        If (lLen > 0) Then
            sOut = StrConv(String$(lLen, vbNullChar), vbUnicode)
            Call CopyMemory(ByVal sOut, ByVal lpsz, lLen * 2)
            PtrToStrW = StrConv(sOut, vbFromUnicode)
        End If
    End Function

    0
     
    LVL 32

    Expert Comment

    by:Erick37
    And here's how to use it from your form:

    '==FORM CODE==
    'Calls SaveAsJPEG to save the picture in Picture1 as Jpeg
    'Don't forget the Form_Load and Form_Unload GDIP functions!

    Option Explicit

    Private Sub Command1_Click()
        '//Save the picture
        Dim ret As Long
        ret = SaveAsJPEG(Picture1, "c:\aaa.jpg", 75)
        Debug.Print "done", ret
       
    End Sub

    Private Sub Form_Load()
        'It is required to initialize GDI+ before use
        If Not gdipLoad() Then
            'Could notinitialize the GDI+ Library
            MsgBox "Error loading GDI+ Library"
            Unload Me
        End If
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
        'Free the GDI+ Library
        Call gdipUnLoad
    End Sub
    0
     
    LVL 1

    Author Comment

    by:HyMaX_2003
    Oh my god! I can't believe how simple and PERFECT this is! Thanks a lot Erick, best code!
    0

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    What Security Threats Are You Missing?

    Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

    Suggested Solutions

    When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
    Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
    HTML5 has deprecated a few of the older ways of showing media as well as offering up a new way to create games and animations. Audio, video, and canvas are just a few of the adjustments made between XHTML and HTML5. As we learned in our last micr…
    Learn how to use the remote presentation tool in Prezi to allow you to harness the power of this cloud based presentation platform. You can show your presentation with a remote audience using this free tool.

    845 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    7 Experts available now in Live!

    Get 1:1 Help Now