Modify code and GDI+ API calls to 64-bit system to load images in the ribbon

[bobsan42]

Hello every one.
Although I know a lot about coding I am not a programmer and I learn bit-by-bit on-the-go. So I actually realize that I know too little. And I need help in this case.
Several years ago I put together a workbook to help me with certain engineering tasks on a project. I had forgotten almost all about it until a friend called to ask for a copy of it some days ago.
Lucky him, I was able to send him an older version which didn't utilise CustomUI ribbon - all was forms and buttons so no problem.
But the newest version uses a custom ribbon. And a part of it are a few ribbon galleries loading WMF images from a folder on the hard drive. The images load without a problem in image controls on a form using LoadPicture.
However for loading them into the Galleries I had to use another method so I found a GDI+ solution online. And it worked without any problems on my previous 32-bit setup:

'This module provides a LoadPictureGDI function, which can
'be used instead of VBA's LoadPicture, to load a wide variety
'of image types from disk - including png.
'
'The png format is used in Office 2007 to provide images that
'include an alpha channel for each pixel's transparency
'
'Author:    Stephen Bullen
'Date:      31 October, 2006
'Email:     stephen@oaltd.co.uk

Option Explicit

'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

'Declare a UDT to store the bitmap information
Private Type PICTDESC
    Size As Long
Type As Long
    hPic As Long
    hPal As Long
End Type

'Declare a UDT to store the GDI+ Startup information
Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type

'Windows API calls into the GDI+ library
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long


' Procedure:    LoadPictureGDI
' Purpose:      Loads an image using GDI+
' Returns:      The image as an IPicture Object
Public Function LoadPictureGDI(ByVal sFilename As String) As IPicture

    Dim uGdiInput As GdiplusStartupInput
    Dim hGdiPlus As Long
    Dim lResult As Long
    Dim hGdiImage As Long
    Dim hBitmap As Long

    'Initialize GDI+
    uGdiInput.GdiplusVersion = 1
    lResult = GdiplusStartup(hGdiPlus, uGdiInput)

    If lResult = 0 Then

        'Load the image
        lResult = GdipCreateBitmapFromFile(StrPtr(sFilename), hGdiImage)

        If lResult = 0 Then

            'Create a bitmap handle from the GDI image
            lResult = GdipCreateHBITMAPFromBitmap(hGdiImage, hBitmap, 0)

            'Create the IPicture object from the bitmap handle
            Set LoadPictureGDI = CreateIPicture(hBitmap)

            'Tidy up
            GdipDisposeImage hGdiImage
        End If

        'Shutdown GDI+
        GdiplusShutdown hGdiPlus
    End If

End Function


' Procedure:    CreateIPicture
' Purpose:      Converts a image handle into an IPicture object.
' Returns:      The IPicture object
Private Function CreateIPicture(ByVal hPic As Long) As IPicture

    Dim lResult As Long, uPicInfo As PICTDESC, IID_IDispatch As GUID, IPic As IPicture

    'OLE Picture types
    Const PICTYPE_BITMAP = 1

    ' Create the Interface GUID (for the IPicture interface)
    With IID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    ' Fill uPicInfo with necessary parts.
    With uPicInfo
        .Size = Len(uPicInfo)
        .Type = PICTYPE_BITMAP
        .hPic = hPic
        .hPal = 0
    End With
    ' Create the Picture object.
    lResult = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)
    ' Return the new Picture object.
    Set CreateIPicture = IPic
End Function

the code above is used by a ribbon callback to assign the images to the gallery elements:

