понедельник, 11 января 2010 г.

Вставка картинок в документ из выбранной папки

Я разработал шаблон, упрощающий процедуру вставки в документ изображений из указанной папки. При загрузке шаблона появляется дополнительная группа на вкладке «Вставка» Возможности:
  1. Выбор папки, из которой нужно часто вставлять изображения.
  2. Просмотр эскизов изображений в галерее.
  3. Обрабатываются (пока) только изображения форматов: "png", "jpg", "jpeg", "bmp", "gif".
  4. Всплывающая подсказка к каждому изображению содержит имя файла, размеры изображения и разрешение по горизонтали и по вертикали.
  5. Вставка изображений в заданном режиме: в текст или с обтеканием.
  6. Автоматическая вставка названия к изображению с нумерацией или без.
  7. Автоматическая вставка имени файла в название к изображению.
В раскрытом виде галерея может выглядеть так: Галерея имеет фиксированное количество столбцов (5), количество строк зависит от количества изображений в выбранной папке. Скачать шаблон можно отсюда С точки зрения работы с лентой, этот шаблон интересен несколькими моментами. Во-первых, в нём реализована загрузка на ленту не только изображений bmp, но и других форматов. Это стало возможным благодаря использованию функций GDI+. За основу взяты примеры для книги RibbonX: Customizing the Office 2007 Ribbon, которые можно скачать отсюда Дело в том, что для отображения на ленте Office понимает только один формат изображения IPictureDisp. Получить этот формат изображения из файла можно функцией LoadPicture. Но она может загружать только изображения bmp. В шаблоне используется похожая функция LoadImage, описанная в модуле GDIPlusAPI. Код модуля выглядит так: 
    1 
    2 
    3 
    4 
    5 
    6 
    7 
    8 
    9 
   10 
   11 
   12 
   13 
   14 
   15 
   16 
   17 
   18 
   19 
   20 
   21 
   22 
   23 
   24 
   25 
   26 
   27 
   28 
   29 
   30 
   31 
   32 
   33 
   34 
   35 
   36 
   37 
   38 
   39 
   40 
   41 
   42 
   43 
   44 
   45 
   46 
   47 
   48 
   49 
   50 
   51 
   52 
   53 
   54 
   55 
   56 
   57 
   58 
   59 
   60 
   61 
   62 
   63 
   64 
   65 
   66 
   67 
   68 
   69 
   70 
   71 
   72 
   73 
   74 
   75 
   76 
   77 
   78 
   79 
   80 
   81 
   82 
   83 
   84 
   85 
   86 
   87 
   88 
   89 
   90 
   91 
   92 
   93 
   94 
   95 
   96 
   97 
   98 
   99 
  100 
  101 
  102 
  103 
  104 
  105 
  106 
  107 
  108 
  109 
  110 
  111 
  112 
  113 
  114 
  115 
  116 
  117 
  118 
  119 
  120 
  121 
  122 
  123 
  124 
  125 
  126 
  127 
  128 

Attribute VB_Name = "GDIPlusAPI"
Option Private Module
Option Explicit

Public Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
Public Declare Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal filename As Long, bitmap As Long) As GpStatus
Public Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As GpStatus
Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus
Public Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Public Declare Function GdipGetImageDimension Lib "gdiplus" (ByVal image As Long, Width As Single, Height As Single) As GpStatus
Public Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As GpStatus
Public Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As GpStatus
Public Declare Function GdipGetImageHorizontalResolution Lib "gdiplus" (ByVal image As Long, resolution As Single) As GpStatus
Public Declare Function GdipGetImageVerticalResolution Lib "gdiplus" (ByVal image As Long, resolution As Single) As GpStatus
Public 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 GpStatus
Public Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, image As Long) As GpStatus

Public Enum GpStatus
  OK = 0
  GenericError = 1
  InvalidParameter = 2
  OutOfMemory = 3
  ObjectBusy = 4
  InsufficientBuffer = 5
  NotImplemented = 6
  Win32Error = 7
  WrongState = 8
  Aborted = 9
  FileNotFound = 10
  ValueOverflow = 11
  AccessDenied = 12
  UnknownImageFormat = 13
  FontFamilyNotFound = 14
  FontStyleNotFound = 15
  NotTrueTypeFont = 16
  UnsupportedGdiplusVersion = 17
  GdiplusNotInitialized = 18
  PropertyNotFound = 19
  PropertyNotSupported = 20
End Enum

Public Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

Public Type PICTDESC
  Size As Long
  Type As Long
  hPic As Long
  hPal As Long
End Type

Public Type GdiplusStartupInput
  GdiplusVersion As Long
  DebugEventCallback As Long
  SuppressBackgroundThread As Long
  SuppressExternalCodecs As Long
End Type


Public Function LoadImage(ByVal strFName As String) As IPicture
  Dim uGdiInput As GdiplusStartupInput
  Dim hGdiPlus As Long
  Dim hGdiImage As Long
  Dim hBitmap As Long
  Dim imgThumb As Long
  Dim imgHeight As Single, imgWidth As Single
  uGdiInput.GdiplusVersion = 1

  'Запускаем GDI+
  If GdiplusStartup(hGdiPlus, uGdiInput) = OK Then
    'Создаём изображение в памяти
    If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = OK Then
      'Получаем размеры изображения
      Call GdipGetImageDimension(hGdiImage, imgWidth, imgHeight)
      'Делаем из изображения уменьшенное
      Call GdipGetImageThumbnail(hGdiImage, ItemWidth, ItemWidth * imgHeight / imgWidth, imgThumb)
      'Указатель на изображение
      Call GdipCreateHBITMAPFromBitmap(imgThumb, hBitmap, 0)
      'Конвертируем изображение в IPicture
      Set LoadImage = ConvertToIPicture(hBitmap)
      GdipDisposeImage hGdiImage
    End If
    GdiplusShutdown hGdiPlus
  Else
    MsgBox "Ошибка при загрузке GDI+!", vbCritical
  End If

