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

http://www.vbforums.com/images/ieimages/2019/10/1.jpg
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.

---

twinBASIC / WinDevLib / x64 support

This project has a 64bit compatible port in twinBASIC using my WinDevLib oleexp successor. It also allows saving in BMP.

WICDemo64 Project Repository on GitHub.

---

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

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

Quote:

---

Originally Posted by fafalone

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

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

---

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.

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

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.

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)

---

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

---

How to use CreateDecoderFromStream,CreateDecoderFromFileHandle?
WEBP picture save as jpg/png, not load by file,with istream/byte array()

Code:

---

Function SetStreamByByteArr(ByteArr() As Byte, Optional AutoFreeIStremMemory As Long) As Boolean
    Dim pIStream As oleexp.IStream, CreateStreamOK As Boolean
    Set pDecoder = Nothing
    'CreateStreamOK=ByteArrToIStream( ByteArr(), pIStream)
    If CreateStreamOnHGlobal(VarPtr(ByteArr(0)), AutoFreeIStremMemory, pIStream) = 0& Then
            CreateStreamOK = True
    End If
    Set pFact = New WICImagingFactory
    Set pDecoder = pFact.CreateDecoderFromStream(pIStream, UUID_NULL, WICDecodeMetadataCacheOnDemand)
    SetStreamByByteArr = Not pDecoder Is Nothing
End Function

Public Function OpenFile(sFile As String, Optional nFrame As Long = 0&) As Boolean
mFile = sFile
mFrame = nFrame
If sFile <> "" Then Set pFact = New WICImagingFactory
If (pFact Is Nothing) = False Then
    If mFile <> "" Then
            Set pDecoder = pFact.CreateDecoderFromFilename(StrPtr(mFile), UUID_NULL, &H80000000, WICDecodeMetadataCacheOnDemand)
    End If

---

https://www.vbforums.com/showthread....=1#post5110277

You can change As IUnknown to As IStream if you want.