Boris Zulin
Начиная с версии 9.0, CorelDRAW поддерживает скрипты VBA (лицензировано у Microsoft). Программисты, знакомые с VBA по пакету MS Office без проблем смогут приступить к программированию и в CorelDRAW.
Рассмотрим примеры написания полезных в дизайне программ и разберём механизм их работы. В качестве иллюстрации будем использовать последнюю на момент обновления статью версию Corel Draw 12. Для удобства использования создадим новый модуль макросов. В папке "C:\Program Files\Corel\Corel Graphics 12\Draw\GMS\" создайте пустой файл с именем cdrTools.gms [3]. Загрузите Corel Draw, вызовите редактор VBA командой Tools/Visual Basic/Visual Basic editor... (Alt+F11). В окне Projects выберите GlobalMacros (cdrTools.gms), в окне свойств или с помощью контекстной команды Properties задайте имя проекта Tools. В контекстном меню командой Insert/Module создайте область записи кода. Теперь приступим к написанию кода. При необходимости раскройте окно редактора для удобства работы. Процедуры ниже чередуются с описанием. Скопируйте текст подпрограмм в редактор и сохраните командой File/Save (Ctrl+S). Хочу обратить ваше внимание, что в Windows 2000/XP модуль можно сохранить в профиль пользователя (C:\Documents and Settings\имя\Application Data\Corel\Graphics12\User Draw\GMS\), из-за чего этот модуль будет доступен только данному пользователю и пользователь сможет этот модуль изменять. Модули, размещенные в папке Program Files доступны для редактирования по умолчанию только для администраторов и опытных пользователей.
Первая строка модуля с оператором Option Explicit определяет явное описание всех переменных, что позволяет уменьшить количество ошибок. Подпрограмма DistributeButt используется для размещения выделенных объектов встык (горизонтально или вертикально). Ранее для позиционирования использовался следующий метод: создавалась дополнительная линия (горизонтальная или вертикальная), выравнивалась с первым объектом по правому краю, а другой объект выравнивался с ней по левому. Затем линия уничтожалась. Подпрограмма перебирает все объекты, которые были выделены, начиная с последнего выделенного (соблюдается концепция CorelDRAW изменения свойств по последнему выделенному объекту), устанавливая позицию каждого следующего как позиция предыдущего плюс размер предыдущего объекта. Для вызова с помощью кнопок на панелях инструментов или с помощью меню создаём две дополнительные подпрограммы - DistributeButtVertical и DistributeButtHorizontal. Обращаю ваше внимание, что в VBA описание типа в операторе DIM производится для каждой переменной. Для эффективной работы применяется цикл For Each ... In ... : Next, который перебирает все указанные объекты. В основной процедуре в строках 12-17 описываем переменные и их типы, далее определяем количество выделенных объектов и прерываем процедуру с сообщением о невозможности выполнения, если выделено менее двух объектов. В строке 24 задаём начало группы команд, группа определяется как одно действие для команд отмены/повтора и её название выводится в списке отмены действий. Далее, перебирая в цикле выделенные объекты устанавливаем координаты начала каждого следующего объекта равной координате конца предыдущего.
| 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 |
| 31 |
| 32 |
| 33 |
| 34 |
| 35 |
| 36 |
| 37 |
| 38 |
| 39 |
| 40 | |
|
| Option Explicit |
| |
| Public Sub DistributeButtVertical() |
| DistributeButt (False) |
| End Sub |
| |
| Public Sub DistributeButtHorizontal() |
| DistributeButt (True) |
| End Sub |
| |
| Public Sub DistributeButt(Horizontal As Boolean) |
| Dim X As Double, Y As Double |
| Dim NumObjs As Long |
| Dim s As Shape |
| Dim First As Boolean |
| Dim i As Integer |
| Dim d As Document |
| Set d = ActiveDocument |
| NumObjs = d.Selection.Shapes.Count |
| If NumObjs < 2 Then |
| i = MsgBox("You should select s few objects first", vbOKOnly, "Distributing") |
| Exit Sub |
| End If |
| d.BeginCommandGroup "Distribute" |
| First = True |
| For Each s In d.Selection.Shapes |
| If Not First Then |
| If Horizontal Then |
| s.PositionX = X |
| Else |
| s.PositionY = Y |
| End If |
| End If |
| X = s.PositionX + s.SizeWidth |
| Y = s.PositionY - s.SizeHeight |
| First = False |
| Next s |
| d.EndCommandGroup |
| End Sub | |
Для удобства желательно вынести кнопки для вызова макроса на панель управления и/или назначить клавиши быстрого запуска. Я вынес кнопки на панель и нарисовал следующие кнопки (изображения кнопок в версии 12 сохраняются в DRAWUIConfig.xml, ранее записывались в cdrbars.cfg): 
. Вынести кнопки вызова на панель задач и изменить рисунки на них можно командой Tools/Options . На закладке General окна, показанного на рисунке ниже, в поле Tooltip Help задайте строку "Разместить встык вертикально" и для второй процедуры соответственно - "Разместить встык горизонтально".
Следующая процедура предназначена для конвертирования текстовых блоков, созданных в ранних версиях с использованием шрифтов, не поддерживающих Unicode. В этом случае все символы располагаются в таблице с номерами 1..255. При использовании современных шрифтов вместо символов кириллицы обычно отображаются дополнительные символы европейских алфавитов. Подпрограмма перебирает (строка 14) все символы во всех текстовых блоках (строка 13). Из перекодировки исключаются символьные элементы (строка 15). Так как рассматриваются коды символов в кодировке Unicode, и каждый символ имеет размер два байта, то используются соответственно функции AscW и ChrW$. После каждого преобразования для символа устанавливаются свойства, соответствующие русскому языку.
| 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 |
| 31 |
| 32 |
| 33 |
| 34 |
| 35 |
| 36 |
| 37 |
| 38 |
| 39 |
| 40 |
| 41 |
| 42 |
| 43 |
| 44 | |
|
| Public Sub ConvertRussianUnicode() |
| ' Description: Конвертирует ASCII текст в кириллицу UNICODE |
| ' |
| Dim T As Text |
| Dim s As Shape |
| Dim d As Document |
| Dim i As Integer, N As Integer |
| Dim C As TextRange |
| Set d = ActiveDocument |
| 'Устанавливаем начало группы для команды отмены |
| d.BeginCommandGroup "Convert Russian Text To Unicode" |
| 'Перебираем все текстовые элементы текущей страницы |
| For Each s In d.ActivePage.FindShapes(, cdrTextShape) |
| For Each C In s.Text.Story.Characters |
| If C.CharSet <> cdrCharSetSymbol Then |
| N = AscW(C.WideText) |
| Select Case N |
| Case 165 |
| C.WideText = ChrW$(1168): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'Ґ |
| Case 168 |
| C.WideText = ChrW$(1025): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'Ё |
| Case 170 |
| C.WideText = ChrW$(1028): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'Є |
| Case 175 |
| C.WideText = ChrW$(1031): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'Ї |
| Case 178 |
| C.WideText = ChrW$(1030): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'І |
| Case 179 |
| C.WideText = ChrW$(1110): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'і |
| Case 180 |
| C.WideText = ChrW$(1169): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'ґ |
| Case 184 |
| C.WideText = ChrW$(1105): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'ё |
| Case 186 |
| C.WideText = ChrW$(1108): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'є |
| Case 191 To 255 |
| C.WideText = ChrW$(N + 848): C.CharSet = cdrCharSetRussian: C.LanguageID = cdrRussian 'А-я |
| End Select |
| End If |
| Next C |
| Next s |
| d.EndCommandGroup |
| End Sub | |
Для удобства редактирования желательно различные смысловые составляющие разнести на разные слои. Обычно удобно разместить слои в последовательности (снизу вверх): подложка, основной рисунок, осевые линии, текст. Для автоматизации обработки старых рисунков написана подпрограмма, создающая в случае отсутствия верхний текстовый слой и переносящая на него текстовые объекты текущей страницы. Объекты, находящиеся за пределами страницы рассматриваются как вспомогательные заготовки и на слой подпрограммой игнорируются.
| 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 |
| 31 |
| 32 |
| 33 |
| 34 |
| 35 |
| 36 |
| 37 |
| 38 | |
|
| Sub TextLayer() |
| ' Description: Перемещает весь текст на отдельный слой |
| ' Примечание : Перемещаются ТОЛЬКО объекты текущей страницы |
| ' |
| Dim d As Document |
| Dim p As Page |
| Dim Lr As Layer |
| Dim lr1 As Layer |
| Dim N As Integer |
| Dim s As Shape |
| Set d = ActiveDocument |
| d.BeginCommandGroup "Text Layer" |
| 'Определить, существует ли уже слой Text, если нет, то создать |
| Set p = ActiveDocument.ActivePage |
| N = -1 |
| For Each Lr In p.Layers |
| If Lr.Name = "Text" Then |
| N = Lr.Index |
| lr1 = Lr |
| Exit For |
| End If |
| Next Lr |
| If N < 0 Then |
| Set lr1 = p.CreateLayer("Text") |
| N = lr1.Index |
| End If |
| 'Перебрать все слои, кроме текстового и перенести все текстовые объекты |
| For Each Lr In p.Layers |
| If (Lr.Name <> "Text") And (Lr.Name <> "Текст") Then |
| For Each s In p.FindShapes(, cdrTextShape) |
| s.MoveToLayer lr1 |
| Next s |
| End If |
| Next Lr |
| lr1.Editable = True |
| d.EndCommandGroup |
| End Sub | |
Ссылки по теме
