Используйте .png как пользовательский значок ленты в Access 2007

Question

Я бы хотел использовать .png в качестве пользовательского значка на ленте Access 2007.

Вот что я пробовал до сих пор:

IЯ могу загружать .bmp и .jpg в качестве пользовательских изображений без каких-либо проблем.Я могу загрузить файлы .gif, но это не сохраняет прозрачность.Я не могу загрузить .png вообще.Мне бы очень хотелось использовать .png, чтобы воспользоваться преимуществами альфа-смешения, недоступного в других форматах.

Я нашел похожий вопрос по SO , но это только касаетсяс загрузкой пользовательских иконок любого вида.Я особенно заинтересован в .png.От Альберта Каллала есть ответ на этот вопрос, который ссылается на написанный им модуль класса, который, кажется, делает именно то, что я хочу:

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

К сожалению, ссылка в этом ответе мертва.

Я также нашел этот сайт , который предлагает загрузку 460-строчного модуля, заполненного десятками вызовов API, для получения поддержки прозрачных значков.Прежде чем идти по этому пути, я хотел спросить здесь экспертов, знают ли они лучший путь.

Я знаю, что .png довольно новомодный и все такое, но я надеюсь, что разработчики Office упали в какой-то нативной поддержке формата.

Answer 1

Вот что я сейчас использую. У Альберта Каллала есть более полноценное решение для программирования лент 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"/>