среда, 22 февраля 2017 г.

Урок 16. Использование внешних изображений на ленте Access.

Внимание! Написанное ниже следует читать с учётом того, что начиная с версии 7.0 редактор Ribbon XML Editor поддерживает прямую работу с базами данных Access, и уже не требуется создавать временный файл Excel для хранения интерфейса Access. Всё остальное в этом уроке актуально!

На прошлом уроке мы коснулись возможности построения собственных лент для Access. Была упомянута возможность использования на лентах собственных изображений. На этом уроке будут подробно рассмотрены два способа вывода изображений в элементы интерфейса — с помощью параметра loadImage корневого элемента customUI и с помощью параметра getImage целевого элемента интерфейса.

Для того, чтобы внедрить собственные изображения в базу данных Access и использовать их в элементах ленточного интерфейса, нужно помимо уже известной нам с прошлого урока системной таблицы USysRibbons с XML-кодом ленты создать ещё одну системную таблицу для хранения изображений.

Чтобы иметь возможность свободно пользоваться не только изображениями формата gif, bmp и jpeg но и png, а также рядом других форматов (полный список: bmp, gif, jpg, jpeg, tif, png, wmf, emf, ico), нам нужно будет подключить к базе сторонний модуль basGDIPlus, код которого будет приведён в конце урока.

Всё, что мы будем делать далее, проверялось в Access 2016, но должно также работать и на всех предыдущих версиях Access, вплоть до 2007-й.


Общие подготовительные действия

XML-код для Access можно писать как в пустом редакторе, сохраняя его через экспорт в файл настроек интерфейса (Ctrl+E), так и на базе открытого документа, например, Excel. Во втором случае интерфейс можно не только сохранять как обычно, вместе с документом, но и частично отлаживать его в Excel, если в нём не используются специфичные для Access идентификаторы. Рассмотрим второй способ.

Итак, для построения, частичной отладки и хранения нашего XML-кода создаём в Excel документ xlsm. Сохраняем и открываем его в Ribbon XML Editor. Создаём интерфейс с новой вкладкой, группой и несколькими своими кнопками, на которых будем размещать наши внешние изображения. Как построить свою вкладку с группой и кнопками вы уже знаете из предыдущих уроков.

Начиная с версии 6.1 система автодополнения редактора Ribbon XML Editor поддерживает идентификаторы Access, которые включаются вместо идентификаторов текущего приложения (в нашем случае вместо идентификаторов Excel) галочкой «Режим Access» в правом нижнем углу вкладки «Интерфейс». Эта возможность может нам очень пригодиться в дальнейшем. Также в этой версии программы в справку добавлены списки идентификаторов вкладок и групп Access с их русскими названиями, что также существенно облегчает нам ориентирование в интерфейсе Access.

После того, как начальный код ленты построен, создаём в Access новую базу данных. Создаём в ней системную таблицу USysRibbons, как было описано на предыдущем уроке (имя этой таблицы зарезервировано для ленточных интерфейсов). Работаем с первой записью таблицы. Копируем в поле RibbonXML наш код из Ribbon XML Editor.

Поскольку поля таблиц Access не поддерживают табуляцию, перед копированием полезно будет отформатировать текст, нажав кнопку форматирования вместе с зажатой клавишей Shift. Код отформатируется, а все символы табуляции заменятся соответствующим количеством пробелов. При включённой галочке «Режим Access» можно вместе с кнопкой форматирования клавишу Shift и не удерживать, табуляция на пробелы в этом случае заменится по умолчанию.

Вводим в поле RibbonName название ленты, сохраняем базу, закрываем и снова открываем её. Не забываем добавить имя нашей ленты в настройки Access для текущей базы. Снова сохраняем базу, закрываем и открываем Access целиком, загружаем базу. На ленте должна появиться наша вкладка с кнопками без изображений. Теперь у нас всё готово к вставке внешних изображений.


Способ 1 (loadImage)

Создание таблицы с изображениями

Добавляем в базу ещё одну системную таблицу, но уже с произвольным именем, но тоже начинающимися на USys (User-created System table, созданная пользователем системная таблица), например, «USys Изображения для ленты» с четырьмя полями: «ID» (тип «Счётчик»), «Иденификатор изображения» (тип «Короткий текст»), «Изображение» (тип «Вложение») и «Описание» (тип «Короткий текст»). Как видите, в именах таблиц и полей можно использовать русские буквы и пробелы. В случае использования пробелов не забываем затем в VBA-коде заключать такие имена в квадратные скобки. Не забываем также поле ID в таблице сделать ключевым, поставив туда курсор и нажав на кнопку «Ключевое поле».

Таблицу «USys Изображения для ленты» построчно заполняем идентификатором изображения и соответствующим внешним изображением. Поскольку сами изображения в таблице видны не будут, для нашего же удобства заполняем поле «Описание».

XML-код интерфейса и генерация модуля процедур обратного вызова

В Ribbon XML Editor в элемент <customUI> добавляем параметр loadImage со значением имени функции обратного вызова, которую мы напишем, и которая будет возвращать нам изображения по их идентификатору. В элементы, в которые мы будем вставлять внешние изображения, добавляем параметр image со значением идентификатора нужного изображения. Нажимаем на кнопку генерации функций обратного вызова и сохраняем полученный модуль с шаблоном нашей функции в файл. Подправленный XML-код интерфейса снова копируем из Ribbon XML Editor в USysRibbons вместо старого.

Подключение модулей в редакторе Visual Basic
  1. Открываем в Access редактор Visual Basic (Alt+F11)
  2. В контекстном меню базы данных выбираем «Import File…» и импортируем наш модуль.
  3. Вставляем в тело нашей функции обратного вызова следующий код:
    Dim s As String
    s = DLookup("Изображение", "[USys Изображения для ленты]", "[Идентификатор изображения]='" & imageId & "'")
    Set image = basGDIPlus.AttachmentToPicture("[USys Изображения для ленты]", "Изображение", s)
  4. Создаём или импортируем вспомогательный модуль «basGDIPlus.bas».
  5. В меню редактора Visual Basic открываем Tools -> References, прокручиваем список вниз и отмечаем галочкой Microsoft Office XX.0 Object Library, где XX — номер версии Access. Также проверяем, чтобы стояла галочка на «OLE Automation».
  6. Сохраняем изменения и закрываем редактор Visual Basic.
Теперь надо перезагрузить Access с базой. Всё закрываем, снова открываем Access и загружаем нашу базу. На ленте появляется наша вкладка, содержащая кнопки с внешними изображениями.


Способ 2 (getImage)

Создание таблицы с изображениями

Добавляем в базу ещё одну системную таблицу, но уже с произвольным именем, но тоже начинающимися на USys (User-created System table, созданная пользователем системная таблица), например, «USys Изображения для ленты» с четырьмя полями: «ID» (тип «Счётчик»), «Иденификатор элемента» (тип «Короткий текст»), «Изображение» (тип «Вложение») и «Описание» (тип «Короткий текст»). Как видите, в именах таблиц и полей можно использовать русские буквы и пробелы. В случае использования пробелов не забываем затем в VBA-коде заключать такие имена в квадратные скобки. Не забываем также поле ID сделать ключевым, поставив в него курсор и нажав на кнопку «Ключевое поле».

Таблицу «USys Изображения для ленты» построчно заполняем идентификатором элемента интерфейса, в который нужно вставить изображение, и соответствующим внешним изображением. Поскольку сами изображения в таблице видны не будут, для нашего же удобства заполняем поле «Описание».

Если одно изображение используется сразу в нескольких элементах интерфейса, то имеет смысл разделить нашу таблицу на две. В одной хранить изображения, а в другой идентификаторы и соответствующие им порядковые номера изображений первой таблицы. В этом случае код нашей процедуры обратного вызова будет на строчку больше, поскольку сначала надо будет найти номер изображения по идентификатору, и только потом изображение по найденному номеру.

XML-код интерфейса и генерация модуля процедур обратного вызова