Sub GalGetItemImage(control As IRibbonControl, index As Integer, ByRef returnedVal)
'This callback runs for every picture that is in the Img folder
'Fnum is the number of times it run this code line
    On Error Resume Next
    Select Case control.Tag
        Case "Type1"
            MyFiles = MyFiles1
        Case "Type2"
            MyFiles = MyFiles2
   ....
    End Select
    Set returnedVal = LoadPictureGDI(ThisWorkbook.Path & ImgPath & control.Tag & "\" & MyFiles(index + 1))
End Sub

When I opened the file on my current 64-bit O365 configuration I got an error about incompatible declarations. So I tried to modify the declarations like this:

#If VBA7 Then
    Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
    Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
    Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
    Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
    Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#Else
    Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
    Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
    Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
    Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
    Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
    Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#End If

The compiler stopped complaining, but I got nothing in return - all gallery elements remained without images.
I tried using WinAPIExcelp to figure it out myself but couldn't. My knowledge and understanging of API's is superficial, at best.

What I established is that this line:

lResult = GdiplusStartup(hGdiPlus, uGdiInput)

returns lResult=2 so the next check for 0 evaluates to False.
I tried in break mode to manually change lResult to 0, but then this line:

lResult = GdipCreateHBITMAPFromBitmap(hGdiImage, hBitmap, 0)

terminates the function immediately.

Any help resolving this or and alternative solution will be appreciated. I would prefer to have a solution working on both 32 and 64 bit OS/Office.

 

[Dan_W]

Forgive me if I missed it, but I don't see it mentioned in your post that you also updated the Types or the variables (e.g., Long -> LongPtr). I can dig out the 64-bit / 32-bit compatible version of the code you've posted above if you like. I'll check when my laptop has finished it's backup process (maybe 15mins).

 

[Gokhan Aycan]

This should help, even if I can't

https://www.cadsharp.com/docs/Win32API_PtrSafe.txt

Edit: I don't see gdiplus stuff in it (on my phone) still kind of must have if you use API calls imho

 

[Dan_W]

Hopefully this works for you:

'This module provides a LoadPictureGDI function, which can
'be used instead of VBA's LoadPicture, to load a wide variety
'of image types from disk - including png.
'
'The png format is used in Office 2007-2010 to provide images that
'include an alpha channel for each pixel's transparency
'
'Author:    Stephen Bullen
'Date:      31 October, 2006
'Email:     stephen@oaltd.co.uk

'Updated :  30 December, 2010
'By :       Rob Bovey
'Reason :   Also working now in the 64 bit version of Office 2010

Option Explicit

'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type


#If VBA7 Then
    'Declare a UDT to store the bitmap information
    Private Type PICTDESC
        Size As Long
        Type As Long
        hPic As LongPtr
        hPal As LongPtr
    End Type
    
    'Declare a UDT to store the GDI+ Startup information
    Private Type GDIPlusStartupInput
        GdiPlusVersion As Long
        DebugEventCallback As LongPtr
        SuppressBackgroundThread As Long
        SuppressExternalCodecs As Long
    End Type
    
    'Windows API calls into the GDI+ library
    Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GDIPlusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As Long
    Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal fileName As LongPtr, BITMAP As LongPtr) As Long
    Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal BITMAP As LongPtr, hbmReturn As LongPtr, ByVal background As LongPtr) As Long
    Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long
    Private Declare PtrSafe Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr)
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
#Else
    'Declare a UDT to store the bitmap information
    Private Type PICTDESC
        Size As Long
        Type As Long
        hPic As Long
        hPal As Long
    End Type
    
    'Declare a UDT to store the GDI+ Startup information
    Private Type GDIPlusStartupInput
        GdiPlusVersion As Long
        DebugEventCallback As Long
        SuppressBackgroundThread As Long
        SuppressExternalCodecs As Long
    End Type
    
    'Windows API calls into the GDI+ library
    Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
    Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
    Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
    Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
    Private Declare Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As Long)
    Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#End If

' Procedure:    LoadPictureGDI
' Purpose:      Loads an image using GDI+
' Returns:      The image as an IPicture Object
Public Function LoadPictureGDI(ByVal sFilename As String) As IPicture

    Dim uGdiInput As GDIPlusStartupInput
    Dim lResult As Long
#If VBA7 Then
    Dim hGdiPlus As LongPtr
    Dim hGdiImage As LongPtr
    Dim hBitmap As LongPtr
#Else
    Dim hGdiPlus As Long
    Dim hGdiImage As Long
    Dim hBitmap As Long
