[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.
Last edited by fafalone; Mar 17th, 2020 at 05:34 AM.
Reason: New Version
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
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.
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
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.
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)
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.
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)
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.