В Ribbon XML Editor в элементы, в которые мы будем вставлять внешние изображения, добавляем параметр getImage со значением имени общей функции обратного вызова, которая будет возвращать нам изображения по идентификатору вызвавшего её элемента. Нажимаем на кнопку генерации функций обратного вызова и сохраняем полученный модуль с шаблоном нашей функции в файл. Подправленный XML-код интерфейса снова копируем из Ribbon XML Editor в USysRibbons вместо старого.

Подключение модулей в редакторе Visual Basic
  1. Открываем в Access редактор Visual Basic (Alt+F11)
  2. В контекстном меню базы данных выбираем «Import File…» и импортируем наш модуль.
  3. Вставляем в тело нашей функции обратного вызова следующий код:
    Dim s As String
    s = DLookup("Изображение", "[USys Изображения для ленты]", "[Идентификатор элемента]='" & control.id & "'")
    Set image = basGDIPlus.AttachmentToPicture("[USys Изображения для ленты]", "Изображение", s)
  4. Создаём или импортируем вспомогательный модуль «basGDIPlus.bas».
  5. В меню редактора Visual Basic открываем Tools -> References, прокручиваем список вниз и отмечаем галочкой Microsoft Office XX.0 Object Library, где XX — номер версии Access. Также проверяем, чтобы стояла галочка на «OLE Automation».
  6. Сохраняем изменения и закрываем редактор Visual Basic.
Теперь надо перезагрузить Access с базой. Всё закрываем, снова открываем Access и загружаем нашу базу. На ленте появляется наша вкладка, содержащая кнопки с внешними изображениями.


Код модуля «basGDIPlus.bas»:
Option Compare Database
Option Explicit
 
'Модуль для вставки изображений в формате .png в элементы ленточного интерфейса Access
'----------------------------------------------------
' Функция для иконок с поддержкой GDIPlus-API (GDIP) |
'----------------------------------------------------
'        *  Для версий Office 2007 и выше  *         |
'----------------------------------------------------
'   (c) mossSOFT / Sascha Trowitzsch rev. 04/2009    |
'                  Germany, Berlin                   |
'----------------------------------------------------
'       отредактировал и перевёл Брыкалин А.С.       |
'----------------------------------------------------
 
'Необходимы ссылки на библиотеки:
'«OLE Automation» (stdole)
'«Microsoft Office XX.0 Object Library», где XX - номер версии Access.
 
Public Const GUID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"    'IPicture
 
'Пользовательские типы данных: ----------------------------------------------------------------------
 
Public Enum PicFileType
    pictypeBMP = 1
    pictypeGIF = 2
    pictypePNG = 3
    pictypeJPG = 4
End Enum
 
Public Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
 
Public Type TSize
    x As Double
    y As Double
End Type
 
Public Type RECT
    Bottom As Long
    Left As Long
    Right As Long
    Top As Long
End Type
 
Private Type PICTDESC
    cbSizeOfStruct As Long
    PicType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type
 
Private Type GDIPStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type
 
Private Type EncoderParameter
    UUID As GUID
    NumberOfValues As Long
    type As Long
    Value As Long
End Type
 
Private Type EncoderParameters
    count As Long
    Parameter As EncoderParameter
End Type
 
'Объявления API: ----------------------------------------------------------------------------
 
'Преобразование формата windows bitmap к OLE-Picture :
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (lpPictDesc As PICTDESC, riid As GUID, ByVal fPictureOwnsHandle As Long, IPic As Object) As Long

'Получение типа-GUID из строки :
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pCLSID As GUID) As Long
 
'Функции для работы с памятью:
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalSize Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByRef Source As Byte, ByVal Length As Long)
 
'Модули API:
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
 
'Таймер API:
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
 
 
'Функции потока OLE-Stream:
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ByRef ppstm As Any) As Long
Private Declare Function GetHGlobalFromStream Lib "ole32.dll" (ByVal pstm As Any, ByRef phglobal As Long) As Long
 
'Объявления GDIPlus Flat-API: ----------------------------------------------------------------------------
 
'Инициализация GDIP:
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GDIPStartupInput, Optional ByVal outputbuf As Long = 0) As Long
'Разъединение GDIP:
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
'Загрузка GDIP-изображения из файла:
Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal FileName As Long, bitmap As Long) As Long
'Создание области GDIP-графики из Windows-DeviceContext:
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, GpGraphics As Long) As Long
'Удаление области GDIP-графики:
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal Graphics As Long) As Long
'Копирование GDIP-изображения в графическую область:
Private Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal Graphics As Long, ByVal image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As Long
'Очищение выделенной памяти под битовый массив из GDIP:
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
'Получение windows bitmap указателя из GDIP-изображения:
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
'Получение Windows-Icon-Handle из GDIP-изображения:
Public Declare Function GdipCreateHICONFromBitmap Lib "gdiplus" (ByVal bitmap As Long, hbmReturn As Long) As Long
'Масштабирование размера GDIP-изображения:
Private Declare Function GdipGetImageThumbnail Lib "gdiplus" (ByVal image As Long, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As Long, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As Long
'Получение GDIP-изображения из Windows-Bitmap-Handle:
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, bitmap As Long) As Long
'Получение GDIP-изображения из Windows-Icon-Handle:
Private Declare Function GdipCreateBitmapFromHICON Lib "gdiplus" (ByVal hicon As Long, bitmap As Long) As Long
'Получение ширины GDIP-изображения (в пикселях):
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As Long
'Получение высоты GDIP-изображения (в пикселях):
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As Long
'Сохранение GDIP-изображения в файл с требуемым форматом:
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal image As Long, ByVal FileName As Long, clsidEncoder As GUID, encoderParams As Any) As Long
'Сохранение GDIP-изображения в поток OLE-Stream с требуемым форматом:
Private Declare Function GdipSaveImageToStream Lib "gdiplus" (ByVal image As Long, ByVal stream As IUnknown, clsidEncoder As GUID, encoderParams As Any) As Long
'Получение GDIP-изображения из OLE-Stream-Object:
Private Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal stream As IUnknown, image As Long) As Long
'Создание GDIP-изображения из развёртки
Private Declare Function GdipCreateBitmapFromScan0 Lib "gdiplus" (ByVal Width As Long, ByVal Height As Long, ByVal stride As Long, ByVal PixelFormat As Long, scan0 As Any, bitmap As Long) As Long
'Получение DC GDIP-изображения
Private Declare Function GdipGetImageGraphicsContext Lib "gdiplus" (ByVal image As Long, Graphics As Long) As Long
'Копирование содержания битового массива GDIP-изображения в другую DC изображения используя позиционирование
Private Declare Function GdipDrawImageRectRectI Lib "gdiplus" (ByVal Graphics As Long, ByVal image As Long, ByVal dstx As Long, ByVal dsty As Long, ByVal dstwidth As Long, ByVal dstheight As Long, ByVal srcx As Long, ByVal srcy As Long, ByVal srcwidth As Long, ByVal srcheight As Long, ByVal srcUnit As Long, Optional ByVal imageAttributes As Long = 0, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As Long
 
 
'-----------------------------------------------------------------------------------------
'Глобальные переменные модуля:
Private lGDIP As Long
Private bSharedLoad As Boolean
'-----------------------------------------------------------------------------------------
 
 
'Инициализация GDI+
Function InitGDIP() As Boolean
    Dim TGDP As GDIPStartupInput
    Dim hMod As Long
    
    If lGDIP = 0 Then
        If IsNull(TempVars("GDIPlusHandle")) Then   'Если lGDIP вылетает вследствие критической ошибки, восстанавливаем из Tempvars collection
            TGDP.GdiplusVersion = 1
            hMod = GetModuleHandle("gdiplus.dll")   'gdiplus.dll ещё не загружен?
            If hMod = 0 Then
                hMod = LoadLibrary("gdiplus.dll")
                bSharedLoad = False
            Else
                bSharedLoad = True
            End If
            GdiplusStartup lGDIP, TGDP  'Получить персональный экземпляр gdiplus
            TempVars("GDIPlusHandle") = lGDIP
        Else
            lGDIP = TempVars("GDIPlusHandle")
        End If
        AutoShutDown
    End If
    InitGDIP = (lGDIP > 0)
End Function
 
'Запланированная выгрузка GDI+ обрабатываемая для предотвращения утечки памяти
Private Sub AutoShutDown()
    'Установка 5 секундного интервала перед следующей выгрузкой
    'Эта IMO наиболие подходящая для циклов - но можете настроить её как душе угодно
    If lGDIP <> 0 Then
        TempVars("TimerHandle") = SetTimer(0&, 0&, 5000, AddressOf TimerProc)
    End If
End Sub
 
'Обратный вызов для AutoShutDown
Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    'Debug.Print "GDI+ AutoShutDown", idEvent
    If TempVars("TimerHandle") <> 0 Then
        If KillTimer(0&, CLng(TempVars("TimerHandle"))) Then TempVars("TimerHandle") = 0
    End If
    ShutDownGDIP
End Sub
 
'Очистка GDI+
Sub ShutDownGDIP()
    If lGDIP <> 0 Then
        If KillTimer(0&, CLng(TempVars("TimerHandle"))) Then TempVars("TimerHandle") = 0
        GdiplusShutdown lGDIP
        lGDIP = 0
        TempVars("GDIPlusHandle") = Null
        If Not bSharedLoad Then FreeLibrary GetModuleHandle("gdiplus.dll")
    End If
End Sub
 
'Загрузка картинки с использованием GDIP
'Этот метод эквивалентен LoadPicture() в библиотеке OLE-Automation (stdole2.tlb)
'Поддерживаемые форматы: bmp, gif, jpg, jpeg, tif, png, wmf, emf, ico
Function LoadPictureGDIP(sFileName As String) As StdPicture
    Dim hBmp As Long
    Dim hPic As Long
 
    If Not InitGDIP Then Exit Function
    If GdipCreateBitmapFromFile(StrPtr(sFileName), hPic) = 0 Then
        GdipCreateHBITMAPFromBitmap hPic, hBmp, 0&
        If hBmp <> 0 Then
            Set LoadPictureGDIP = BitmapToPicture(hBmp)
            GdipDisposeImage hPic
        End If
    End If
 
End Function

'Масштабирование изображения с GDIP
'bSharpen: TRUE=Thumb даёт дополнительную резкость
Function ResampleGDIP(ByVal image As StdPicture, ByVal Width As Long, ByVal Height As Long, _
                      Optional bSharpen As Boolean = True) As StdPicture
    Dim lRes As Long
    Dim lBitmap As Long

    If Not InitGDIP Then Exit Function
    
    If image.type = 1 Then
        lRes = GdipCreateBitmapFromHBITMAP(image.Handle, 0, lBitmap)
    Else
        lRes = GdipCreateBitmapFromHICON(image.Handle, lBitmap)
    End If
    If lRes = 0 Then
        Dim lThumb As Long
        Dim hBitmap As Long

        lRes = GdipGetImageThumbnail(lBitmap, Width, Height, lThumb, 0, 0)
        If lRes = 0 Then
            If image.type = 3 Then  'Image-Type 3 это Icon!
                'Преобразование с этим методом GDI +:
                lRes = GdipCreateHICONFromBitmap(lThumb, hBitmap)
                Set ResampleGDIP = BitmapToPicture(hBitmap, True)
            Else
                lRes = GdipCreateHBITMAPFromBitmap(lThumb, hBitmap, 0)
                Set ResampleGDIP = BitmapToPicture(hBitmap)
            End If
            
            GdipDisposeImage lThumb
        End If
        GdipDisposeImage lBitmap
    End If

End Function

'Получить ширину и высоту изображения в пикселях с GDIP
'Вернуть значение как определённый пользователем тип TSize (X/Y как Long)
Function GetDimensionsGDIP(ByVal image As StdPicture) As TSize
    Dim lRes As Long
    Dim lBitmap As Long
    Dim x As Long, y As Long

    If Not InitGDIP Then Exit Function
    If image Is Nothing Then Exit Function
    lRes = GdipCreateBitmapFromHBITMAP(image.Handle, 0, lBitmap)
    If lRes = 0 Then
        GdipGetImageHeight lBitmap, y
        GdipGetImageWidth lBitmap, x
        GetDimensionsGDIP.x = CDbl(x)
        GetDimensionsGDIP.y = CDbl(y)
        GdipDisposeImage lBitmap
    End If

End Function
 
'Вспомогательная функция для получения OLE-Picture из Windows-Bitmap-Handle
'Если bIsIcon = TRUE, то Icon-Handle фиксируется
Function BitmapToPicture(ByVal hBmp As Long, Optional bIsIcon As Boolean = False) As StdPicture
    Dim TPicConv As PICTDESC, UID As GUID
 
    With TPicConv
        If bIsIcon Then
            .cbSizeOfStruct = 16
            .PicType = 3    'PicType Icon
        Else
            .cbSizeOfStruct = Len(TPicConv)
            .PicType = 1    'PicType Bitmap
        End If
        .hImage = hBmp
    End With
 
    CLSIDFromString StrPtr(GUID_IPicture), UID
    OleCreatePictureIndirect TPicConv, UID, True, BitmapToPicture
 
End Function
 
 
'Сохраняет bitmap в файл (с преобразованием формата!)
'image = объект StdPicture
'sFile = полный путь к файлу
'PicType = pictypeBMP, pictypeGIF, pictypePNG или pictypeJPG
'Quality: 0...100; (Качество сжатия, работает только для pictypeJPG!)
'Возвращает TRUE если завершилось успешно
Function SavePicGDIPlus(ByVal image As StdPicture, sFile As String, PicType As PicFileType, Optional Quality As Long = 80) As Boolean
    Dim lBitmap As Long
    Dim TEncoder As GUID
    Dim ret As Long
    Dim TParams As EncoderParameters
    Dim sType As String
 
    If Not InitGDIP Then Exit Function
 
    If GdipCreateBitmapFromHBITMAP(image.Handle, 0, lBitmap) = 0 Then
        Select Case PicType
        Case pictypeBMP: sType = "{557CF400-1A04-11D3-9A73-0000F81EF32E}"
        Case pictypeGIF: sType = "{557CF402-1A04-11D3-9A73-0000F81EF32E}"
        Case pictypePNG: sType = "{557CF406-1A04-11D3-9A73-0000F81EF32E}"
        Case pictypeJPG: sType = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
        End Select
        CLSIDFromString StrPtr(sType), TEncoder
        If PicType = pictypeJPG Then
            TParams.count = 1
            With TParams.Parameter    ' Качество
                CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .UUID
                .NumberOfValues = 1
                .type = 4
                .Value = VarPtr(CLng(Quality))
            End With
        Else
            'Различает количество параметров для GDI+ 1.0 и GDI+ 1.1 в GIF-ах!!
            If (PicType = pictypeGIF) Then TParams.count = 1 Else TParams.count = 0
        End If
        'Сохраняем GDIP-Image в файл:
        ret = GdipSaveImageToFile(lBitmap, StrPtr(sFile), TEncoder, TParams)
        GdipDisposeImage lBitmap
        DoEvents
        'Функция возвращает True, если появляется сгенерированный файл:
        SavePicGDIPlus = (Dir(sFile) <> "")
    End If
 
End Function

'Эта процедура аналогична процедуре SavePicGDIPlus (по параметрам), но отличается тем,
'что ничего не хранится в виде файла, а преобразование выполняется
'с помощью OLE-Stream-объект в байт-массив.
Function ArrayFromPicture(ByVal image As Object, PicType As PicFileType, Optional Quality As Long = 80) As Byte()
    Dim lBitmap As Long
    Dim TEncoder As GUID
    Dim ret As Long
    Dim TParams As EncoderParameters
    Dim sType As String
    Dim IStm As IUnknown

    If Not InitGDIP Then Exit Function

    If GdipCreateBitmapFromHBITMAP(image.Handle, 0, lBitmap) = 0 Then
        Select Case PicType    'Выбор GDIP-Format-Encoders CLSID:
        Case pictypeBMP: sType = "{557CF400-1A04-11D3-9A73-0000F81EF32E}"
        Case pictypeGIF: sType = "{557CF402-1A04-11D3-9A73-0000F81EF32E}"
        Case pictypePNG: sType = "{557CF406-1A04-11D3-9A73-0000F81EF32E}"
        Case pictypeJPG: sType = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
        End Select
        CLSIDFromString StrPtr(sType), TEncoder

        If PicType = pictypeJPG Then    'Если JPG, установить дополнительный параметр
                                        'для задания уровня качества
            TParams.count = 1
            With TParams.Parameter    ' Качество
                CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .UUID
                .NumberOfValues = 1
                .type = 4
                .Value = VarPtr(CLng(Quality))
            End With
        Else
            'Различает количество параметров для GDI+ 1.0 и GDI+ 1.1 в GIF-ах!!
            If (PicType = pictypeGIF) Then TParams.count = 1 Else TParams.count = 0
        End If

        ret = CreateStreamOnHGlobal(0&, 1, IStm)    'Создаём поток
        'Сохраняем GDIP-Image в поток:
        ret = GdipSaveImageToStream(lBitmap, IStm, TEncoder, TParams)
        If ret = 0 Then
            Dim hMem As Long, LSize As Long, lpMem As Long
            Dim abData() As Byte

            ret = GetHGlobalFromStream(IStm, hMem)    'Получить Memory-Handle из потока
            If ret = 0 Then
                LSize = GlobalSize(hMem)
                lpMem = GlobalLock(hMem)   'Получить доступ к памяти
                ReDim abData(LSize - 1)    'Размер массива
                'Фиксация стека памяти из потока:
                CopyMemory abData(0), ByVal lpMem, LSize
                GlobalUnlock hMem           'Закрыть память
                ArrayFromPicture = abData   'Результат
            End If

            Set IStm = Nothing  'Очистка
        End If

        GdipDisposeImage lBitmap    'Очистка GDIP-Image-Memory
    End If

End Function


'Создание объекта картинки из вложения Access
'strTable:              Таблица, содержащая вложенный файл картинки
'strAttachmentField:    Название столбца с вложением
'strImage:              Название изображения для поиска в записи с вложением
'? AttachmentToPicture("ribbonimages","imageblob","cloudy.png").Width
Public Function AttachmentToPicture(strTable As String, strAttachmentField As String, strImage As String) As StdPicture
    Dim strSQL As String
    Dim bin() As Byte
    Dim nOffset As Long
    Dim nSize As Long
    
    strSQL = "SELECT " & strTable & "." & strAttachmentField & ".FileData AS data " & _
             "FROM " & strTable & _
             " WHERE " & strTable & "." & strAttachmentField & ".FileName='" & strImage & "'"
    On Error Resume Next
    bin = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenSnapshot)(0)
    If Err.Number = 0 Then
        Dim bin2() As Byte
        nOffset = bin(0)    'Первый байт Field2.FileData определяет смещение блока данных в файле
        nSize = UBound(bin)
        ReDim bin2(nSize - nOffset)
        CopyMemory bin2(0), bin(nOffset), nSize - nOffset   'Скопировать файл в новый байтовый массив начиная со смещения
        Set AttachmentToPicture = ArrayToPicture(bin2)
        Erase bin2
        Erase bin
    End If
End Function

'Создать OLE-картинку из байтового массива PicBin()
Public Function ArrayToPicture(ByRef PicBin() As Byte) As StdPicture
    Dim IStm As IUnknown
    Dim lBitmap As Long
    Dim hBmp As Long
    Dim ret As Long

    If Not InitGDIP Then Exit Function

    ret = CreateStreamOnHGlobal(VarPtr(PicBin(0)), 0, IStm)  'Создать поток из стека памяти
    If ret = 0 Then    'OK, начать GDIP:
        'Конвертировать поток в GDIP-изображение:
        ret = GdipLoadImageFromStream(IStm, lBitmap)
        If ret = 0 Then
            'Получить Windows-Bitmap из GDIP-изображения:
            GdipCreateHBITMAPFromBitmap lBitmap, hBmp, 0&
            If hBmp <> 0 Then
                'Конвертировать bitmap в объект картинки:
                Set ArrayToPicture = BitmapToPicture(hBmp)
            End If
        End If
        'Чистка памяти ...
        GdipDisposeImage lBitmap
    End If

End Function

понедельник, 13 февраля 2017 г.

Урок 15. Использование Ribbon XML Editor для создания ленты в Access.

Внимание! Написанное ниже актуально для Ribbon XML Editor версии 6.0 и ниже. В версии 6.1 появилось автодополнение Access и справка по его идентификаторам, а начиная с версии 7.0 редактор Ribbon XML Editor поддерживает прямую работу с базами данных Access!

Написание надстроек для Access не менее актуально, чем для Word, Excel и уж тем более Power Point. Однако файл Access в отличие от упомянутых приложений имеет совсем иную структуру. Это обычная база данных, и интерфейс там хранится не в виде файла в отдельной папке документа, а в специальной системной таблице USysRibbons базы данных.

Используемый нами Ribbon XML Editor предназначен для работы с файлами папочной структуры (Word, Excel, Power Point), однако схема интерфейса Access аналогична схемам интерфейса упомянутых приложений, а значит мы можем построить интерфейс и для Access, просто разрабатывая его на базе файла Excel.

Единственное неудобство такого способа состоит в том, что в автодополнении и встроенной справке программы отсутствует информация по идентификаторам Access. Но если у вас под рукой есть соответствующая шпаргалка, полученная из других источников, то последняя проблема перестаёт быть актуальной. 

Замечу, что если вы хотите использовать в Access собственные внешние изображения, то внедрять их штатным инструментом RibbonXML Edeitor не получится, поскольку они не могут храниться внутри папочной структуры файла документа, как это происходит в Word, Excel и PowerPoint. Ведь формат документа Access просто не предусматривает такой структуры. Но изображения можно положить рядом с файлом базы данных, и загружать их с помощью функции, прописанной в параметре loadImage корневого элемента customUI. Кроме того, изображения можно поместить внутрь самой базы. Тому, как это всё сделать, будет посвящён один из следующих уроков.

Итак, технология создания интерфейса Access выглядит приблизительно так:
  1. Открываем Excel и создаём в нём новый документ. Сохраняем документ и закрываем Excel.
  2. Открываем сохранённый документ Excel в Ribbon XML Editor и как обычно создаём структуру кастомной ленты для Access: вкладки, группы, кнопки — всё это будет работать и в Access.
  3. Обработчики событий нажатия на кнопки (функции обратного вызова) создаём так же, как и в Excel.
  4. Открываем Access и создаём в базе данных системную таблицу USysRibbons, в которую копируем весь созданный в Ribbon XML Editor код. Замечу, что для отображения содержимого системной таблицы USysRibbons, в параметрах навигации по таблицам надо разрешить отображение системных объектов.
  5. Код функций обратного вызова подключаем аналогично Excel.
Всё, интерфейс для Access внедрён. Таким образом, Ribbon XML Editor вполне можно использовать даже для Access. 