#End If

    'Initialize GDI+
    uGdiInput.GdiPlusVersion = 1
    lResult = GdiplusStartup(hGdiPlus, uGdiInput)

    If lResult = 0 Then

        'Load the image
        lResult = GdipCreateBitmapFromFile(StrPtr(sFilename), hGdiImage)

        If lResult = 0 Then

            'Create a bitmap handle from the GDI image
            lResult = GdipCreateHBITMAPFromBitmap(hGdiImage, hBitmap, 0)

            'Create the IPicture object from the bitmap handle
            Set LoadPictureGDI = CreateIPicture(hBitmap)

            'Tidy up
            GdipDisposeImage hGdiImage
        End If

        'Shutdown GDI+
        GdiplusShutdown hGdiPlus
    End If

End Function


' Procedure:    CreateIPicture
' Purpose:      Converts a image handle into an IPicture object.
' Returns:      The IPicture object
#If VBA7 Then
Private Function CreateIPicture(ByVal hPic As LongPtr) As IPicture
#Else
Private Function CreateIPicture(ByVal hPic As Long) As IPicture
#End If
    Dim lResult As Long
    Dim uPicinfo As PICTDESC
    Dim IID_IDispatch As GUID
    Dim iPic As IPicture

    'OLE Picture types
    Const PICTYPE_BITMAP = 1

    ' Create the Interface GUID (for the IPicture interface)
    With IID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With

    ' Fill uPicInfo with necessary parts.
    With uPicinfo
        .Size = Len(uPicinfo)
        .Type = PICTYPE_BITMAP
        .hPic = hPic
        .hPal = 0
    End With

    ' Create the Picture object.
    lResult = OleCreatePictureIndirect(uPicinfo, IID_IDispatch, True, iPic)

    ' Return the new Picture object.
    Set CreateIPicture = iPic

End Function

 

[Dan_W]

Edit: I don't see gdiplus stuff in it (on my phone) still kind of must have if you use API calls imho

You're absolutely right - there aren't any references to GDIP. It's extremely frustrating. And the various GDIP declarations that you might find in source code around the internet are not always correct. I've managed to find a fairly thorough list - I will try and find the link to it.

 

[bobsan42]

This should help, even if I can't

https://www.cadsharp.com/docs/Win32API_PtrSafe.txt

Edit: I don't see gdiplus stuff in it (on my phone) still kind of must have if you use API calls imho

I will have look on it on the laptop, thanks.
I managed to adapt other codes successfully, but this one took the best of me.

 

[bobsan42]

Hopefully this works for you:

'This module provides a LoadPictureGDI function, which can
'be used instead of VBA's LoadPicture, to load a wide variety
'of image types from disk - including png.
'
'The png format is used in Office 2007-2010 to provide images that
'include an alpha channel for each pixel's transparency
'
'Author:    Stephen Bullen
'Date:      31 October, 2006
'Email:     stephen@oaltd.co.uk

'Updated :  30 December, 2010
'By :       Rob Bovey
'Reason :   Also working now in the 64 bit version of Office 2010

Option Explicit

'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type


#If VBA7 Then
    'Declare a UDT to store the bitmap information
    Private Type PICTDESC
        Size As Long
        Type As Long
        hPic As LongPtr
        hPal As LongPtr
    End Type
   
    'Declare a UDT to store the GDI+ Startup information
    Private Type GDIPlusStartupInput
        GdiPlusVersion As Long
        DebugEventCallback As LongPtr
        SuppressBackgroundThread As Long
        SuppressExternalCodecs As Long
    End Type
   
    'Windows API calls into the GDI+ library
    Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GDIPlusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As Long
    Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal fileName As LongPtr, BITMAP As LongPtr) As Long
    Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal BITMAP As LongPtr, hbmReturn As LongPtr, ByVal background As LongPtr) As Long
    Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long
    Private Declare PtrSafe Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr)
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
#Else
    'Declare a UDT to store the bitmap information
    Private Type PICTDESC
        Size As Long
        Type As Long
        hPic As Long
        hPal As Long
    End Type
   
    'Declare a UDT to store the GDI+ Startup information
    Private Type GDIPlusStartupInput
        GdiPlusVersion As Long
        DebugEventCallback As Long
        SuppressBackgroundThread As Long
        SuppressExternalCodecs As Long
    End Type
   
    'Windows API calls into the GDI+ library
    Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
    Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
    Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
    Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
    Private Declare Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As Long)
    Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#End If

