在 Access 2007 中使用 .png 作为自定义功能区图标

Question

我想在 Access 2007 功能区中使用 .png 作为自定义图标。

以下是我到目前为止所做的尝试：

我能够将 .bmp 和 .jpg 作为自定义图像加载，而无需任何其他操作问题。我可以加载 .gif，但它似乎没有保留透明度。我根本无法加载 .png。我真的很想使用 .png 来利用其他格式所不具备的 alpha 混合功能。

我发现了一个类似的问题，但这只是处理加载任何类型的自定义图标。我对 .png 特别感兴趣。 Albert Kallal 对这个问题有一个答案，链接到他编写的一个类模块，该模块似乎完全符合我的要求：

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

不幸的是，该答案中的链接已失效。

我还发现了这个网站，它提供了完整的460行模块的下载数十个 API 调用以获得对透明图标的支持。在走这条路之前，我想问问这里的专家是否知道更好的方法。

我知道 .png 是相当新颖的，但我希望 Office 开发人员能够对该格式提供一些本机支持。

Answer 1

这是我目前正在使用的。 Albert Kallal 为 Access 2007 功能区编程提供了更全面的解决方案，它可以做更多的事情不仅仅是加载 .png 的。我还没有使用它，但值得一试。

对于那些感兴趣的人，这是我正在使用的代码。我相信这非常接近 .png 支持所需的最低要求。如果这里有任何无关的内容，请告诉我，我会更新我的答案。

将以下内容添加到标准代码模块：

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

然后，如果您还没有标准代码模块，请添加一个名为 USysRibbons 的表。 （注意：Access 将此表视为系统表，因此您必须通过转至 Access 选项 --> 当前数据库 --> 导航选项来在导航窗格中显示这些表，并确保“显示系统对象”为选中。）然后将这些属性添加到您的控件标记中：

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

例如：

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