Для справки. Создание системной таблицы USysRibbons в Access 2016 
  1. Запускаем Access, создаём новую базу данных или открываем старую.
  2. Проверка настройки № 1. Открываем вкладку «Файл», выбираем «Параметры», переходим в «Параметры клиента» и ищем раздел «Общий». Убеждаемся, что галочка на пункте «Показывать ошибки интерфейса пользователя надстроек» установлена.
  3. Проверка настройки № 2. В левой панели навигации щёлкаем правой кнопкой и выбираем пункт «Параметры навигации...». Убеждаемся, что галочка на пункте «Показывать системные объекты» установлена.
  4. На ленте открываем вкладку «Создание» и нажимаем кнопку «Конструктор таблиц».
  5. Создаём 3 поля: ID («Счётчик»), RibbonName («Короткий текст» или «Текст») и RibbonXML («Длинный текст» или «MEMO»). Щёлкаем по строке поля ID и нажимаем на ленте кнопку «Ключевое поле».
  6. Нажимаем «Сохранить» (дискетка на панели быстрого доступа или Ctrl+S). На запрос имени таблицы вводим USysRibbons. Таблица создана и сохранена.
  7. Открываем таблицу и вводим туда данные — имя нашей ленты и её XML-код. Так мы можем ввести в таблицу несколько лент, каждую в свою строку таблицы, и впоследствии выбирать тот или иной интерфейс в зависимости от показанной на экране формы или отчёта (настраивается в окне свойств конструктора формы, вкладка «Другие», параметр «Имя ленты»). Сохраняем данные, закрываем, а затем снова открываем файл базы данных. Теперь Access знает о существовании пользовательского варианта интерфейса. Осталось его подключить.
  8. Открываем вкладку «Файл», выбираем «Параметры», переходим в пункт «Текущая база данных» и ищем раздел «Параметры ленты и панелей инструментов». В комбобоксе «Имя ленты» выбираем имя, которое мы присвоили интерфейсу в поле RibbonName. 
  9. Закрываем, а затем снова открываем файл базы данных. Если всё сделано правильно и в XML-коде нет ошибок, база данных должна открыться с пользовательской лентой. Если лента не появилась, попробуйте закрыть и открыть приложение Access целиком

понедельник, 4 июля 2016 г.

Урок 14. Автоматическое открытие заданной вкладки ленты при запуске документа.

По умолчанию при открытии документа в ленте всегда открывается первая вкладка (псевдовкладку «файл», открывающую закулисье, мы не считаем). Если мы расположили нашу вкладку не первой, но хотим автоматически её открывать при запуске документа, можно использовать следующий трюк.
  1. В xml-коде присвоим нашей вкладке символы клавиатурного доступа (keytip). Для этого используем атрибут keytip для тега tab нашей вкладки. Можно задать последовательность от одного до трёх символов, например, так: keytip="ЁПТ". Теперь, если в документе нажать и отпустить Alt, у ярлыка нашей вкладки появится заданная нами последовательность «ЁПТ», набрав которую вы откроете эту вкладку.
  2. В тег customUI нашего интерфейса добавим атрибут onLoad="ВыборВкладки". Этот атрибут задаёт процедуру, которая будет вызываться сразу после окончания загрузки интерфейса. В ней мы и будем переключать вкладку.
  3. Генерируем шаблон процедуры обратного вызова "ВыборВкладки" (кнопка VBA), и вставляем его в код макросов нашего документа. Внутри этой процедуры программно сэмулируем набор символов клавиатурного доступа командой SendKeys "%ЁПТ{F6}".
Процедура должна выглядеть так:
' (компонент: customUI, атрибут: onLoad), 2007
Sub ВыборВкладки(ribbon As IRibbonUI)
    SendKeys "%ЁПТ{F6}"
End Sub
Знак «%» означает клавишу Alt. Буквы ЁПТ означают сами знаете что. Конструкция {F6} означает клавишу F6. Нажатие на эту клавишу снимает подсказки с элементов внутри открывшейся вкладки.

Несколько слов по выбору первого символа последовательности клавиатурного доступа. Не весь алфавит доступен для этого. Во-первых, нельзя дублировать уже имеющиеся на ленте символы, даже если использовать их в другом регистре. В последнем случае будет срабатывать только первый по счёту символ. Во-вторых, некоторые символы используются для каких-то других целей, и задать их физически невозможно.


Список доступных первых символов для Word 2016:

Б, Г, Ё, Ж, З, Й, Н, С, У, Х, Ц, Ш, Щ, Ъ, Ы, Ь.
Также доступны те же символы в нижнем регистре плюс следующие: д, и, к, л, о, р, ф, ч, э, ю, я. Однако некоторые из дополнительно перечисленных символов дублируют уже использующиеся клавиши верхнего регистра, и их использовать не стоит.

Список доступных первых символов для Excel 2016:

Б, Г, Ё, Ж, З, И, Й, К, Н, С, Т, У, Х, Ц, Ш, Щ, Ъ, Ь.
Также доступны те же символы в нижнем регистре плюс следующие: л, о, р, ф, ч, ы, э, ю, я. Однако некоторые из дополнительно перечисленных символов дублируют уже использующиеся клавиши верхнего регистра, и их использовать не стоит.

четверг, 31 марта 2016 г.

Урок 13. Амперсанд (&), его код &amp; и подчёркивание быстрых клавиш

Иногда в подписях элементов интерфейса необходимо использовать знак & (амперсанд), в английской языковой традиции заменяющий союз and («и»). Кроме того, иногда нужно использовать также и знаки < или >. Но в xml-разметке все эти символы использовать нельзя, поскольку они являются частью языка разметки. Чтобы всё же их использовать, а также использовать символ двойных кавычек внутри двойных кавычек (или символ одинарных кавычек внутри одинарных), применяются специальные коды:
" — &quot;
' — &apos;
< — &lt;
> — &gt;
& — &amp;
Для быстрой вставки этих кодов в Ribbon XML Editor можно принудительно вызвать меню автодополнения (Ctrl + Пробел) внутри строкового значения параметра и выбрать нужный код из предложенного списка:


Поскольку код &amp; используется также и для управления подчёркиванием горячих клавиш в элементе labelControl, то для его реального отображения его код надо сдваивать: &amp;&amp; В этом случае первый код даёт команду подчеркнуть следующий символ, который уже не рассматривается, как управляющий подчёркиванием, а просто отображается подчёркнутым. Но подчёркивать амперсанд в подписях нужно редко. Как же быть?

Чтобы снять ненужное подчёркивание амперсанда, используется следующий трюк. Поскольку подчёркивание в подписи может быть только одно, система оставляет подчёркнутым только последний из отмеченных кодом &amp; символов. Поэтому нам достаточно отметить им либо другой символ, стоящий после подчёркнутого амперсанда, либо, если подчёркивание в labelControl не нужно вообще, поставить &amp; в конце строки. В последнем случае символа после &amp; уже никакого не будет, и подчёркивания в подписи не появится вообще. Кстати, подчеркнуть символ до амперсанда, видимо, нельзя.

Замечу, что не все элементы отображают подчёркивание. Я нашёл только один элемент — labelControl, поддерживающий эту функцию. Поэтому использовать трюк с убиранием подчёркивания амперсанда в подписях других элементов смысла, наверное, не имеет.

пятница, 13 марта 2015 г.

Урок 12. Динамическое меню.

Теперь мы уже почти профессионалы в программировании интерфейсов, и можем замахнуться аж на динамическое меню. Динамическое меню, как и динамические атрибуты, получает своё содержимое из функции обратного вызова. То есть, наша функция должна возвращать некий XML-код, который и будет формировать дочерние элементы меню.

Давайте сделаем ещё одну надстройку-демонстратор динамического меню. Создадим третий документ и откроем его в Ribbon XML Editor. Построим в нём следующий код:

<?xml version="1.0" standalone="yes"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" xmlns:МПИ="http://customui.blogspot.ru">
    <ribbon startFromScratch="false">
        <tabs>
            <tab idQ="МПИ:Вкладка1" label="Полезные надстройки" insertBeforeMso="TabHome" keytip="Н">
                <group id="ДинамическиеМеню" label="Демонстрация меню">
                    <menu id="Меню1" label="Обычное меню" itemSize="large">
                        <button 
                            id="Кнопка1" 
                            label="Пункт 1" 
                            description="Пункт обычного меню" 
                            onAction="Сообщение1" />
                        <button 
                            id="Кнопка2" 
                            label="Пункт 2" 
                            description="Пункт обычного меню" 
                            onAction="Сообщение2" />
                        <button 
                            id="Кнопка3" 
                            label="Пункт 3" 
                            description="Пункт обычного меню" 
                            onAction="Сообщение3" />
                    </menu>
                    <dynamicMenu 
                        id="ДинамическоеМеню1" 
                        label="Динкамическое меню" 
                        getContent="ВернутьДинамическоеМеню" />
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

