Question

我想将.png用作Access 2007功能区中的自定义图标。

这是我到目前为止所尝试的内容：

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

我找到了类似的question on SO，但这只是处理加载任何类型的自定义图标。我对.png特别感兴趣。阿尔伯特·卡拉尔（Albert Kallal）对这个问题有一个答案，这个问题链接到他所写的类似模块，似乎完全符合我的要求：

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

不幸的是，答案中的链接已经死了。

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

我知道.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"/>

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

1 个答案: