I was recently part of a conversation regarding scaling/resizing images and the usual solutions were provided:

• Automate Irfanview
• Use WIA
• …

One person mentioned the GDI+ API, but didn’t provide any code, so I decided to take some of my existing routines and see if I couldn’t make it happen.

It truly didn’t take much effort as I already had 90-95% of the code already done.   I just needed to implement the GdipGetImageThumbnail API to resize the image and I had a functional routine.

Long story short, should anyone wish to use GDI+ to resize/scale images and/or change the image file format, then feel free to use:

'GDI - General
Private Declare Function GdiplusStartup Lib "GDIPlus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Status
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Status
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal fileName As Long, ByRef Bitmap As Long) As Status
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Status
Private Declare Function GdipGetImageThumbnail Lib "GDIPlus" (ByVal Image As Long, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As Long, ByVal callback As Long, ByVal callbackData As Long) As Status
Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal fileName As Long, clsidEncoder As GUID, encoderParams As Any) As Status

'Helper API Declarations
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long

Private Type GDIPlusStartupInput
    GdiPlusVersion            As Long
    DebugEventCallback        As Long
    SuppressBackgroundThread  As Long
    SuppressExternalCodecs    As Long
End Type

Private Type GUID
    Data1                     As Long
    Data2                     As Integer
    Data3                     As Integer
    Data4(0 To 7)             As Byte
End Type

Private Type EncoderParameter
    GUID                      As GUID
    NumberOfValues            As Long
    type                      As Long
    Value                     As Long
End Type

Private Type EncoderParameters
    Count                     As Long
    Parameter(15)             As EncoderParameter
End Type

'GDI+ Status Constants
Private Enum Status
    'https://docs.microsoft.com/en-us/windows/win32/api/gdiplustypes/ne-gdiplustypes-status
    OK = 0
    GenericError = 1
    InvalidParameter = 2
    OutOfMemory = 3
    ObjectBusy = 4
    InsufficientBuffer = 5
    NotImplemented = 6
    Win32Error = 7
    WrongState = 8
    Aborted = 9
    FileNotFound = 10
    ValueOverflow = 11
    AccessDenied = 12
    UnknownImageFormat = 13
    FontFamilyNotFound = 14
    FontStyleNotFound = 15
    NotTrueTypeFont = 16
    UnsupportedGdiplusVersion = 17
    GdiplusNotInitialized = 18
    PropertyNotFound = 19
    PropertyNotSupported = 20
    ProfileNotFound = 21
End Enum

Private Const GdiPlusVersion  As Long = 1
Private Const ImageCodecBMP = "{557CF400-1A04-11D3-9A73-0000F81EF32E}"
Private Const ImageCodecGIF = "{557CF402-1A04-11D3-9A73-0000F81EF32E}"
Private Const ImageCodecJPG = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Private Const ImageCodecPNG = "{557CF406-1A04-11D3-9A73-0000F81EF32E}"
Private Const ImageCodecTIF = "{557CF405-1A04-11D3-9A73-0000F81EF32E}"
Private Const EncoderQuality = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Private Const EncoderCompression = "{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"
Private Const TiffCompressionNone = 6
Private Const EncoderParameterValueTypeLong = 4

Dim lGDIpToken                As Long
Dim bGDIpInitialized          As Boolean
Dim lBitmap                   As Long
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------

Private Function GDIErrorToString(ByVal lGDIError As Status) As String
    Select Case lGDIError
        Case GenericError
            GDIErrorToString = "Generic Error."
        Case InvalidParameter
            GDIErrorToString = "Invalid Parameter."
        Case OutOfMemory
            GDIErrorToString = "Out Of Memory."
        Case ObjectBusy
            GDIErrorToString = "Object Busy."
        Case InsufficientBuffer
            GDIErrorToString = "Insufficient Buffer."
        Case NotImplemented
            GDIErrorToString = "Not Implemented."
        Case Win32Error
            GDIErrorToString = "Win32 Error."
        Case WrongState
            GDIErrorToString = "Wrong State."
        Case Aborted
            GDIErrorToString = "Aborted."
        Case FileNotFound
            GDIErrorToString = "File Not Found."
        Case ValueOverflow
            GDIErrorToString = "Value Overflow."
        Case AccessDenied
            GDIErrorToString = "Access Denied."
        Case UnknownImageFormat
            GDIErrorToString = "Unknown Image Format."
        Case FontFamilyNotFound
            GDIErrorToString = "FontFamily Not Found."
        Case FontStyleNotFound
            GDIErrorToString = "FontStyle Not Found."
        Case NotTrueTypeFont
            GDIErrorToString = "Not TrueType Font."
        Case UnsupportedGdiplusVersion
            GDIErrorToString = "Unsupported Gdiplus Version."
        Case GdiplusNotInitialized
            GDIErrorToString = "Gdiplus Not Initialized."
        Case PropertyNotFound
            GDIErrorToString = "Property Not Found."
        Case PropertyNotSupported
            GDIErrorToString = "Property Not Supported."
        Case Else
            GDIErrorToString = "Unknown Error."
    End Select
End Function


'---------------------------------------------------------------------------------------
' Procedure : GDI_CovertResize
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Resize/Scale and/or change the image format of the specified image file
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
' References: GDI+ APIs, Enums, Types - as applicable
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile       : Fully qualified path and filename of the image file work with
' lWidth      : width to resize image to, leave = 0 to not resize
' lHeight     : height to resize image to, leave = 0 to not resize
' sSaveAsFile : Fully qualified path and filename of the output image file
' lJPGQuality : jpg image quality 1-100, only if outputting as a jpg
'
' Usage:
' ~~~~~~
' Convert to gif only, no resize
' Call GDI_CovertResize("C:\temp\Capture.PNG", 0, 170, "C:\Temp\GDITest.gif")
'
' Resize and convert to jpg
' Call GDI_CovertResize("C:\temp\Capture.PNG", 238, 170, "C:\Temp\GDITest.jpg", 50)
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2023-09-12              Initial Release
'---------------------------------------------------------------------------------------
Public Function GDI_CovertResize(ByVal sFile As String, _
                                 ByVal lWidth As Long, _
                                 ByVal lHeight As Long, _
                                 ByVal sSaveAsFile As String, _
                                 Optional lJPGQuality As Long = 100)
    On Error GoTo Error_Handler
    Dim GDIpStartupInput      As GDIPlusStartupInput
    Dim GDIStatus             As Status
    Dim lThumb                As Long
    Dim tEncoder              As GUID
    Dim tParams               As EncoderParameters
    Dim bParams               As Boolean
    Dim sExt                  As String

    'Start GDI
    '-------------------------------------------------------------------------------------
    If bGDIpInitialized = False Then
        GDIpStartupInput.GdiPlusVersion = 1
        GDIStatus = GdiplusStartup(lGDIpToken, GDIpStartupInput, ByVal 0)
        If GDIStatus <> Status.OK Then
            MsgBox "Unable to start the GDI+ API" & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
            GoTo Error_Handler_Exit
        Else
            bGDIpInitialized = True
        End If
    End If

    'Load our Image to work with
    '-------------------------------------------------------------------------------------
    'In case we already have something in memory let's dispose of it properly
    If lBitmap <> 0 Then
        GDIStatus = GdipDisposeImage(lBitmap)
        If GDIStatus <> Status.OK Then
            MsgBox "Unable to dispose of the current image in memory" & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
            GoTo Error_Handler_Exit
        End If
    End If
    'Now let's proceed with loading the actual image we want to work with
    GDIStatus = GdipCreateBitmapFromFile(StrPtr(sFile), lBitmap)
    If GDIStatus <> Status.OK Then
        MsgBox "Unable to load the specified image" & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
        GoTo Error_Handler_Exit
    End If

    'Work with the image
    '-------------------------------------------------------------------------------------
    If lBitmap Then
        If lWidth = 0 Or lHeight = 0 Then
            'Conversion only
            GDIStatus = Status.OK
        Else
            'Resize
            GDIStatus = GdipGetImageThumbnail(lBitmap, lWidth, lHeight, lThumb, 0, 0)
        End If
        If GDIStatus <> Status.OK Then
            MsgBox "Unable to generate a thumbnail image." & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
            GoTo Error_Handler_Exit
        Else
            'Save the changes
            sExt = Mid(sSaveAsFile, InStrRev(sSaveAsFile, ".") + 1)
            Select Case sExt
                Case "bmp", "dib"
                    CLSIDFromString StrPtr(ImageCodecBMP), tEncoder
                Case "gif"
                    CLSIDFromString StrPtr(ImageCodecGIF), tEncoder
                Case "jpg", "jpeg", "jpe", "jfif"
                    CLSIDFromString StrPtr(ImageCodecJPG), tEncoder

                    If lJPGQuality > 100 Then lJPGQuality = 100
                    If lJPGQuality < 1 Then lJPGQuality = 1
                    With tParams
                        .Count = 1
                        .Parameter(0).NumberOfValues = 1
                        .Parameter(0).type = EncoderParameterValueTypeLong
                        .Parameter(0).Value = VarPtr(lJPGQuality)
                        CLSIDFromString StrPtr(EncoderQuality), .Parameter(0).GUID
                    End With
                    bParams = True
                Case "png"
                    CLSIDFromString StrPtr(ImageCodecPNG), tEncoder
                Case "tif", "tiff"
                    CLSIDFromString StrPtr(ImageCodecTIF), tEncoder

                    With tParams
                        .Count = 1
                        .Parameter(0).NumberOfValues = 1
                        .Parameter(0).type = EncoderParameterValueTypeLong
                        .Parameter(0).Value = VarPtr(TiffCompressionNone)
                        CLSIDFromString StrPtr(EncoderCompression), .Parameter(0).GUID
                    End With
                    bParams = True
                Case Else
                    Exit Function
            End Select

            If bParams Then
                If lWidth = 0 Or lHeight = 0 Then
                    'Simple conversion
                    GDIStatus = GdipSaveImageToFile(lBitmap, StrPtr(sSaveAsFile), tEncoder, ByVal tParams)
                Else
                    'Resize and possible conversion
                    GDIStatus = GdipSaveImageToFile(lThumb, StrPtr(sSaveAsFile), tEncoder, ByVal tParams)
                End If
            Else
                If lWidth = 0 Or lHeight = 0 Then
                    GDIStatus = GdipSaveImageToFile(lBitmap, StrPtr(sSaveAsFile), tEncoder, ByVal 0)
                Else
                    GDIStatus = GdipSaveImageToFile(lThumb, StrPtr(sSaveAsFile), tEncoder, ByVal 0)
                End If
            End If
            If GDIStatus <> Status.OK Then
                MsgBox "Unable to save the image." & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
                GoTo Error_Handler_Exit
            End If
        End If
    End If

Error_Handler_Exit:
    On Error Resume Next
    'Shutdown GDI
    '-------------------------------------------------------------------------------------
    If bGDIpInitialized = True Then
        If lBitmap <> 0 Then
            GDIStatus = GdipDisposeImage(lBitmap)
            If GDIStatus <> Status.OK Then
                MsgBox "Unable to dispose of the processed image" & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
                Exit Function
            Else
                lBitmap = 0
            End If
        End If
        If lThumb <> 0 Then
            GDIStatus = GdipDisposeImage(lThumb)
            If GDIStatus <> Status.OK Then
                MsgBox "Unable to dispose of the thumbnail image" & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
                Exit Function
            Else
                lThumb = 0
            End If
        End If
        GDIStatus = GdiplusShutdown(lGDIpToken)
        If GDIStatus <> Status.OK Then
            MsgBox "Unable to shutdown the GDI+ API" & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
            Exit Function
        Else
            bGDIpInitialized = False
        End If
    End If
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GDI_CovertResize" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Personally, I think WIA is far simpler, but GDI+ does open the doors to do a lot more than just scaling and switching the image format. So it all depends on your needs, but at least now you have options!

Also note that GDI+ is limited to outputting images in the following formats:

• BMP
• GIF
• JPG
• PNG
• TIFF

So if you need another format I highly recommend using the Irfanview automation (see below) approach as it can output in a wide variety of formats.
 

Resources on Other Possible Approaches

VBA - Automating Irfanview

I didn’t originally plan on making any posts about Irfanview, but because I mentioned in in my recent YouTube video regarding I figured I owed it to everyone to at least touch upon the subject.