' Procedure:    LoadPictureGDI
' Purpose:      Loads an image using GDI+
' Returns:      The image as an IPicture Object
Public Function LoadPictureGDI(ByVal sFilename As String) As IPicture

    Dim uGdiInput As GDIPlusStartupInput
    Dim lResult As Long
#If VBA7 Then
    Dim hGdiPlus As LongPtr
    Dim hGdiImage As LongPtr
    Dim hBitmap As LongPtr
#Else
    Dim hGdiPlus As Long
    Dim hGdiImage As Long
    Dim hBitmap As Long
#End If

    'Initialize GDI+
    uGdiInput.GdiPlusVersion = 1
    lResult = GdiplusStartup(hGdiPlus, uGdiInput)

    If lResult = 0 Then

        'Load the image
        lResult = GdipCreateBitmapFromFile(StrPtr(sFilename), hGdiImage)

        If lResult = 0 Then

            'Create a bitmap handle from the GDI image
            lResult = GdipCreateHBITMAPFromBitmap(hGdiImage, hBitmap, 0)

            'Create the IPicture object from the bitmap handle
            Set LoadPictureGDI = CreateIPicture(hBitmap)

            'Tidy up
            GdipDisposeImage hGdiImage
        End If

        'Shutdown GDI+
        GdiplusShutdown hGdiPlus
    End If

End Function


' Procedure:    CreateIPicture
' Purpose:      Converts a image handle into an IPicture object.
' Returns:      The IPicture object
#If VBA7 Then
Private Function CreateIPicture(ByVal hPic As LongPtr) As IPicture
#Else
Private Function CreateIPicture(ByVal hPic As Long) As IPicture
#End If
    Dim lResult As Long
    Dim uPicinfo As PICTDESC
    Dim IID_IDispatch As GUID
    Dim iPic As IPicture

    'OLE Picture types
    Const PICTYPE_BITMAP = 1

    ' Create the Interface GUID (for the IPicture interface)
    With IID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With

    ' Fill uPicInfo with necessary parts.
    With uPicinfo
        .Size = Len(uPicinfo)
        .Type = PICTYPE_BITMAP
        .hPic = hPic
        .hPal = 0
    End With

    ' Create the Picture object.
    lResult = OleCreatePictureIndirect(uPicinfo, IID_IDispatch, True, iPic)

    ' Return the new Picture object.
    Set CreateIPicture = iPic

End Function

Thanks. I will give it a try in a bit and let you know.

 

[bobsan42]

You're absolutely right - there aren't any references to GDIP. It's extremely frustrating. And the various GDIP declarations that you might find in source code around the internet are not always correct. I've managed to find a fairly thorough list - I will try and find the link to it.

Sometime ago I dowloaded an app WinAPIExcelp.
It helped me a lot several times. But it also doesn't contain much on GDI+.
I am guessing most of it is in the txt file link provided by Gokhan Aycan.

 

[Gokhan Aycan]

What you can do is check MS documentation for C++ and (try to) translate datatypes. As mentioned before for pointers instead of Long there is LongPtr, which acts as Long (32b) or LongLong (64b) depending on architecture. Normal Long's should stay Long.

 

[bobsan42]

What you can do is check MS documentation for C++ and (try to) translate datatypes. As mentioned before for pointers instead of Long there is LongPtr, which acts as Long (32b) or LongLong (64b) depending on architecture. Normal Long's should stay Long.

My guess is the types of the arguments in the declarations are not correct for 64 bit. But I couldn't find any references for that.
I will check the code from Dan_W and let you know.
But I am currently having a late evening conversation with Mr. Jack.