В этом коде мы создаём на нашей вкладке третью группу, в которой размещаем обычное меню с тремя пунктами и динамическое меню, пункты которого мы будем получать с помощью функции «ВернутьДинамическоеМеню». Сгенерируем шаблоны функций обратного вызова и сохраним их в файле, как мы уже делали это ранее.

Кстати, если вы хотите изменить имя, предлагаемое по умолчанию, под которым сохраняются шаблоны функций, зайдите в настройки Ribbon XML Editor, и обратите внимание на окно в правом верхнем углу. Этот блок текста каждый раз помещается в начало сохраняемого файла, и вы можете отредактировать его по вашему усмотрению. В первой строке написано:

Attribute VB_Name = "RibbonCallbacks"

Мы можем поменять эту строку на:

Attribute VB_Name = "CustomUICallbacks"

и при сохранении файла нам будет предлагаться уже новое имя.

Итак, запустим документ на выполнение. Обычное меню уже работает, а для формирования пунктов динамического меню нам нужно открыть редактор Бейсика (Alt+F11) и загрузить в него модуль с сохранёнными нами ранее шаблонами функций обратного вызова.

Заполним шаблоны функций следующим кодом:

'Кнопка1 (компонент: button, атрибут: onAction), 2007
Sub Сообщение1(control As IRibbonControl)
    MsgBox "Был выбран пункт 1"
End Sub

'Кнопка2 (компонент: button, атрибут: onAction), 2007
Sub Сообщение2(control As IRibbonControl)
    MsgBox "Был выбран пункт 2"
End Sub

'Кнопка3 (компонент: button, атрибут: onAction), 2007
Sub Сообщение3(control As IRibbonControl)
    MsgBox "Был выбран пункт 3"
End Sub

'ДинамическоеМеню1 (компонент: dynamicMenu, атрибут: getContent), 2007
Sub ВернутьДинамическоеМеню(control As IRibbonControl, ByRef content)
Dim sXML As String
    sXML = "<menu itemSize=""large"" xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">" & vbCrLf
    sXML = sXML & "<button id=""Кнопка1"" label=""Пункт 1"" description=""Пункт динамического меню"" onAction = ""Сообщение1""/>" & vbCrLf
    sXML = sXML & "<button id=""Кнопка2"" label=""Пункт 2"" description=""Пункт динамического меню"" onAction = ""Сообщение2""/>" & vbCrLf
    sXML = sXML & "<button id=""Кнопка3"" label=""Пункт 3"" description=""Пункт динамического меню"" onAction = ""Сообщение3""/>" & vbCrLf
    content = sXML & "</menu>" 
End Sub

В первых трёх функциях мы просто выводим сообщение о нажатии того или иного пункта, а в последней — формируем пункты, которые должны будут вернуться из функции во время выполнения документа. Тут требуются небольшое пояснение.

Формируемые пункты возвращаются в динамическое меню не списком, а XML-структурой, объединенённой корневым элементом menu, имеющим тип CT_MenuRoot. Элемента этого типа нет в иерархии статических элементов. Но в справке Ribbon XML Editor среди приложений мы можем найти ссылку «Динамическое меню», нажав на которую, мы откроем страничку с описанием этого типа и дополнительными сведениями по нему.

Согласно справке, корневой элемент menu должен содержать атрибут xmlns с объявлением пространства имён, используемое нами в основном коде. Замечу, что несмотря на то, что ранее мы использовали этот атрибут только в корневом элементе customUI, теоретически его можно использовать в любом элементе интерфейса, хотя его и не будет среди предлагаемых вариантов в автодополнении ввиду редкости такого использования. В данном случае мы применяем его в элементе menu.

В функции «ВернутьДинамическоеМеню» мы присваиваем строковой переменной sXML сначала открывающий тег menu с атрибутом размера пунктов меню и объявлением пространства имён, затем добавляем туда коды перевода строки (vbCrLf), затем теги элементов пунктов меню с желаемыми атрибутами и, в завершение, присваиваем возвращаемой переменной содержимое полученной строки с добавлением закрывающего тега menu. Внутри строковых переменных знак кавычек делается сдвоенным, чтобы не было конфликта с синтаксисом Бейсика, использующего тот же знак для обозначения строк.

Сохраняем код, закрываем редактор Бейсика, потом документ, а затем снова открываем его и нажмём на кнопку открытия динамического меню. В момент нажатия срабатывает код формирования меню, и оно отображается. Сравните его работу с работой рядом расположенного статического меню.

четверг, 12 марта 2015 г.

Урок 11. Создание второй надстройки, дополняющей первую.

На этом уроке мы попробуем написать вторую надстройку, которая могла бы использоваться как независимо от первой, так и располагаться вместе с ней на той-же вкладке. Пусть это будет надстройка работы со строками.

Создадим в Word новый документ и сохраним его как документ с макросами (.doсm). Убедимся, что в новом документе работает надстройка, сделанная нами на прошлом уроке. Закроем документ, и откроем его через Ribbon XML Editor.

Кстати, документы можно открывать в Ribbon XML Editor как непосредственно из этого редактора, так и из контекстного меню самого документа, что очень удобно. Но для этого нужно вначале добавить в эти контекстные меню соответствующий пункт. Это легко делается со страницы настроек Ribbon XML Editor.

Откройте вкладку настроек, и обратите внимание на раздел в правой части «Добавление «Открыть в Ribbon XML Editor» в контекстное меню проводника». Отметьте галочками те документы, для которых в контекстное меню проводника должен быть добавлен соответствующий пункт. В нашем случае достаточно одной галочки в столбце «Для файлов Word» напротив «Документ с макросами», но можно отметить и все галочки. Затем нажмите кнопку «Установить».

Обязательно прочтите всплывающую подсказку на кнопке, там есть много полезной информации. В частности, то, что документ будет открываться в той копии Ribbon XML Editor, из которой была осуществлена установка. Перед удалением программы, для того, чтобы убрать ненужные уже пункты контекстных меню, не забудьте снять все установленные галочки и снова нажать кнопку «Установить» для установки отменённого состояния пунктов контекстного меню.

Напишем интерфейс, аналогичный прежней надстройке:

<?xml version="1.0" standalone="yes"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
    <ribbon startFromScratch="false">
        <tabs>
            <tab id="Вкладка1" label="Полезные надстройки" insertBeforeMso="TabHome" keytip="Н">
                <group id="РаботаСоСтроками" label="Работа со строками">
                    <button 
                        id="ДублироватьТекущуюСтроку" 
                        onAction="ДублироватьТекущуюСтроку" 
                        label="Дублировать" 
                        keytip="Д" 
                        imageMso="QuickStylesSets" 
                        size="large" 
                        screentip="Дублировать текущую строку" 
                        supertip="Сопировать текущую строку в строку ниже"/>
                    <button 
                        id="УдалитьСдвоенныеПустыеСтроки" 
                        onAction="УдалитьСдвоенныеПустыеСтроки" 
                        label="Удалить повторные пустые строки" 
                        keytip="С" 
                        imageMso="RecordsCollapseAllSubdatasheets" 
                        size="large" 
                        screentip="Удалить повторные пустые строки" 
                        supertip="Найти и заменить все повторяющиеся пустые строки одной"/>
                    <button 
                        id="УдалитьПустыеСтроки" 
                        onAction="УдалитьПустыеСтроки" 
                        label="Удалить пустые строки" 
                        keytip="В" 
                        imageMso="GroupQuerySetup" 
                        size="large" 
                        screentip="Удалить все пустые строки" 
                        supertip="Найти и удалить все пустые строки"/>                            
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

Сгенерируем процедуры обратного вызова и сохраним их в файле. Запустим документ на выполнение. Ожидаем, что на уже существующую вкладку «Вкладка1» добавится новая группа. Попробуем запустить документ (F9). Запустили? Вот те на…

Вместо того, чтобы группа добавилась на вкладку с указанным идентификатором, мы увидели, что создалась ещё одна вкладка с тем же именем, куда и была помещена новая группа! Что же произошло не так?

