Results 1 to 9 of 9

Thread: [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert JPG to PNG

Hybrid View

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert JPG to PNG


    Windows Imaging Component Demo

    Intro
    The Windows Imaging Component has been included in Windows since Vista, but there's been no easy way to use it from VB, not in the least due to many variable and pointer types that are incompatible. I've now converted these interfaces to work with VB and added them to my Modern Shell Interfaces type library (added in version 4.62, released 20 Oct 2019).

    This project provides a basic introduction. You can load a file of type JPG, PNG, GIF, BMP, TIF, or ICO; then scale it (or not-- you can skip the scaling and just save it as a new format) and convert it to either PNG or JPG. JPG supports setting a percentage for image quality (it will appear in the Save As... dialog).

    Requirements
    Windows Vista or newer
    oleexp.tlb v4.62 or higher
    oleexp addon modules mIID.bas and mWIC.bas (mWIC is a new addon in 4.62) - These modules are included in the oleexp zip file, you may need to manually add them to the project.
    Common Controls 6.0 Manifest - For transparency. You will not be able to display transparent images if your IDE or EXE are not manifested. See LaVolpe's Manifest Creator if you're not already familiar with this. The Demo project has a manifest in a resource file.

    Selected Code
    The project contains a class called cWICImage.

    Opening a file:
    Code:
    Public Function OpenFile(sFile As String, ToHDC As Long, x As Long, y As Long, Optional nFrame As Long = 0&) As Boolean
    mFile = sFile
    mFrame = nFrame
    Debug.Print "OpenFile ToHDC=" & ToHDC
    Set pFact = New WICImagingFactory
    If (pFact Is Nothing) = False Then
        Set pDecoder = pFact.CreateDecoderFromFilename(StrPtr(mFile), UUID_NULL, &H80000000, WICDecodeMetadataCacheOnDemand)
        If (pDecoder Is Nothing) = False Then
            Dim nCount As Long
            pDecoder.GetFrameCount nCount
            mFrameCt = nCount
            If mFrame >= nCount Then mFrame = nCount - 1
            pDecoder.GetFrame mFrame, pFrame
            pDecoder.GetContainerFormat tCF
            If IsEqualIID(tCF, GUID_ContainerFormatJpeg) Then mCodec = WFF_JPG
            If IsEqualIID(tCF, GUID_ContainerFormatGif) Then mCodec = WFF_GIF
            If IsEqualIID(tCF, GUID_ContainerFormatBmp) Then mCodec = WFF_BMP
            If IsEqualIID(tCF, GUID_ContainerFormatTiff) Then mCodec = WFF_TIF
            If IsEqualIID(tCF, GUID_ContainerFormatIco) Then mCodec = WFF_ICO
            If IsEqualIID(tCF, GUID_ContainerFormatPng) Then mCodec = WFF_PNG
            
            
            If (pFrame Is Nothing) = False Then
                pFrame.GetSize mWidth, mHeight
                pFact.CreateFormatConverter pConverter
                If pConverter Is Nothing Then
                    Debug.Print "OpenFile:No converter"
                    Exit Function
                End If
                pConverter.Initialize pFrame, GUID_WICPixelFormat32bppBGRA, WICBitmapDitherTypeNone, Nothing, 50, WICBitmapPaletteTypeCustom
                mLoaded = True
                mHDC = ToHDC
                Set mSave = pFrame
                Render pFrame, ToHDC, x, y, mWidth, mHeight
            End If
        Else
            Debug.Print "Failed to create decoder."
        End If
    Else
        Debug.Print "Failed to get factory."
    End If
    End Function
    Scaling is fairly simple:
    Code:
    Public Sub ScaleImage(ToHDC As Long, x As Long, y As Long, cx As Long, cy As Long)
    If (pFact Is Nothing) Then Exit Sub
    pFact.CreateBitmapScaler pScaler
    If pScaler Is Nothing Then
        Debug.Print "No scaler"
        Exit Sub
    End If
    pScaler.Initialize pConverter, cx, cy, WICBitmapInterpolationModeFant
    mHDC = ToHDC
    Render pScaler, mHDC, x, y, cx, cy
    Set mSave = pScaler
    End Sub
    The most complicated code is saving:
    Code:
    Public Function SaveJPG(sFilename As String, Quality As Single) As Long
    Debug.Print "SaveJpg " & sFilename
    'Quality must be between 0 and 1
    On Error GoTo e0
    If (pFact Is Nothing) Then Exit Function
    Dim pEnc As IWICBitmapEncoder
    Set pEnc = pFact.CreateEncoder(GUID_ContainerFormatJpeg, UUID_NULL)
    If (pEnc Is Nothing) = False Then
        Dim hr As Long
        Dim fileOutStream As IWICStream
        pFact.CreateStream fileOutStream
        If (fileOutStream Is Nothing) = False Then
            fileOutStream.InitializeFromFilename StrPtr(sFilename), GENERIC_WRITE
            
            pEnc.Initialize fileOutStream, WICBitmapEncoderNoCache
            Dim pTFrame As IWICBitmapFrameEncode
            Dim ppbag As IPropertyBag2
            pEnc.CreateNewFrame pTFrame, ppbag
            
            Dim optImgQuality As PROPBAG2
            optImgQuality.pstrName = StrPtr("ImageQuality")
            Dim pv As Variant
            pv = Quality
            ppbag.Write 1&, optImgQuality, VarPtr(pv)
            hr = pTFrame.Initialize(ppbag)
            Debug.Print "pTFrame.Init hr=0x" & Hex$(hr)
            
            If hr = S_OK Then
                Dim idPF As UUID
                mSave.GetPixelFormat idPF
                 pTFrame.SetPixelFormat idPF 'GUID_WICPixelFormat32bppBGRA
                 pTFrame.WriteSource mSave, 0&
                 Dim pThumb As IWICBitmapSource
                 
                hr = pFrame.GetThumbnail(pThumb)
                If (pThumb Is Nothing) = False Then
                    pTFrame.SetThumbnail pThumb
                End If
     
                pTFrame.Commit
                SaveJPG = pEnc.Commit()
            Else
                SaveJPG = hr
            End If
        Else
            Debug.Print "No output stream."
        End If
    Else
        Debug.Print "Failed to create encoder."
    End If
    
    Exit Function
    
    e0:
        Debug.Print "cWICImage.SaveJpg->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
    End Function
    Update (Revision 1/21 Oct 2019): The x,y offset was being ignored. In the Render sub, hBitmapToPictureBox should have the x, y optional arguments included: hBitmapToPictureBox hDC, hDIBBitmap, x, y. Project updated to make that change; no other changes at this point if you just want to add it yourself.

    Update (Revision 2/22 Oct 2019): Added input for position to the form. Also added an option in cWICImage to center the image; pass -1 for x and specify the PictureBox hWnd (because WindowFromDC does not work on PictureBoxes). This applies to both the OpenFile and ScaleImage functions.
    Attached Files Attached Files
    Last edited by fafalone; Mar 17th, 2020 at 05:34 AM. Reason: New Version

  2. #2
    The Idiot
    Join Date
    Dec 2014
    Posts
    2,721

    Re: [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert to JPG or P

    Interesting, Im using wic for my direct2d needs.
    Instead of using CreateDecoderFromFilename Im using CreateDecoderFromStream
    this so I can load from a byte array and if I do any encryption/decryption of the pictures and if I have multiple pictures in a file.

    another thing I have is "flip", that I can choose when loading, If I want the picture flipped or not,
    quite easy to apply

    Set cFlipRotator = cWICFactory.CreateBitmapFlipRotator()
    cFlipRotator.Initialize cConverter, WICBitmapTransformFlipHorizontal

  3. #3
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert JPG to PNG

    how to open webp format and change to jpg/png?

    Quote Originally Posted by fafalone View Post
    You can use Windows Imaging Component.

    [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert to JPG or PNG

    If you're on Windows 10, it supports WebP natively, but if you're on Windows Vista or 7, you'll need to install a codec:

    Here is one from Google that I use. You'll also be able to see previews in the Windows Image Viewer and in Explorer (in e.g. the Preview pane in my ShellBrowse control). Note that after installation you have to restart your computer before WIC will recognize it.
    IT'S SO FUNNY,
    WEBP 280K
    JPG 972K
    google webp to JPG 500K(80%)
    100%jpg =1.8M
    Last edited by xiaoyao; Mar 25th, 2021 at 03:57 AM.

  4. #4
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert JPG to PNG

    If IsEqualIID(tCF, GUID_ContainerFormatJpeg) Then mCodec = WFF_JPG
    can it check is webp format?
    webp file header:
    Code:
    RIFF ?  WEBPVP8X
    ==============
    question 2:how to change webp img file to jpg or png without hdc?

    'cWICImage 0.2
    'Windows Imaging Component Basic Usage Demo

    it's use hdc:
    Public Function OpenFile(sFile As String, ToHDC As Long, x As Long, y As Long, Optional nFrame As Long = 0&, Optional hWnd As Long) As Boolean

    Code:
    function webpimgToPng(webpfile as string,pngfile as string)
    '****???
    end function

  5. #5

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    Re: [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert JPG to PNG

    Yes I believe it supports webp; check tCF is equal to GUID_ContainerFormatWebp; already defined in mWIC.bas.


    It doesn't use the hDC for conversion, just for rendering, so you can just remove those parts or pass 0 to it for hDC. But then you won't see the picture on your screen.

  6. #6
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert JPG to PNG

    Can png file With transparent channels save as webp?

    saveas jpg
    Code:
           Dim optImgQuality As PROPBAG2
            optImgQuality.pstrName = StrPtr("ImageQuality")
            Dim pv As Variant
            pv = Quality
            ppbag.Write 1&, optImgQuality, VarPtr(pv)

    Code:
    Public Function SaveAsWebp(sFilename As String) As Long
    On Error GoTo e0
     
    If (pFact Is Nothing) Then Exit Function
    
    Dim pEnc As IWICBitmapEncoder
    Set pEnc = pFact.CreateEncoder(GUID_ContainerFormatWebp, UUID_NULL)
    cWICImage.SaveAsWebp->Error: Automatic error, 0x88982F50
    Last edited by xiaoyao; Aug 20th, 2023 at 06:10 AM.

  7. #7

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    Re: [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert JPG to PNG

    I believe the webp WIC codec can only decode. So you could save WEBP as PNG but not PNG as WEBP. There is CLSID_WICWebpDecoder but no corresponding encoder like CLSID_WICPngEncoder.

  8. #8
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert JPG to PNG

    ok,thank you
    save to jpg,png,gif or other format,maybe only jpg file need set PROPBAG2?
    other format only 3 lines code?

    Code:
    'save as jpg
            Dim pTFrame As IWICBitmapFrameEncode
            Dim ppbag As IPropertyBag2
            pEnc.CreateNewFrame pTFrame, ppbag
            
            Dim optImgQuality As PROPBAG2
            optImgQuality.pstrName = StrPtr("ImageQuality")
            Dim pv As Variant
            pv = Quality
            ppbag.Write 1&, optImgQuality, VarPtr(pv)
            hr = pTFrame.Initialize(ppbag)
            Debug.Print "pTFrame.Init hr=0x" & Hex$(hr)
    other format?
    Code:
           Dim pTFrame As IWICBitmapFrameEncode
            pEnc.CreateNewFrame pTFrame, Nothing
            
            hr = pTFrame.Initialize(Nothing)

  9. #9
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert JPG to PNG

    HEIF stands for High Efficiency Image File Format, which is an efficient image packaging format. The file extension of HEIF format photos is generally. HEIC or.HEIF. Different from the JPEG format pictures we most commonly see, HEIF is a package format, the general HEIF format pictures, especially the image file compressed by HEVC (H.265) encoder.

    Apple supported this image format on iOS 11 in 2017, and Windows 10 and Android 9 also began to support HEIF image format in 2018.

    wic2--saveas any img format
    unsupport save as *.hif,*.webp

    Code:
    Public Function SaveAs(sFilename As String, Optional jpgQuality As Single = 80, Optional SaveFormat As String) As Long
    'Quality must be between 0 and 1
    On Error GoTo e0
    Dim SaveTypeUUID As UUID
    If SaveFormat = "" Then
        Dim id As Long
        SaveFormat = LCase(sFilename)
        id = InStrRev(SaveFormat, ".")
        If id > 0 Then
            SaveFormat = Mid(SaveFormat, id + 1)
            If SaveFormat = "jpeg" Then SaveFormat = "jpg"
            If SaveFormat = "heic" Then SaveFormat = "hif"
        Else
            SaveFormat = "jpg"
        End If
        Select Case SaveFormat
            Case "jpg":   SaveTypeUUID = GUID_ContainerFormatJpeg
            Case "png":   SaveTypeUUID = GUID_ContainerFormatPng
            Case "gif":   SaveTypeUUID = GUID_ContainerFormatGif
            Case "bmp":   SaveTypeUUID = GUID_ContainerFormatBmp
            Case "hif":   SaveTypeUUID = GUID_ContainerFormatHeif
            Case Else:    Exit Function
        End Select
    End If
    If (pFact Is Nothing) Then Exit Function
    Dim pEnc As IWICBitmapEncoder
    Set pEnc = pFact.CreateEncoder(SaveTypeUUID, UUID_NULL)
    If (pEnc Is Nothing) = False Then
        Dim hr As Long
        Dim fileOutStream As IWICStream
        pFact.CreateStream fileOutStream
        If (fileOutStream Is Nothing) = False Then
            fileOutStream.InitializeFromFilename StrPtr(sFilename), GENERIC_WRITE
            
            pEnc.Initialize fileOutStream, WICBitmapEncoderNoCache
            Dim pTFrame As IWICBitmapFrameEncode
            Dim ppbag As IPropertyBag2
            
            If SaveFormat = "jpg" Then
                pEnc.CreateNewFrame pTFrame, ppbag
                
                Dim optImgQuality As PROPBAG2
                optImgQuality.pstrName = StrPtr("ImageQuality")
                Dim pv As Variant
                pv = jpgQuality
                ppbag.Write 1&, optImgQuality, VarPtr(pv)
                hr = pTFrame.Initialize(ppbag)
            Else
                pEnc.CreateNewFrame pTFrame, Nothing
                hr = pTFrame.Initialize(Nothing)
            End If
            
            If hr = S_OK Then
                Dim idPF As UUID
                mSave.GetPixelFormat idPF
                 pTFrame.SetPixelFormat idPF 'GUID_WICPixelFormat32bppBGRA
                 pTFrame.WriteSource mSave, 0&
                 Dim pThumb As IWICBitmapSource
                 
                hr = pFrame.GetThumbnail(pThumb)
                If (pThumb Is Nothing) = False Then
                    pTFrame.SetThumbnail pThumb
                End If
     
                pTFrame.Commit
                SaveAs = pEnc.Commit()
            Else
                SaveAs = hr
            End If
        Else
            Debug.Print "No output stream."
        End If
    Else
        Debug.Print "Failed to create encoder."
    End If
    
    Exit Function
    
    e0:
        Debug.Print "cWICImage.SaveAs->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
    End Function
    Last edited by xiaoyao; Aug 20th, 2023 at 06:51 AM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width