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.

 

[bobsan42]

Hopefully this works for you:

It did thank you.
It turned out to be a bit more twisted than I expected but basically variable types were the essence that made the difference - Long changing to LongPtr.
Thanks a bunch for your help guys. And to Mr. Rob Bovey of course.