По всей видимости, приложения офиса всё же различают внутри себя одинаковые идентификаторы. Очевидно, им автоматически присваиваются разные пространства имён (о которых мы говорили на первых наших уроках). Какой же из этого выход? Принудительно присвоить нашим идентификаторам одинаковое пространство имён. Для этого нам придётся произвести небольшую модификацию кода в обеих надстройках и вспомнить, что такое idQ.

Закроем Word, и удалим нашу прежнюю надстройку из папки:

    C:\Users\[ИмяПользователя]\AppData\Roaming\Microsoft\Word\STARTUP

В текущей надстройке, открытой в Ribbon XML Editor, добавим в тег customUI второй атрибут xmlns с указанием идентификатора нашего собственного пространства имён, например, МПИ (Моё Пространство Имён), и присвоим значение этому идентификатору, например, http://customui.blogspot.ru (интернет-адрес этого блога), как показано в строке ниже:

    xmlns:МПИ="http://customui.blogspot.ru"

Этим самым мы объявим новое пространство имён, в дополнение к пространству по умолчанию, которое выражалось строкой

    xmlns="http://schemas.microsoft.com/office/2006/01/customui"

Теперь в теге tab заменим атрибут id на атрибут idQ, чтобы иметь возможность включить в идентификатор вкладки префикс пространства имён, и перед идентификатором «Вкладка1» вставим этот префикс нашего нового пространства. Замечу, что как только мы добавляем новое пространство имён в тег интерфейса (customUI), оно сразу появляется в автодополнении, поэтому вставку префикса мы можем осуществить прямо из него. Итак, мы получили строку:

<tab idq="МПИ:Вкладка1" insertbeforemso="TabHome" keytip="Н" label="Полезные надстройки">

Запускаем документ на выполнение (F9) и видим нашу вкладку в интерфейсе. Она будет единственной, потому что старую нашу надстройку, которую мы ещё не модифицировали аналогичным образом, мы удалили. Переходим в редактор Бейсика (Alt+F11) и открываем в нём ранее сохранённые нами шаблоны процедур обратного вызова для этой надстройки. Затем заполняем их следующим образом:

'НайтиИЗаменить (компонент: button, атрибут: onAction), 2007
Sub НайтиИЗаменить(findString As String, replaceString As String)
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = findString
        .Replacement.Text = replaceString
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub

'ДублироватьТекущуюСтроку (компонент: button, атрибут: onAction), 2007
Sub ДублироватьТекущуюСтроку(control As IRibbonControl)
    With Selection
        .HomeKey Unit:=wdLine
        .MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
        .Copy
        .HomeKey Unit:=wdLine
        .PasteAndFormat (wdFormatOriginalFormatting)
    End With
End Sub

'УдалитьСдвоенныеПустыеСтроки (компонент: button, атрибут: onAction), 2007
Sub УдалитьСдвоенныеПустыеСтроки(control As IRibbonControl)
Dim NumCharsBefore As Long, NumCharsAfter As Long
    Do
        NumCharsBefore = ActiveDocument.Characters.Count
        Call НайтиИЗаменить("^p^p^p", "^p^p")
        NumCharsAfter = ActiveDocument.Characters.Count
    Loop Until NumCharsBefore = NumCharsAfter
End Sub

'УдалитьПустыеСтроки (компонент: button, атрибут: onAction), 2007
Sub УдалитьПустыеСтроки(control As IRibbonControl)
Dim NumCharsBefore As Long, NumCharsAfter As Long
    Do
        NumCharsBefore = ActiveDocument.Characters.Count
        Call НайтиИЗаменить("^p^p", "^p")
        NumCharsAfter = ActiveDocument.Characters.Count
    Loop Until NumCharsBefore = NumCharsAfter
End Sub

В этих функциях мы реализовываем функционал кнопок. Мы можем увидеть здесь уже знакомую нам по первой надстройке функцию «НайтиИЗаменить», а также функции обратного вызова для кнопок. Функция дублирования строки создана методом записи макроса с последующей небольшой корректировкой, а две оставшиеся функции в цикле меняют одно количество символов абзаца (^p) на другое, в зависимости от задачи.

Замечу, что предложенная реализация функций не является эталонной. Напротив, это первое и самое простое, что пришло в голову. Напомню, что задачей этих уроков является построение интерфейса, а не программирование на VBA.

Сохраним код, перейдём в окно документа и проверим работу кнопок. Если всё работает так, как надо, то сохраняем документ как шаблон с поддержкой макросов (.dotm) в папку:

    C:\Users\[ИмяПользователя]\AppData\Roaming\Microsoft\Word\STARTUP

Эта надстройка готова. В Word пока не включаем её, чтобы не мешалась. Теперь открываем в Ribbon XML Editor документ со старой надстройкой, и правим её аналогично новой. Добавляем то же самое пространство имён, у вкладки меняем атрибут id на idQ и добавляем наш префикс перед идентификатором. Запускаем документ (F9), проверяем функционал и сохраняем его как шаблон рядом со второй надстройкой в папке

    C:\Users\[ИмяПользователя]\AppData\Roaming\Microsoft\Word\STARTUP

Закрываем сохранённый шаблон в Word и открытый документ в Ribbon XML Editor. Обе надстройки готовы к работе. Запускаем Word, лезем в настройки, и включаем обе надстройки, установив напротив них галочки. После сохранения изменений в настройках у нас появляется одна вкладка, содержащая две группы, сформированные разными надстройками! То, что нам и было нужно.

суббота, 7 марта 2015 г.

Урок 10. Создание простейшей надстройки.

Конструирование интерфейсов чаще всего используется при создании надстроек. Надстройка представляет собой невидимый документ со встроенным VBA-кодом и с собственными дополнениями к интерфейсу, автоматически открываемый приложением при запуске. При запуске он не показывает своё тело (т.е. содержимое документа текст, рисунки и пр.), а проявляется только своими изменениями в интерфейсе и подключенными макросами. Таким образом, приложение Microsoft Office дополняет свой функционал, и позволяет редактировать другие документы, используя вновь полученные функции.

Документ надстройки для Word имеет расширение .dotm. Фактически, надстройка для Word является обычным шаблоном с поддержкой макросов. Для надстроек Excel и PowerPoint имеются отдельные расширения — .xlam и .ppam соответственно.

Замечу, что надстройки .xlam и .ppam просто так не открываются в приложениях в качестве документа для редактирования, поэтому пока такая надстройка не готова, её сохраняют как обычный документ с поддержкой макросов. А вот шаблон .dotm можно открыть в Word именно как шаблон (по крайней мере, Ribbon XML Editor это делает), поэтому его можно сохранять шаблоном и в процессе разработки надстройки. Однако, я всё же рекомендую действовать единообразно, и исходники надстроек всегда держать в формате обычных документов с поддержкой макросов, и переводить их в шаблоны или надстройки только после полного окончания их разработки.

Итак, давайте попробуем построить надстройку Word, которая будет выглядеть, как отдельная вкладка, и содержать группу с кнопками, выполняющими некоторые действия. Пусть это будут некие действия с пробелами. Замечу, что процесс создания надстройки Excel ничем не отличается от создания надстройки Word и, умея создавать одно, вы будете уметь создавать другое.

Откроем Ribbon XML Editor, откроем в нём наш подопытный документ, и в окно для 2007-го интерфейса скопируем текст интерфейса нашей надстройки:

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
    <ribbon startFromScratch="false">
        <tabs>
            <tab id="Вкладка1" label="Полезные надстройки" insertBeforeMso="TabHome" keytip="Н">
                <group id="РаботаСПробелами" label="Работа с пробелами">
                    <button 
                        id="УдалитьПовторяющиесяПробелы" 
                        onAction="УдалитьПовторяющиесяПробелы" 
                        label="Удалить повторяющиеся пробелы" 
                        keytip="У" 
                        imageMso="WordArtSpacingMenu" 
                        size="large" 
                        screentip="Удалить повторяющиеся пробелы" 
                        supertip="Найти и заменить все повторяющиеся пробелы одним"/>
                    <button 
                        id="ПробелыВПереносыСтрок" 
                        onAction="ПробелыВПереносыСтрок" 
                        label="Пробелы в переносы строк" 
                        keytip="ПС" 
                        imageMso="PivotExpandField" 
                        size="large" 
                        screentip="Пробелы в переносы строк" 
                        supertip="Найти и заменить все пробелы переносом строки"/>
                    <button 
                        id="ПереносыСтрокВПробелы" 
                        onAction="ПереносыСтрокВПробелы" 
                        label="Переносы строк в пробелы" 
                        keytip="СП" 
                        imageMso="PivotCollapseField" 
                        size="large" 
                        screentip="Переносы строк в пробелы" 
                        supertip="Найти и заменить все переносы строк пробелами"/>                        
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

