Use .png as custom ribbon icon in Access 2007

4.6k Views Asked by At

I'd like to use a .png as a custom icon in the Access 2007 ribbon.

Here's what I've tried so far:

I am able to load .bmp's and .jpg's as custom images without any problem. I can load .gif's, but it doesn't seem to preserve the transparency. I can't load .png's at all. I'd really like to use .png's to take advantage of the alpha-blending that is not available in the other formats.

I found a similar question on SO, but that just deals with loading custom icons of any kind. I am specifically interested in .png's. There is an answer from Albert Kallal to that question that links to a class module he had written that appears to do exactly what I want:

meRib("Button1").Picture = "HappyFace.png"

Unfortunately, the link in that answer is dead.

I also found this site which offers a download of a 460 line module full of dozens of API calls to get support for transparent icons. Before I go that route I wanted to ask the experts here if they know of a better way.

I know .png is pretty new-fangled and all, but I'm hoping the Office development folks slipped in some native support for the format.

1

There are 1 best solutions below

3
On BEST ANSWER

Here is what I am currently using. Albert Kallal has a more full-fledged solution for Access 2007 ribbon programming that does a lot more than just load .png's. I am not using it yet, but it's worth checking out.

For those who are interested, here is the code that I am using. I believe this is pretty close to the minimum required for .png support. If there's anything extraneous here, let me know and I'll update my answer.

Add the following to a standard code module:

Option Compare Database
Option Explicit

'================================================================================
'  Declarations required to load .png's in Ribbon
Private Type GUID
    Data1                   As Long
    Data2                   As Integer
    Data3                   As Integer
    Data4(0 To 7)           As Byte
End Type

Private Type PICTDESC
    Size                        As Long
    Type                        As Long
    hPic                        As Long
    hPal                        As Long
End Type

Private Type GdiplusStartupInput
    GdiplusVersion              As Long
    DebugEventCallback          As Long
    SuppressBackgroundThread    As Long
    SuppressExternalCodecs      As Long
End Type

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
'================================================================================

Public Sub GetRibbonImage(ctl As IRibbonControl, ByRef image)
Dim Path As String
    Path = Application.CurrentProject.Path & "\Icons\" & ctl.Tag
    Set image = LoadImage(Path)
End Sub

Private Function LoadImage(ByVal strFName As String) As IPicture
    Dim uGdiInput As GdiplusStartupInput
    Dim hGdiPlus As Long
    Dim hGdiImage As Long
    Dim hBitmap As Long

    uGdiInput.GdiplusVersion = 1

    If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
        If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
            GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
            Set LoadImage = ConvertToIPicture(hBitmap)
            GdipDisposeImage hGdiImage
        End If
        GdiplusShutdown hGdiPlus
    End If

End Function

Private Function ConvertToIPicture(ByVal hPic As Long) As IPicture

    Dim uPicInfo As PICTDESC
    Dim IID_IDispatch As GUID
    Dim IPic As IPicture

    Const PICTYPE_BITMAP = 1

    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

    With uPicInfo
        .Size = Len(uPicInfo)
        .Type = PICTYPE_BITMAP
        .hPic = hPic
        .hPal = 0
    End With

    OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic

    Set ConvertToIPicture = IPic
End Function

Then, if you don't already have one, add a table named USysRibbons. (NOTE: Access treats this table as a system table, so you'll have to show those in your nav pane by going to Access Options --> Current Database --> Navigation Options and make sure 'Show System Objects' is checked.) Then add these attributes to your control tag:

getImage="GetRibbonImage" tag="Acq.png"

For example:

<button id="MyButtonID" label="Do Something" enabled="true" size="large"
getImage="GetRibbonImage" tag="MyIcon.png" onAction="MyPublicSub"/>