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

Question

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

这是我迄今为止尝试过的：

我可以毫无问题地将 .bmp 和 .jpg 加载为自定义图像。我可以加载 .gif，但它似乎无法保持透明度。我根本无法加载.png。我真的很想使用 .png 来利用其他格式中不可用的 alpha 混合。

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

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

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

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

我知道 .png 非常新奇，但我希望 Office 开发人员能够对该格式提供一些本机支持。

Answer 1

这是我目前正在使用的。 Albert Kallal 有一个more full-fledged solution 用于 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 将此表视为系统表，因此您必须通过访问选项 --> 当前数据库 --> 导航选项在导航窗格中显示这些表，并确保选中“显示系统对象”。 ) 然后将这些属性添加到您的控件标记中：

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

例如：

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