Ознакомьтесь с кодом интерфейса. Тут всё просто. Надстройка добавляет новую вкладку, и располагает на ней группу работы с пробелами, содержащую три кнопки. Для упрощения примера, в качестве иконок для кнопок я использовал максимально подходящие встроенные изображения. Вы можете использовать вместо них свои собственные, вы это уже умеете.

Первая кнопка удаляет все повторяющиеся пробелы. Довольно полезная функция, учитывая то, что правильная вёрстка в Word вообще не предполагает идущих подряд пробелов. Вторая кнопка преобразует все пробелы в переносы строк, а третья — обратное действие, т.е. переносы строк в пробелы. Тоже нужная функция для работы с последовательностями различных лексем.

Сгенерируем функции обратного вызова (Alt+F11). Скопируем шаблоны в буфер обмена (обращаем внимание на раскладку клавиатуры во избежание появления кракозябр). Закроем окно шаблонов и запустим документ. Перейдём в редактор Бейсика (Alt+F11) и вставим взятые в буфер обмена шаблоны функций вместо наших старых функций модуля RibbonCallbacks.

Теперь осталось написать на Бейсике нужные команды. Очевидно, нам понадобится функция поиска и замены. С помощью штатной функции записи макросов я выяснил, каким кодом осуществляется поиск и замена, и организовал это в виде отдельной функции, которую мы будем использовать внутри наших функций обратного вызова.

Итак, вставляем в код новую функцию:

'НайтиИЗаменить (компонент: button, атрибут: onAction), 2007
Sub НайтиИЗаменить(findString As String, replaceString As String)
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = findString
        .Replacement.Text = replaceString
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With 
End Sub

Функция принимает на вход строку для поиска и строку для замены, а внутри функции вставлен код из макроса, который записывался во время реального поиска и замены. Несомненно, в нём много лишнего, так как все эти параметры наверняка имеют значения по умолчанию. Тем не менее, для надёжности я оставил всё как есть — хуже уж точно не будет.

Теперь заполняем шаблоны процедур обратного вызова:

'УдалитьПовторяющиесяПробелы (компонент: button, атрибут: onAction), 2007
Sub УдалитьПовторяющиесяПробелы(control As IRibbonControl)
Dim NumCharsBefore As Long, NumCharsAfter As Long
    Do
        NumCharsBefore = ActiveDocument.Characters.Count
        Call НайтиИЗаменить("  ", " ")
        NumCharsAfter = ActiveDocument.Characters.Count
    Loop Until NumCharsBefore = NumCharsAfter
End Sub

'ПробелыВПереносыСтрок (компонент: button, атрибут: onAction), 2007
Sub ПробелыВПереносыСтрок(control As IRibbonControl)
    Call НайтиИЗаменить(" ","^p")
End Sub

'ПереносыСтрокВПробелы (компонент: button, атрибут: onAction), 2007
Sub ПереносыСтрокВПробелы(control As IRibbonControl)
    Call НайтиИЗаменить("^p", " ")
    Call НайтиИЗаменить("^w^p", "")
End Sub

Как видите, код элементарен, ничего сложного. В первой функции мы организовываем цикл, в котором сдвоенные пробелы меняем на одинарные, и который будет выполняться до тех пор, пока при очередной его итерации размер текста до и после поиска и замены не останется равным. Это будет означать, что сдвоенных пробелов в тексте уже не осталось.

Две последние функции ещё более элементарны. Там просто вызывается наша функция по поиску и замене, которая меняет пробел на символ абзаца (^p) или наоборот. В последнем случае мы ещё и удаляем появившийся в конце текста из-за неубирающегося символа абзаца лишний пробел (^w — чистое пространство, например, пробелы или табуляция).

Сохраняем код, закрываем редактор Бейсика и сразу проверяем работу кнопок в документе. Замечу, что закрывать редактор Бейсика не обязательно, можно просто сохранить в нём изменения и переключиться в окно документа. Если кнопки заработали, как надо, сохраняем документ как шаблон с макросами (.dotm) в папку:

C:\Users\[ИмяПользователя]\AppData\Roaming\Microsoft\Word\STARTUP

Теперь добавим нашу надстройку. Закрываем всё, открываем Word, лезем в Файл -> Параметры -> Надстройки -> Управление, выбираем «Надстройки Word» и нажимаем кнопку «Перейти». В открывшемся окне на первой же вкладке нажимаем «Добавить…» и выбираем наш файл. Нажимаем «ОК», и наша надстройка начинает действовать.

четверг, 5 марта 2015 г.

Урок 9. Выполнение действия по нажатию кнопки.

На прошлом уроке мы познакомились с написанием функций для динамического возвращения значений атрибутов. Теперь мы напишем функцию, которая будет выполняться при нажатии на кнопку. Если мы рассмотрим все предлагаемые для button атрибуты, то увидим атрибут onAction. Именно в этом атрибуте и указывается функция, которая будет выполняться при нажатии на эту кнопку.

Добавим кнопке атрибут:

onAction="ОтобразитьПриветствие"

Сгенерируем шаблоны функций (Alt+F11), проконтролируем текущую раскладку, чтобы была русская, и скопируем в буфер шаблон для функции «ОтобразитьПриветствие». Затем закроем окно, запустим документ на выполнение, нажмём в Word Alt+F11, и вставим скопированное рядом нашей предыдущей с функцией. Внутри функции пишем команду вывода сообщения:

MsgBox "Приветствую тебя, мой повелитель!"

Сохраняем, всё закрываем, затем снова запускаем документ. Нажимаем на кнопку и получаем удовольствие.

Вместо вывода сообщения можно вызвать любую имеющуюся в Word команду. Выше я упоминал, что штатной кнопке нельзя присвоить внешнее изображение. Но можно создать свою кнопку, присвоить ей внешнее изображение, а в onAction прописать команду, выполняющуюся при нажатии штатной кнопки.

Давайте повесим на нашу кнопку команду открытия редактора Бейсика. Запускаем документ, переходим в редактор Бейсика, и правим наши функции. Сначала в функции «Поприветствовать» меняем название кнопки на, например, «Открыть редактор Бейсика» (можем изменить и имя самой функции, но тогда надо не забыть поменять его также и в атрибуте onAction). Затем в функции «ОтобразитьПриветствие» комментируем апострофам строку вывода приветствия, и пишем вместо неё строку:

ShowVisualBasicEditor = True

Сохраняем, закрываем редактор Бейсика, нажимаем на кнопку и… снова оказываемся в редакторе! Всё, как и задумывалось!

Теперь, вопрос: откуда я узнал, что редактор Бейсика открывается именно так? Всё очень просто. Для того, чтобы узнать, как программно проделать те или иные действия, можно штатными средствами Word просто создать макрос, и записав в него нужную последовательность действий, открыть его код и скопировать в нашу функцию. При этом не всегда стоит копировать код бездумно. Как правило, полученные макросы можно уточнить, убрать из них лишнее и т.п.

Замечу, что обучение записи макросов и программированию на VBA не входит в задачи наших уроков, но всё это очень легко осваивается самостоятельно. Особенно запись макросов. Для неё даже предусмотрена группа «Макросы» на вкладке «Вид» или группа «Код» с кнопкой «Запись макроса» на вкладке «Разработчик».

На сегодня закончим. В следующем уроке мы перейдём к важной теме - созданию надстроек.