End Function

Public 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
Загрузка изображений происходит в модуле RibbonCallbacks в процедуре getItemImage, которая, в свою очередь, определена в XML-схеме для галереи.
   68 
   69 
   70 
   71 
   72 
'galleryImagesFromFolder (компонент: gallery, атрибут: getItemImage)
Sub getItemImage(control As IRibbonControl, index As Integer, ByRef image)
  If ImagesCount = 0 Then Exit Sub
  Set image = LoadImage(arImagePaths(index))
End Sub
В этой процедуре arImagePaths — массив с путями к файлам изображений, index — номер элемента в галерее. Во-вторых, на примере данного шаблона можно понять как работает механизм изменения состояния одних элементов ленты в зависимости от состояния других. Начнём с XML-схемы трёх флажков, расположенных в правой части группы, которые определяют правила вставки названия к вставляемому изображению. 
   51 
   52 
   53 
   54 
   55 
   56 
   57 
   58 
   59 
   60 
   61 
   62 
   63 
   64 
   65 
   66 
   67 
     <!-- Разделитель группы -->
     <separator id="sep1" />
     <checkBox id="chbInsertImageWithCaption"
          label="Вставлять название"
          supertip="Установите этот флажок, чтобы автоматически вставлять подпись к вставляемому рисунку."
          onAction="chb_onAction" />
     <checkBox id="chbUsePathInCaption"
          label="Имя файла в названии"
          supertip="Установите этот флажок, чтобы подпись к вставляемому рисунку содержала имя файла рисунка."
          getEnabled="getEnabled"
          onAction="chb_onAction" />
     <checkBox id="chbNumberImage"
          label="Нумеровать изображение"
          supertip="Установите этот флажок, чтобы автоматически нумеровать вставляемое изображение."
          getPressed="chb_getPressed"
          getEnabled="getEnabled"
          onAction="chb_onAction" />
У всех трёх флажков определён один общий динамический атрибут onAction, определяющий процедуру, которая выполняется при клике на соответствующем флажке. Двум последним флажкам задан атрибут getEnabled, определяющий процедуру, изменяющую активность этих флажков. Активность этих флажков меняется в зависимости от состояния первого флажка. И, наконец, у третьего флажка задан атрибут getPressed, определяющий процедуру, изменяющую состояние флажка. Теперь посмотрим, как это реализовано в VBA:
Копировать код без номеров строк
29 'galleryImagesFromFolder (компонент: gallery, атрибут: getEnabled) 30 'chbUsePathInCaption (компонент: checkBox, атрибут: getEnabled) 31 'chbUsePathInCaption (компонент: checkBox, атрибут: onAction) 32 'chbNumberImage (компонент: checkBox, атрибут: getEnabled) 33 Sub getEnabled(control As IRibbonControl, ByRef enabled) 34 Select Case control.ID 35 Case "chbUsePathInCaption" 36 enabled = chbInsertImageWithCaptionChecked 37 Case "chbNumberImage" 38 enabled = chbInsertImageWithCaptionChecked 39 Case Else 40 enabled = CBool(ImagesCount) 41 End Select 42 End Sub
Эта процедура при помощи селективного оператора определяет состояние какого элемента ленты нужно установить и присваивает ему значение соответствующей глобальной переменной. 
  110 
  111 
  112 
  113 
  114 
  115 
  116 
  117 
  118 
  119 
  120 
  121 
  122 
  123 
  124 
  125 
  126 
  127 
  128 
'chbInsertImageWithCaption (компонент: checkBox, атрибут: onAction)
'chbUsePathInCaption (компонент: checkBox, атрибут: onAction)
'chbNumberImage (компонент: checkBox, атрибут: getPressed)
Sub chb_onAction(control As IRibbonControl, pressed As Boolean)
  Select Case control.ID
    Case "chbUsePathInCaption"
      chbUsePathInCaptionChecked = pressed
    Case "chbNumberImage"
      chbNumberImageChecked = pressed
    Case "chbInsertImageWithCaption"
      chbInsertImageWithCaptionChecked = pressed
      If Not myRibbon Is Nothing Then
        myRibbon.InvalidateControl "chbUsePathInCaption"
        myRibbon.InvalidateControl "chbNumberImage"
      Else
        MsgBox "Связь с пользовательским интерфейсом customUI утеряна. Попробуйте переоткрыть документ, или переподключить шаблон", vbInformation + vbOKOnly
      End If
  End Select
End Sub
В этой процедуре, также с помощью селективного оператора, определяется флажок, на котором щёлкнул пользователь и состояние этого флажка, переданное параметром pressed, записывается в соответствующую глобальную переменную. Кроме того, если сработал первый флажок, то обновляется состояние остальных двух.
  140 
  141 
  142 
  143 
'chbNumberImage (компонент: checkBox, атрибут: getPressed)
Sub chb_getPressed(control As IRibbonControl, ByRef returnValue)
  returnValue = chbNumberImageChecked
End Sub
Здесь всё просто: состояние флажка, на которое ссылается переменная returnedValue, устанавливается в соответствии со значением глобальной переменной. Здесь не используется селективный оператор, поскольку эта процедура вызывается только для одного флажка. Замечания и пожелания приветствуются.
Автор: на 1 комментарий :
Подписаться на: Сообщения ( Atom )