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

[fafalone]

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:

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:

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:

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.

---