dcsimg
Results 1 to 1 of 1

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

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,341

    [VB6] Intro to the Windows Imaging Component (WIC): Scale and convert to JPG or 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

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
  •  



Featured


Click Here to Expand Forum to Full Width