Андрей Бреслав
(Материалы проверены с Borland Delphi v5.0 Enterprise UP1)
Как мы знаем из истории, промышленный переворот происходит тогда, когда люди переходят к производству средств производства. Это занятие применительно к Delphi — не есть осознанная необходимость, но есть весьма полезное в практике умение, позволяющее не падать духом при виде несовершенства того, что уже написали программисты Borland или третьих фирм.
Итак, с чего начинается проектирование
визуальных (и не только визуальных) компонент для
Delphi? В принципе — со знания Object Pascal, но коль скоро
это само собой разумеется, то создадим новый
пакет (
File/New/Package(Object Repository/New))
назовём его как понравится, скажем, custom.dpk, в 
опциях проекта установим описаниe (Description): "Custom
components", сохраним. Дальнейшая работа будет
проходить в пределах этого пакета — так удобнее
локализовать данные.
Скажем немного о пакетах в Delphi. Пакет — это логическая единица (модуль, физически — файл), содержащая ссылки на другие модули и интегрируемая (устанавливаемя) в IDE при компиляции (Component/Install packages). Проще говоря, просто сборник файлов, компилируемых вместе и доступных во время проектирования. Наш пакет будет содержать файл с исходным кодом компоненты и два файла для среды: регистрационный модуль и ресурс (Delphi Component Resource — *.dcr).
Теперь создаём новый компонент (Component/New component), задаём родительский класс (Ancestor type) TComponent, имя класса (Class name) TMgsBox(это связано с характером проекта), страницу на палитре компонент (Palette page) Custom, сохраняем модуль в той же директории, где и пакет (не обязательно, но удобно) под именем, скажем, MsgBox.pas.
И получаем в итоге следующий код:
| unit MsgBox; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type TMsgBox = class(TComponent) private { Private declarations } protected { Protected declarations } public { Public declarations } published { Published declarations } end; procedure Register; implementation procedure Register; begin RegisterComponents('Custom', [TMsgBox]); end; end. |
О сути увиденного мы будем говорить в
самом конце, а сейчас не забудем 
добавить созданный файл в
пакет и сообразим всё-таки, какого же чёрта мы
будем делать.
Собственно, какую компоненту мы будем создавать? Класс мы наследовали от TComponent, это говорит о том, что наша первая компонента будет невизуальной, она просто будет оболочкой на функции MessageBox из глубин Win32 API. По чести сказать, глубокого практического смысла в такой компоненте нет, более того, нерационально писать компоненту ради оболочки на функцию — она занимает в стеке много больше места, однако мы возьмём эту задачу, как удобную для примера.
Функция MessageBox, экспортируемая из библиотеки user32.dll, имеет сигнатуру
function MessageBox(hWnh: HWND; lpText: PChar; lpCaption: PChar; uType: Cardinal): Integer;
и занимается выводом на экран сообщений типа
что очень полезно любой программе. Она обладает кандовым Borland'овским аналогом MessageDlg, но он уж очень левый, и к тому же кнопки подписывает всегда по-английски, а не на языке ОС.
Параметры функции MessageBox |
|
| hWnd | Идентификатор вызывающего окна — удобно ставить в Application.Handle |
| lpText | Указатель на строку с сообщением |
| lpCaption | Указатель на строку с заголовком |
| uType | Флаги (сумма целых констант), задающие поведение и содержание окна |
Значение uType — сумма следующих констант: |
|
| MB_ABORTRETRYIGNORE | The message box contains three push buttons: Abort, Retry, and Ignore. |
| MB_OK | The message box contains one push button: OK. This is the default. |
| MB_OKCANCEL | The message box contains two push buttons: OK and Cancel. |
| MB_RETRYCANCEL | The message box contains two push buttons: Retry and Cancel. |
| MB_YESNO | The message box contains two push buttons: Yes and No. |
| MB_YESNOCANCEL | The message box contains three push buttons: Yes, No, and Cancel. |
| MB_ICONEXCLAMATION | An exclamation-point icon appears in the message box. |
| MB_ICONWARNING | An exclamation-point icon appears in the message box. |
| MB_ICONINFORMATION | An icon consisting of a lowercase letter i in a circle appears in the message box. |
| MB_ICONASTERISK | An icon consisting of a lowercase letter i in a circle appears in the message box. |
| MB_ICONQUESTION | A question-mark icon appears in the message box. |
| MB_ICONSTOP | A stop-sign icon appears in the message box. |
| MB_ICONERROR | A stop-sign icon appears in the message box. |
| MB_ICONHAND | A stop-sign icon appears in the message box. |
| MB_DEFBUTTON1 | The first button is the default button. MB_DEFBUTTON1 is the default unless MB_DEFBUTTON2, MB_DEFBUTTON3, or MB_DEFBUTTON4 is specified. |
| MB_DEFBUTTON2 | The second button is the default button. |
| MB_DEFBUTTON3 | The third button is the default button. |
| MB_DEFBUTTON4 | The fourth button is the default button. |
| MB_APPLMODAL | The user must respond to the message box before continuing work in the window identified by the hWnd parameter. However, the user can move to the windows of other applications and work in those windows. Depending on the hierarchy of windows in the application, the user may be able to move to other windows within the application. All child windows of the parent of the message box are automatically disabled, but popup windows are not.MB_APPLMODAL is the default if neither MB_SYSTEMMODAL nor MB_TASKMODAL is specified. |
| MB_SYSTEMMODAL | Same as MB_APPLMODAL except that the message box has the WS_EX_TOPMOST style. Use system-modal message boxes to notify the user of serious, potentially damaging errors that require immediate attention (for example, running out of memory). This flag has no effect on the user's ability to interact with windows other than those associated with hWnd. |
| MB_TASKMODAL | Same as MB_APPLMODAL except that all the top-level windows belonging to the current task are disabled if the hWnd parameter is NULL. Use this flag when the calling application or library does not have a window handle available but still needs to prevent input to other windows in the current application without suspending other applications. |
| MB_DEFAULT_DESKTOP_ONLY | The desktop currently receiving input must be a default desktop; otherwise, the function fails. A default desktop is one an application runs on after the user has logged on. |
| MB_HELP | Adds a Help button to the message box. Choosing the Help button or pressing F1 generates a Help event. |
| MB_RIGHT | The text is right-justified. |
| MB_RTLREADING | Displays message and caption text using right-to-left reading order on Hebrew and Arabic systems. |
| MB_SETFOREGROUND | The message box becomes the foreground window. Internally, Windows calls the SetForegroundWindow function for the message box. |
| MB_TOPMOST | The message box is created with the WS_EX_TOPMOST window style. |
Остальные флаги — только для Windows NT |
|
Возвращаемые значения функции MessageBox |
|
| IDABORT | Abort button was selected. |
| IDCANCEL | Cancel button was selected. |
| IDIGNORE | Ignore button was selected. |
| IDNO | No button was selected. |
| IDOK | OK button was selected. |
| IDRETRY | Retry button was selected. |
| IDYES | Yes button was selected. |
Как видно, эта функция тоже не отличается особенным изяществом, но всё же будет весьма полезно её освоить.
С чего начнём? С концепции интерфейса нашей компоненты: нам нужно задать функции все четыре её параметра через поля объекта. Пишем:
| protected { Protected declarations } |
|
| fhWnd: HWND; | //Ссылка на окно |
| fCaption: String; | //Заголовок окна |
| fText: String; | //Текст сообщения |
| fFlags: Integer; | //Флаги |
Задаём эти поля как protected из уважения к несчастным, желающим что-нибудь наследовать от нашего объекта. Далее сразу устанавливаем свойства (properties), соответсвующие этим полям.
Свойства (properties) объекта — это особое представление полей, для которого заданы определённый способ чтения и записи, а также другие интересные вещи. Только свойства (к которым относятся и события (events)) могут отображаться в Object Inspector. Да и то только те, которые описаны в разделе published и не являются свойствами только для чтения (read only). Для таких свойств генерируется RTTI (RunTime type information), о которой желающие могут почитать Help к Delphi на слово "published".
Свойство декларируется ключевым словом property
| published {Published declarations} |
|
| property hWnd: HWND read fhWnd write fhWnd default 1; | //Ссылка на окно |
| property Caption: String read fCaption write fCaption; | //Заголовок окна |
| property Text: String read fText write fText; | //Текст сообщения |
property Flags: DWord read fFlags write fFlags default MB_APPLMODAL+MB_OK+MB_ICONERROR; |
//Флаги |
Как видно, тип свойства необходимо указывать, как и тип поля (кроме наследуемых свойств, о которых скажем чуть ниже). Далее: за ключевым словом read указываем идентификатор поля или метода на запись свойства; метод должен быть процедурой, получающей параметр одного с полем типа. За ключевым словом write указываем идентификатор поля или метода на чтение объекта; метод должен быть функцией, возвращающей значение одного со свойством типа. Одна из этих директив может быть опущена, и тогда значение в поле нельзя будет читать или писать извне (свойство уже не попадёт в Object Inspector), того же эффекта можно добиться и создав пустой метод: тогда, если Delphi будет в хорошем настроении, сойство в Object Inspector попадёт.
Для этих четырёх полей свойства заданы лишь для удобства во время проектирования, но вообще — это очень удобный, как мы увидим ниже, механизм.
Теперь займёмся наследованными от родительского класса методами и свойствами. Собственно, нас интересуют конструктор, деструктор и published свойства нашего объекта. Таких свойств всего два (посмотрите Help): Name и Tag, их можно не указывать как наследованные, они отобразятся в Object Inspector и так, но если бы мы наследовали наш объект, скажем, от TActionList, то его свойство Images необходимо было бы внести в раздел published:
| published {Published declarations} |
|
| property Images; | //Не указывая ни тип, ни атрибуты чтения/записи — они указаны в родительском классе. |
К такому свойству можно добавлять не указанные в родительском классе директивы (например default).
Теперь перейдём к методам, и в первую очередь — к конструктору. Наш конструктор не должен делать ничего выдающегося — просто создать экземпляр объекта. Но это неинтересно! И мы создадим ещё один конструктор: он создаёт обект с уже заданными свойствами Text,Caption и Flags и может сразу показать диалог. Надо сказать, что, если мы хотим использовать объект как компоненту, то сигнатура его конструктора (хотя бы одного) должна соответствовать стандартной:
constructor Create(AOwner: TComponent);
если хочется обязательно включить туда другие параметры, то AOwner должен остаться первым, а другие — быть необязательными:
constructor Create(AOwner: TComponent; Param1: Integer = 0; Param2: String = '');
Нам незачем переписывать конструктор со стандартной сигнатурой, наследованный нами от класса TComponent, а другому мы просто изменим имя.
| public {Public declarations} constructor CreateShow(AOwner: TComponent; Msg, Cpt: String; Flags: Integer = 0; Show: Boolean = false); |
Деструктор мы вообще трогать не будем — убьёт объект, и пусть.
Реализуем конструкторы:
| public {Public declarations} constructor Create(AOwner: TComponent); override; constructor CreateShow(AOwner: TComponent; Msg, Cpt: String; Flags: Integer = 0; Show: Boolean = false); |
| {...} |
| constructor TMsgBox.Create(AOwner: TComponent); begin inherited Create(AOwner); fFlags:= MB_APPLMODAL+MB_OK+MB_ICONERROR; fhWnd:= 1; end; |
| constructor TMsgBox.CreateShow(AOwner: TComponent; Msg, Cpt: String; Flags: Integer = 0; Show: Boolean = false); |
| begin Create(AOwner); fText:= Msg; fCaption:= Cpt; fFlags:= Flags; if Show then Execute; end; |
В коде конструктора мы забежали вперёд: мы не декларировали пока функцию Execute, но у нас всё ещё впереди...
Теперь займёмся реализаций рабочей части объекта. Собственно, об интересующем пользователя в первую очередь методе уже сказано: это функция Execute, возвращающая Boolean. Так, какое Boolean — это хитро: мы введём ещё одно свойство — TrueResults, в котором будет лежать список возвращаемых MessageBox значений, в случае которых Execute возвращает true. Реализуем TrueResults поле DResult, содержащее возвращённое MessageBox значение:
| type ids = idOK..idHelp; TMBTRes = set of ids; {...} protected fDResult: Integer; //В действительности результат запросто укладывается в Byte, но уважим Borland fTrueResults: TMBTRes; public property DResult: Integer read fDresult; //Read Only! published property TrueResult: TMBTRes read fTrueResults write fTrueResults default [idOK, idYes]; |
Как видно, поле DResult представлено свойством только для чтения (ради того и свойство), и декларировано свойство в разделе public, чтобы не нагружать Delphi не нужной работой по проверке на RTTI совместимость. Не забудем внести в текст конструктора инициализацию свойств по умолчанию: fTrueResults:= [idOk, idYes].
Теперь реализуем главный метод объекта:
| public function Execute: Boolean; |
| {...} |
| function TMsgBox.Execute: Boolean; |
| begin fDResult:= MessageBox(fhWnd, PChar(fText), PChar(fCaption), fFlags); Result:= fDResult in fTrueResults; end; |
К этому методу мы ещё вернёмся...
Если обратиться к пункту 2, можно заметить, что все настройки делятся на 7 категорий
Задаём соответствующие свойства:
| published property Buttons: TMBBtns read GetButtons write SetButtons default btnOK; property Icon: TMBIcon read GetIcon write SetIcon default icoError; property DefaultButton: Integer read GetDefButton write SetDefButton default 1; property Modality: TMBModality read GetModality write SetModality default modApplModal; property Help: Boolean read GetHelp write SetHelp default false; property WinStyle: TMBWinStyle read GetWinStyle write SetWinStyle default []; property TextAttr: TMBTextAttr read GetTextAttr write SetTextAttr default []; |
Вносим в type до класса необходимые типы:
| type TMBBtns = (btnOK, btnOKCancel, btnAbortRetryIgnore, btnYesNo, btnYesNoCancel, btnRetryCancel); TMBTextAttr = set of (taRight, taRTLReading); TMBModality = (modApplModal, modSystemModal, modTaskModal); TMBWinStyles = (modSetForeground, modDefaultDesktopOnly, modTopMost); TMBWinStyle = set of TMBWinStyles; TMBIcon = (icoNone, icoError, icoQuestion, icoWarning, icoInfo); |
Вносим в private декларации методов, а в implementation — их реализации:
| private { Private declarations } function GetButtons: TMBBtns; procedure SetButtons(Value: TMBBtns); function GetIcon: TMBIcon; procedure SetIcon(Value: TMBIcon); function GetDefButton: Integer; procedure SetDefButton(Value: Integer); function GetModality: TMBModality; procedure SetModality(Value: TMBModality); function GetHelp: Boolean; procedure SetHelp(Value: Boolean); function GetWinStyle: TMBWinStyle; procedure SetWinStyle(Value: TMBWinStyle); function GetTextAttr: TMBTextAttr; procedure SetTextAttr(Value: TMBTextAttr); {...} implementation {...} function TMsgBox.GetButtons: TMBBtns; begin {...Код, возврщаем значение} end; procedure TMsgBox.SetButtons(Value: TMBBtns); begin {...Код, записываем значение в поле} end; {etc...} |
Код для этих подпрограмм довольно громоздкий и однообразный, желающие вникнуть, читайте моё Руководство по Булевой Алгебе и, если хочется, вникайте в исходники. В принципе, содержание их имеет опосредованное отношение к делу, скажу только, что все эти свойства читают и пишут в fFlags какой-нибудь бит, задающий то или другое свойство.
Итак, настал момент, когда, скопировав из исходников код, можно откомпилировать проект, однако сперва — главная интерфейсная задача: нарисуем компоненте иконку...
Это делается просто: из меню Tools (можно и из
меню ПУСК) запускаем 
Borland Image Editor. Там
выбираем пункт меню File/New.../Component Resource File(.dcr),
и сохраняем созданный ресурс в каталоге с
модулем и пакетом, под именем MsgBox.dcr. Теперь в
контекстном меню выбираем New/Bitmap, и видим вот
такой диалог:
главная задача — это выставить размер в 24x24, остальное — Ваше личное дело: хотите — 2, хотите — 256, а хотите — и 16 цветов, и воля для фантазии в рисовании... Созданную картинку называем командой Rename контекстного меню по имени компонента — TMSGBOX.
Теперь всё, что осталось — это включить в модуль директиву {$R}, добавляющую ресурс:
{$R *.dcr}
Теперь настало время 
удалить и пакета модуль, а потом снова добавить его — он
будет включен уже с ресурсом.
Острый момент — 
компилируем пакет... Если не
получилось — обратитесь к разработчику или
проверьтесь на исходниках.
Должно получиться следующее:
Появилась вкладка Custom (последняя) на политре компонент
На ней (если этой вкладки раньше не
было) одна 
пиктограмма — та, которую Вы
нарисовали, если поленились, Delphi использует 
значок по умолчанию
Компонента при добавлении к форме работает.
Теперь мы переходим к части, сулящей нам многократные компиляции и новые возможности. Собственно, возможностей две: контекстное меню для всей компоненты и редакторы её свойств. Ими и займёмся. Для этого создаём новый чистый модуль (File/New/Module(Object Repository/New)) и сохраняем его в каталоге с модулем MsgBox, под именем MsgReg.pas.
В этот модуль нужно перенести текст процедуры Register модуля MsgBox, не забыв включить MsgBox в раздел Uses. На будущее пропишем там модули времени проектирования — Dsgnintf и TypInfo, а также модули Classes, содержащий процедуры регистрации, Forms, Controls, Windows, Graphics, SysUtils, Dialogs — уверяю, они все нам пригодятся.
В IDE Delphi что-нибудь редактировать позволяют разные EDITOR'ы, за компоненты отвечают TComponentEditor и TDefaultEditor — с их помощью можно контролировать поведение компоненты при DblClick'е в IDE и формирование контекстного меню компоненты. Вообще, для понимания всего этого не мешает заглянуть в Help по теме Making components avalible at design time, ибо там описано (хотя и бестолково), кроме всего выше и ниже сказанного, ещё, например, добавление Help'а компоненте.
Собственно, TDefaultEditor происходит от TComponentEditor, но это вовсе не говорит о нём ничего хорошего. Это редактор для компонент, для которых не зарегистрирован никакой редактор: в контекстном меню ветер свищет, а по DblClick'у — редактирует OnClick, если нет, то OnChange, если нет, то OnCreate, если нет, то первое попавшееся событие. От него можно что-нибудь наследовать, если хочется по DblClick'у редактировать чей-нибудь обработчик.
TComponentEditor — родительский класс для всех редакторов компонент, предоставляет все вышеописанные возможности. Делается это так наследуем новый класс TMsgBoxEditor от TComponentEditor, и начинаем переопределять ему разные методы...
| TMsgBoxEditor = class(TComponentEditor) function GetVerbCount: Integer; override; function GetVerb(Index: Integer): String; override; procedure ExecuteVerb(Index: Integer); override; procedure Edit; override; end; |
За контекстное меню компоненты отвечают три метода класса TComponentEditor, в имени которых присутствует слово Verb (в принципе, это "глагол", но можно предположить, что "действие"):
Вот этих троих мы и переопределяем (в принципе, если концепция ясна, можно не придерживаться текста примера):
| function TMsgBoxEditor.GetVerbCount: Integer; begin Result:= 1; end; function TMsgBoxEditor.GetVerb(Index: Integer): String; begin case Index of 0: Result:= '&View message'; end; end; procedure TMsgBoxEditor.ExecuteVerb(Index: Integer); begin case Index of 0: //'&View message' TMsgBox(Component).Execute; end; end; |
Мы говорим среде, что в нашем меню один пункт, что зовут его View message и что по нажатию этого пункта следует запустить метод Execute редактируемой компоненты. Доступ к компоненте соуществляется через свойство Component класса TComponentEditor, естественно, для вызова специализированных методов надо сообщить объекту, что он TMsgBox, а не TComponent: TMsgBox(Component).
Регистрируем наш редактор процедуой RegisterComponentEditor, в процедуре Register:
| procedure Register; begin RegisterComponents('Custom', [TMsgBox]); RegisterComponentEditor(TMsgBox, TMsgBoxEditor); end; |
Теперь IDE знает, что для всех компонент TMsgBox нужно использовать редактор TMsgBoxEditor, а не TDefaultEditor.
| Итак, как и обещали, компиляция...
Контекстное меню должно выглядеть примерно так: (Вообще, удобно создать форму, добавить в неё компроненту и проверять на ней действенность...) При выборе первого пункта появляется диалог (на нём можно проверить, работают ли настройки). |
 |
За DblClick отвечает один-единственный метод Edit класса TComponentEditor — по сути, это обработчик события, и мы пишем:
Здесь мы по DblClick'у просто вызываем метод Execute (показываем диалог).
Снова компиляция, по DblClick'у — диалог.
Вот и весь редактор компоненты, можете добавить что-нибудь в меню, скажем стили для компоненты: "Ошибка", "Осторожно", "Вопрос" итд, присваивая соответсвующие значения свойствам.
Если вспомнить контекстное меню Object Inspector, можно вспомнить и то, что в секци Arrange есть пункт By category, и если его выбрать. получится очень неудобный список свойств. Несмотря на эту его особенность, находятся люди, использующие именно такое расположение. Оно основано на категориях свойств, их всего 12 и каждая представляет собой класс, в котором нужно зарегистрировать свойство.
| Название класса | Строка в Object Inspector | Описание |
|---|---|---|
| TActionCategory | Action | Разнообразные настройки времени выполнения: Enabled, Hint, Visible, HelpContext |
| TDatabaseCategory | Database | Всё, связанное с базами данных: DataBaseName, SQL, BeforeScroll, OnCalcFields |
| TDragNDropCategory | Drag, Drop and Docking | Всё про "оторви и брось:-)": DragKind, DragCursor, OnStartDrag |
| THelpCategory | Help and Hints | Всё про помощь итд: HelpContext, Hint, OnHelp |
| TLayoutCategory | Layout | Всё про отображение во время проектирования: Top, Left, Align, AutoScroll |
| TLegacyCategory | Legacy | Устаревшее: Ctl3D |
| TLinkageCategory | Linkage | Связи между компонентами: DataSource, DataSet, FileEdit |
| TLocaleCategory | Locale | Всё про локализацию в языковой среде: BiDiMode, taRTLReading |
| TLocalizableCategory | Localizable | То, что может меняться при локализации: всякие строки (Caption), размеры (Height, Width) и пр. |
| TMiscellaneousCategory | Miscellaneous | Всё, что не попало ни в какую другую категорию |
| TVisualCategory | Visual | Всё, что связано с отображением: Align, Visible, Autosize, BorderIcons |
| TInputCategory | Input | Всё, связанное с вводом: Enabled, ReadOnly, OnKeyPressed, OnClick |
Как видно, события тоже делятся на категории, а те в свою очередь перекрываются: Enabled встречается и как Action, и как Input.
Все категории-классы наследованы от TPropertyCategory, следовательно, от него (или от одного из вышеперечисленных) можно наследовать что-то своё. Повторяю, классификация такого рода кажется мне очень неудобной, однако, по категориям свойства легко скрыть, чтобы они не мешались в Object Inspector (тут актуальна категория Legacy), и вообще, полезно поддерживать все возможности, предоставляемые IDE.
Итак, большинство свойств нашего объекта относятся к визуальным категориям. Delphi большую их часть по незнанию отправит в категорию Miscellaneous. Надо сказать, что свойства могут регистрироваться в категориях глобально, то есть любое свойство сименем Enabled любой компоненты обязательно попадёт в категорию Action, потому что при регистрации его не был указан класс, для которого оно регистрировалось. Регистрация может осуществляться двумя путями, у которых есть "подпути":
Как видно, вариантов великое множество. Мы воспользуемся тем, что нужно в нашем случае: локальной регистрацией многих свойств. Снова процедура Register:
| procedure Register; begin RegisterComponents('Custom', [TMsgBox]); RegisterComponentEditor(TMsgBox, TMsgBoxEditor); RegisterPropertyInCategory(TCopyrightCategory, TMsgBox, 'About'); RegisterPropertiesInCategory(TVisualCategory, TMsgBox, ['Buttons', 'DefaultButton', 'WinStyle']); RegisterPropertiesInCategory(TLocalizableCategory, TMsgBox, ['TextAttr', 'Modality', 'Flags']); end; |
Третья строчка в теле процедуры повергает в смятение: не бывает ни свойства About у TMsgBox, ни категории TCopyrightCategory вообще. Это не страшно: сейчас они появятся.
Как понятно, наследовать новый класс мы будем от TPropertyCategory. Собственно, ничего особенного переопределять не придётся, нас интересует только то, что будет написано в Object Inspector. Мы пишем:
| TCopyrightCategory = class(TPropertyCategory) class function Name: String; override; end; {...} implementation {...} class function TCopyrightCategory.Name: String; begin Result:= 'Copyright, etc'; end; |
Отмечаю, что функция Name является атрибутом класса, а не объекта, что говорит о способе использования категорий самой IDE.
Вообще, ввести такую категорию, зарегистрировать глобально для всех свойств типа About, Copyright итд, а потом исключить из показываемых в Object Inspector может быть удобно.
Теперь добавим свойство About к нашему объекту (надо же как-то закрепить за собой авторство!).
| private {...} fAbout: String; {...} published {...} property About: String read fAbout write SetAbout; {...} implementation {...} constructor TMsgBox.Create(AOwner: TComponent); begin {...} fAbout:= 'TMsgBox by Andrew Breslav, 2000'; end; {...} procedure TMsgBox.SetAbout(Value: String); begin end; |
Применена хитрость, уже упоминавшаяся выше: чтобы свойство попало в Object Inspector, но его не могли редактировать нигде, создан пустой метод на запись SetAbout. К этому свойству мы ещё вернёмся.
Теперь, перед тем, как заняться редакторами свойств, допишем, наконец до конца нашу компоненту. Добавим три события: OnSuccess (если Execute = true), BeforeExecute и AfterExecute (до и после запуска) и свойство Dialog (показывать или не показывать диалог), а так же — модификацию свойства hWnd.
Событие — это свойство процедурного типа. Любое published-свойство, имеющее тип procedure(...) of object или function(...) of object, является событием. События, как правило, не имеют методов на чтение и запись — просто поля. Проверка на предмет, задан обработчик события или нет, осуществляется функцией Assigned(var P), возвращающей true, если задан, и false, если нет.
Итак, пишем:
| private {...} fOnSuccess: TNotifyEvent; fBExecute: TNotifyEvent; fAExecute: TNotifyEvent; {...} published {...} property OnSuccess: TNotifyEvent read fOnSuccess write fOnSuccess; property BeforeExecute: TNotifyEvent read fBExecute write fBExecute; property AfterExecute: TNotifyEvent read fAExecute write fAExecute; {...} implementation {...} function TMsgBox.Execute: Boolean; begin if Assigned(fBExecute) then fBExecute(Self); fDResult:= MessageBox(fhWnd, PChar(fText), PChar(fCaption), fFlags); Result:= fDResult in fTrueResults; if (Result) and (Assigned(fOnSuccess)) then fOnSuccess(Self); if Assigned(fAExecute) then fAExecute(Self); end; |
Зарегистрируйте события, как вам понравится, скажем в категории Action:
RegisterPropertiesInCategory(TActionCategory, TMsgBox, ['OnSuccess', 'BeforeExecute', 'AfterExecute']);
Не всегда оповещение должно быть визуальным, иногда нужен лишь звук. За звук в Windows API отвечает функция MessageBeep, параметром которой служат ICON-флаги функции MessageBox, этим и воспользуемся.
| private {...} fDialog: Boolean; {...} published {...} property Dialog: Boolean read fDialog write fDialog default true; {...} implementation {...} function TMsgBox.Execute: Boolean; var Wnd: THandle; i: Integer; begin if Assigned(fBExecute) then fBExecute(Self); if not fDialog then begin if GetIcon = icoNone then i:= MB_OK else i:= 16*GetNumBit(fFlags, 2); MessageBeep(i); end else begin Wnd:= fhWnd; if fhWnd <= 32 then case fhWnd of 1: Wnd:= Application.Handle; 2: Wnd:= GetDesktopWindow; end; fDResult:= MessageBox(Wnd, PChar(fText), PChar(fCaption), fFlags); end; Result:= fDResult in fTrueResults; if (Result) and (Assigned(fOnSuccess)) then fOnSuccess(Self); if Assigned(fAExecute) then fAExecute(Self); end; |
В тело функции уже внесена модификация свойства hWnd: если значение меньше 32 (ссылка фиктивная), то по значению 1 присвоить ссылку на приложение, а по значению 2 — ссылку на Desktop Windows. Далее мы используем эту модификацию.
Редакторы свойств — пожалуй самая обширная из легкодоступных возможностей в IDE Delphi. Собственно, редактор — это всё, что находится правее названия свойства в Object Inspector. Как Вы, наверное, заметили для большинства свойств нашего объекта Delphi назначила редакторы по умолчанию, но оин не всегда устраивают нас. Редактор свойства — это, как понятно, класс, наследованный от TPropertyEditor (описанный, как и все встречавшиеся ранее, в модуле Dsgnintf). Есть, как понятно несколько стандартных редакторов:
| Имя класса | Описание |
|---|---|
| TOrdinalProperty | Базовый класс для редакторов свойств перечислимых типов |
| TIntegerProperty | Редактор свойств целых типов |
| TCharProperty | Редактор свойств символьных типов |
| TEnumProperty | Редактор свойств перечислимых типов (
выпадающий список) |
| TFloatProperty | Редактор свойств типов с плавающей точкой |
| TStringProperty | Редактор свойств строковых типов |
| TSetElementProperty | Редактор элементов подмножеств, как Boolean на вхождение в значение |
| TSetProperty | Редактор свойств множественных типов (с использованием TSetEelementProperty) |
| TClassProperty | Редактор свойств типов-классов (имя
класса в строке и  для свойств) |
| TMethodProperty | Редактор свойств-методов (события,
выпадающий список) |
| TComponentProperty | Редактор свойств-компонентов (
выпадающий список со всеми досягаемыми) |
| TColorProperty | Редактор свойства Color |
| TFontNameProperty | Редактор свойства FontName ( выпадающий список
всех шрифтов объекта Screen) |
| TFontProperty | Редактор свойства Font |
Создавая свои редакторы свойств, обращайтесь к Borland'овским реализациям стандартных — все примеры налицо.
Теперь стоит подробно разобрать класс TPropertyEditor:
| RT | Метод/свойство | Параметры | Тип | Описание |
|---|---|---|---|---|
| p | Designer | - | IFormDesigner | Интерфейс редактора формы (не понадобится) |
| p | PrivateDirectory | - | String | Каталог, где можно хранить данные, загружать библиотеки (HKEY_CURRENT_USER\Software\Borland\Delphi\x.0\Globals\PrivateDir) |
| p | PropCount | - | Integer | Сколько объектов, редактируемых этим редактора выделено на форме |
| p | Value | - | String | То, что отображено в строке Object Inspector (read GetValue write SetValure) |
| m | Activate | - | - | Обработчик события выбора свойства в Object Inspector. Переопределив, можно менять свойства редактора динамически. |
| m | AllEqual | - | Boolean | Показывает, у всех ли выбранных объектов значение свойства одинаково |
| m | AutoFill | - | Boolean | Говорит, может ли Object Inspector дополнять недовведённые значения из выпадающего списка |
| m | Destroy | - | - | Деструктор (самому вызывать противопоказано!) |
| m | Edit | - | - | Обработчик DblClick'а по свойству в ObjectInspector |
| m | GetAttributes | - | TPropertyAttributes | Возвращает среде параметры редактора. Лучше переопределять и настраивать заново |
| m | GetComponent | Index: Integer | TPersistent | Возвращает компонент с номером Index из всех выбранных |
| m | GetEditLimit | - | Integer | Возвращает среде количество знаков, которые можно ввести как значение свойства |
| m | GetFloatValue | - | Extended | Возвращает значение свойства типа с плавающей точкой (первой из выбранных компонент) |
| m | GetFloatValueAt | Index: Integer | Extended | Возвращает значение свойства типа с плавающей точкой (компоненты с номером Index) |
| m | GetXXXValue | - | XXX | Возвращает значение свойства типа XXX (первой из выбранных компонент) |
| m | GetXXXValueAt | Index: Integer | XXX | Возвращает значение свойства типа XXX (компоненты с номером Index) |
| m | SetXXXValue | Value: XXX | - | Усианавливает значение свойства типа XXX (всех выбранных компонент) |
XXX может быть:
|
||||
| m | GetName | - | String | Возвращает среде имя свойства, точнее — что написать в Object Inspector |
| m | GetProperties | Proc: TGetPropEditProc | - | Даёт среде знать, что создавать для подсвойств данного свойства (актуально для классов и множеств). Процедуру, переданную в параметре следует запустить с каждым редактором подсвойства |
| m | GetPropInfo | - | PPropInfo | Возвращает указатель на информацию о свойстве: тип, значение по умолчанию итд |
| m | GetPropType | - | PTypeInfo | Возвращает тип свойства (переопределять себе дороже) |
| m | GetValue | - | String | Read для Value — строковое представление значения |
| m | SetValue | Value: String | - | Write для Value — интерпретация строкового представления значения |
| m | GetValues | Proc: TGetStrProc | - | Даёт среде знать, что отображать в выпадающем списке. Переданную процедуру нужно вызвать для каждой строки |
| m | GetVisualValue* | - | String | Говорит Object Inspector, что вывести в строке свойства |
| m | Initialize | - | - | Обработчик события OnCreate-BeforeUsed вызывается перед использованием редактора. Можно переопределять, если нужно совершить что-нибудь исключительное перед использованием. |
| m | ListDrawValue | const Value: string; Canvas: TCanvas; Rect: TRect; Selected: Boolean | - | Рисует пункт в выпадающем списке — OwnerDraw чистой воды, но не верьте Help'у: никакого атрибута paOwnerDrawList в природе не бывает! |
| m | ListMeasureHeight | const Value: string; Canvas: TCanvas; var AHeight: Integer | - | В AHeight хранится значение высоты элемента выпадающего списка: его можно изменить. |
| m | ListMeasureWidth | const Value: string; Canvas: TCanvas; var AWidth: Integer | - | В AWidth хранится значение ширины элемента выпадающего списка: его можно изменить. |
| m | Modified | - | - | Процедура, вызов которой сообщает Object Inspector, что значение свойства изменилось. |
| m | Revert | - | - | Возвращение начальных значений свойства всем выбренным компонентам |
| m | ValueAvailable | - | Boolean | Если в ComponentStyle выбранных объектов есть csCheckPropAvail, определяет, для всех ли таких компонент есть значения свойства. |
| m | PropDrawName* | ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean |
- | Процедура рисует имя свойства в Object Inspector |
| m | PropDrawValue* | ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean |
- | Процедура рисует строку значения свойства в Object Inspector, когда она не активна |
* — не
документировано |
||||
Теперь в дополнение — что может возвращать главная, на мой взгляд функция — GetAttributes, и что это значит:
| Значение (эл-т множества) | Описание |
|---|---|
| paValueList | Редактор представляет собой
выпадающий список |
| paSortList | Список значений нужно отсортировать |
| paSubProperties | Свойство имеет подсвойства (актуально для
классов и множеств) |
| paDialog | Кнопка  вызова диалога |
| paMultiSelect | Отображается, если выделено более одного объекта |
| paAutoUpdate | Значение устанавливается после каждого изменения свойсьва, а не только по нажатию Enter |
| paReadOnly | Нельзя редактировать значение |
| paRevertable | Object Inspector может вернуть исходное значение (отменить изменение) |
| paOwnerDrawList | ВНИМАНИЕ: В ПРИРОДЕ НЕТУ!!! И НЕ НУЖНО! |
Теперь теоритическую часть можно считать
законченной, переходим к созданию этих самых
редакторов свойств.
Как, видимо, стало понятно, основной метод создание чего-то нового — это переопределение параметральных методов старого.
Этим и займёмся. Первое, что мы сделаем будет редактор для свойства Flags, призванный просто запретить редактирование свойства во время проектирования — всё равно ничего не понятно.
Наследуем новый класс от TIntegerProperty и переопределяем метод GetAttributes:
| TROIntProperty = class(TIntegerProperty) function GetAttributes: TPropertyAttributes; override; end; |
| implementation |
| {...} |
| function TROIntProperty.GetAttributes:
TPropertyAttributes; begin Result:= inherited GetAttributes + [paReadOnly]; end; |
Вот и всё. Удобно, не правда ли? Регистрируем созданный редактор в процедуре Register:
| procedure Register; begin RegisterComponents('Custom', [TMsgBox]); {...} RegisterPropertyEditor(TypeInfo(DWord), TMsgBox, 'Flags', TROIntProperty); end; |
Компиляция — свойство не редактируется!
Теперь займёмся действительно созданием чего-то интерерсного, и сперва это будет редактор свойства Icon. Задача наша состоит в том, чтобы в списке отображались те иконки, которые впоследствии отобразятся на окне диалога. Скажем сразу, что эти иконки — стандартные, входят в число 6 стандартных пиктограмм модуля user32.dll ядра Windows. Достать их можно, если передать нулевую ссылку и предопределённый идентификатор функции LoadIcon Win32 API, которая с радосстью вернёт нам HICON. Впоследствии его можно рисовать где угодно с помощью функции того же API DrawIcon.
Итак, наследуем от TEnumProperty новый класс и переопределяем его методы:
| TMBIconProperty = class(TEnumProperty) function GetAttributes: TPropertyAttributes; override; procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override; procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer); override; procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas; var AHeight: Integer); override; procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override; end; |
Реализуем GetAttributes: список, можно много выбирать, можно и отменить:
| function TMBIconProperty.GetAttributes: TPropertyAttributes; begin Result:= [paValueList, paMultiSelect, paRevertable]; end; |
Реализуем ListMeasureHeight и ListMeasureWidth:
| procedure TMBIconProperty.ListMeasureWidth(const Value:
string; ACanvas: TCanvas; var AWidth: Integer); begin AWidth:= AWidth+GetSystemMetrics(SM_CXSMICON); end; procedure TMBIconProperty.ListMeasureHeight(const Value: string; ACanvas: TCanvas; var AHeight: Integer); begin if AHeight < GetSystemMetrics(SM_CYSMICON) then AHeight:= GetSystemMetrics(SM_CYSMICON); end; |
Смысл кода этих методов а том, чтобы всё, что мы хотим нарисовать, поместилось в пункт списка, и при этом уже определённые сваойства не пострадали. GetSystemMetrics возарщает размерв системных элементов (в данном случае маленьких иконок) — его мы и используемдля определения ширины и высоты области элемента.
Реализуем ListDrawValue:
| procedure TMBIconProperty.ListDrawValue(const Value:
string; ACanvas: TCanvas; const ARect: TRect; ASelected:
Boolean); var IDI: PChar; begin IDI:= nil; if Value = 'icoError' then IDI:= IDI_ERROR else if Value = 'icoQuestion' then IDI:= IDI_QUESTION else if Value = 'icoWarning' then IDI:= IDI_WARNING else if Value = 'icoInformation' then IDI:= IDI_INFORMATION; with ACanvas do try if ASelected then Brush.Color:= clHighlight; FillRect(ARect); DrawIconEx(ACanvas.Handle, ARect.Left, Arect.Top, LoadIcon(0, IDI), GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON), 0, 0, DI_NORMAL or DI_DEFAULTSIZE); finally inherited ListDrawValue(Value, ACanvas, Rect(ARect.Left+GetSystemMetrics(SM_CXSMICON), Arect.Top, ARect.Right, ARect.Bottom), ASelected); end; end; |
Суть в том, чтобы в зависимости от значения рисуемого пункта, отобразить ту или другую иконку из числа стандартных (IDI_XXX — идентификаторы, определённые в модуле Windows), а потом — пусть Delphi рисует то, что хотела раньше, но чуть-чуть правее. Размеры картинки нам даёт небезызвестная GetSystemMetrics.
Теперь, всё, что мы хотим, кроме всеобщего счастья — это чтобы пиктограмма отображалась и тогда, когда списка нет. К сожалению, непосильной представляется задача рисовать иконку во время редактирования свойства, однако, в любое другое время — метод PropDrawValue всегда с нами:
| procedure TMBIconProperty.PropDrawValue(ACanvas: TCanvas; const
ARect: TRect; ASelected: Boolean); begin if GetVisualValue <> '' then ListDrawValue(GetVisualValue, ACanvas, ARect, false) else inherited PropDrawValue(ACanvas, ARect, ASelected); end; |
(Этот метод честно скопирован с Borland'овского оригинала.) Здесь всё, что мы делаем, это говорим, что когда в строке значения свойства что-нибудь отображено (у всех выбранных объектов значение свойства одинаково), можно нарисовать на ней то же, что и при рисовании в списке невыбранного элемента (мы нигде ничего не говорим про фон — он остаётся по умолчанию).
Регистрируем созданный редактор в процедуре Register:
| procedure Register; begin RegisterComponents('Custom', [TMsgBox]); {...} RegisterPropertyEditor(TypeInfo(TMBIcon), TMsgBox, 'Icon', TMBIconProperty); end; |
Компиляция — всё должно работать.
Отличие редактора свойства Modality в том, что символы только двух из трёх его значений доступны как системные, третий символ придётся включить самим. Отличие составит только метод ListDrawValue. Картинку, в принципе, можно подгружать откуда угодно, но надёжнее всего — из прилинкованного к пакету ресурса.
Создайте ресурс чем угодно: Delphi Image Editor, Resources WorkShop, Symantec Resource Studio, etc...
Положите в него под именем "icoTaskModal" соответствующую
идее иконку, я взял её из набора от MS Visual Studio (честное
слово, кроме иконок, этот пакет представляет мало
хорошего): 
. Теперь сохраним ресурс под
именем MsgReg.res и прилинкуем его упоминавшейся
директивой {$R}:
{$R *.res}
В код включено условное изменение ссылки на экземпляр приложения: 0 для стандартных и hInstance для ресурсной иконки:
| procedure TMBModalProperty.ListDrawValue(const Value:
string; ACanvas: TCanvas; const ARect: TRect; ASelected:
Boolean); var IDI: PChar; Inst: THandle; begin IDI:= IDI_APPLICATION; Inst:= 0; if Value = 'modTaskModal' then begin IDI:= 'icoTaskModal'; Inst:= hInstance; end else if Value = 'modSystemModal' then IDI:= IDI_WINLOGO; with ACanvas do try if ASelected then Brush.Color:= clHighlight; FillRect(ARect); DrawIconEx(ACanvas.Handle, ARect.Left, Arect.Top, LoadIcon(Inst, IDI), GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON), 0,0, DI_NORMAL or DI_DEFAULTSIZE); finally inherited ListDrawValue(Value, ACanvas, Rect(ARect.Left+GetSystemMetrics(SM_CXSMICON), Arect.Top, ARect.Right, ARect.Bottom), ASelected); end; end; |
Надо сказать, что при работе с ресурсами вообще, а тем более — в пакетах, стоит соблюдать предельную осторожность, использовать как можно больше Win32 API, а из VCL — только специализированные методы. Это важно, потому что ошибка системного уровня в Вашем пакете немедленно вызовет критическую ошибку Delphi, и хорошо, если Вы, а не нервный заказчик, потеряете несохранённые данные.
Редактор свойства About — задача чисто эстетическая, не имеющая под собой практически никаких технических целей (только что, если Вы поставляете скомпилированный пакет, никто не сможет его украсть, да и то, я Вас уверяю, не перевелись ещё умельцы в земле Русской...). Поэтому здесь можно просто подурачиться и применить мало или узко применимые методы.
Сделаем так: пусть...
| TAboutProperty = class(TPropertyEditor) function GetAttributes: TPropertyAttributes; override; function GetName: String; override; procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override; procedure Edit; override; procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override; procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer); override; procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas; var AHeight: Integer); override; function GetValue: string; override; procedure GetValues(Proc: TGetStrProc); override; end; |
GetAttributes: список, не редактируемо, выделяйте сколько угодно:
| function TAboutProperty.GetAttributes:
TPropertyAttributes; begin Result:= [paValueList, paReadOnly, paMultiSelect]; end; |
GetName: "About this component":
| function TAboutProperty.GetName: String;
begin Result:= 'About this component...'; end; |
PropDrawName: рисуем иконку, и сразу за ней текст (красный):
| procedure TAboutProperty.PropDrawName(ACanvas: TCanvas; const
ARect: TRect; ASelected: Boolean); begin DrawIconEx(ACanvas.Handle, 0, ARect.Top, LoadIcon(hInstance, 'logo'), GetSysTemMetrics(SM_CXSMICON), GetSysTemMetrics(SM_CXSMICON), 0,0,DI_NORMAL or DI_DEFAULTSIZE); ACanvas.Font.Color:= clRed; inherited PropDrawName(ACanvas, Rect(GetSystemMetrics(SM_CXSMICON), ARect.Top, ARect.Right, ARect.Bottom), ASelected); end; |
Edit: показываем незамысловатый диалог: ShowMessage (если не нравится, применяйте MessageBox):
| procedure TAboutProperty.Edit; begin ShowMessage('TMsgBox - Delphi VCL component'#13#10 + 'Created and used as an exaple'#13#10 + 'in the Tutorial of designing components'#13#10 + '© Andrew Breslav, St.Petersburg, Russia, y. 2000'); end; |
ListMeasureXXX: зависит от того, что Вы нарисовали себе в логотип. Я изобразил следующее:
имеет оно размеры 110x40, исходя из этого:
| procedure TAboutProperty.ListMeasureWidth(const Value:
string; ACanvas: TCanvas; var AWidth: Integer); begin AWidth:= 110; end; procedure TAboutProperty.ListMeasureHeight(const Value: string; ACanvas: TCanvas; var AHeight: Integer); begin AHeight:= 40; end; |
ListDrawValue: настал тот момент, когда вновь нужно обратиться к ресурсу (запихните туда BMP, назовите "About"), но здесь Win32 API уже мало полезен: придётся воспользоваться стандартным классом TBitMap из модуля Graphics и его методом LoadFromResourceName. Итак, заливаем фон, загружаем, центрируем, рисуем:
| procedure TAboutProperty.ListDrawValue(const Value:
string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); var Bmp: TBitMap; begin ACanvas.Brush.Color:= $0033FFFF; ACanvas.FillRect(ARect); Bmp:= TBitmap.Create; Bmp.LoadFromResourceName(hInstance, 'About'); ACanvas.Draw((ARect.Right - 110) div 2,0,Bmp); Bmp.Free; end; |
GetValue: Чтобы видеть текст, нужно его вернуть: TPropertyEditor не предствляет, как это сделать:
| function TAboutProperty.GetValue: string;
begin Result:= TMsgBox(GetComponent(0)).About; end; |
GetValues: чтобы список отображался, в нём должен быть хотя бы один элемент:
| procedure TAboutProperty.GetValues(Proc: TGetStrProc); begin Proc(''); end; |
Регистрируем созданный редактор в процедуре Register:
| procedure Register; begin RegisterComponents('Custom', [TMsgBox]); {...} RegisterPropertyEditor(TypeInfo(String), TMsgBox, 'About', TAboutProperty); end; |
Компиляция — весёленький About!
**Кстати, если теперь посмотреть на категории свойств, нашей категории "Copyright, etc" мы не увидим: Delphi распознаёт свойства по именам, возвращаемым GetName редактора, а поскольку мы возвращаем не лаконичное "About", а развёрнутое "About this component", регистрация краткого имени для этого свойства недействительна, напишите:
| procedure Register; begin RegisterComponents('Custom', [TMsgBox]); {...} RegisterPropertyInCategory(TCopyrightCategory, TMsgBox, 'About this component...'); {...} RegisterPropertyEditor(TypeInfo(String), TMsgBox, 'About', TAboutProperty); end; |
Компиляция — теперь лучше.
Как мы помним, для это свойство обладает некоторой спецификой: его значение интерпретируется перед тем, как быть передано в функцию MessageBox. Поскольку задать значене ссылки руками, то есть числом, и во время проектированя невозможно, не и смысла предоставлять такой интерфейс. Лучше красиво обработать три варианта значения: ноль, приложение, Desktop. Хорошо то, что для этих значений не нужно вводить типов и идентификаторов: они известны, и их число конечно: три.
Итак, что мы хотим:
Декларируем:
| TMBHWndProperty = class(TIntegerProperty) function GetAttributes: TPropertyAttributes; override; procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override; procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer); override; procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas; var AHeight: Integer); override; procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override; function GetValue: String; override; procedure SetValue(const Value: String); override; procedure GetValues(Proc: TGetStrProc); override; end; |
С точки зрения рисования списка всё должно быть ясно. Займёмся делом.
GetAttributes: список, R/O, выбирайте хоть все, хочешь — отмени:
| function TMBHWndProperty.GetAttributes:
TPropertyAttributes; begin Result:= [paValueList, paReadOnly, paMultiSelect, paRevertable]; end; |
GetValues: те самые три строки:
| procedure TMBHWndProperty.GetValues(Proc: TGetStrProc); begin Proc('Application'); Proc('Desktop'); Proc('NULL'); end; |
G|SetValue: интепретировать число в строку и обратно:
| function TMBHWndProperty.GetValue: String; var i: Integer; begin for i:= 0 to PropCount - 1 do begin Result:= IntToStr(TMsgBox(GetComponent(i)).hWnd); case TMsgBox(GetComponent(i)).hWnd of 1: Result:= 'Application'; 2: Result:= 'Desktop'; else Result:= 'NULL'; end; end; end; procedure TMBHWndProperty.SetValue(const Value: String); var i: Integer; begin for i:= 0 to PropCount - 1 do begin if Value = 'NULL' then TMsgBox(GetComponent(i)).hWnd:= 0 else if Value = 'Application' then TMsgBox(GetComponent(i)).hWnd:= 1 else if Value = 'Desktop' then TMsgBox(GetComponent(i)).hWnd:= 2 else TMsgBox(GetComponent(i)).hWnd:= StrToInt(Value); end; end; |
Регистрируем созданный редактор в процедуре Register:
| procedure Register; begin RegisterComponents('Custom', [TMsgBox]); {...} RegisterPropertyEditor(TypeInfo(HWND), TMsgBox, 'hWnd', TMBHWndProperty); end; |
Компиляция — должно работать.
Вся сложность состоит в том что
Сперва решим вопрос с идентификаторами: создадим прямо в модуле MsgReg (в секции implementation) тип TRT:
| type TRT = (idOK, idCancel, idAbort, idRetry, idIgnore, idYes, idNo, idClose, idHelp); |
Этот тип заменит библиотеку имён.
Создаём редактор для множества:
| TMBTRProperty = class(TSetProperty) function GetValue: String; override; procedure GetProperties(Proc: TGetPropEditProc); override; end; |
GetValue: идею честно крадём у Borland:
| function TMBTRProperty.GetValue: String;
var S: TIntegerSet; TpInfo: PTypeInfo; I: Integer; begin Integer(S):= GetOrdValue; TpInfo:= TypeInfo(TRT); Result := '['; for I := 0 to SizeOf(Integer) * 8 - 1 do if I in S then begin if Length(Result) <> 1 then Result := Result + ','; Result := Result + GetEnumName(TpInfo, I - 1); end; Result := Result + ']'; end; |
Собственно, изменено в оригинальном коде очнь мало: вторая строчка в теле процедуры: сложное определение типа заменено его непосредственным идентификатором — мы подменяем любой тип, редактируемого свойства типом TRT. Суть Borland'овского кода в том, что если представить множество как TIntegerSet, можно получить доступ к его элементам через биты числа, хотя эта технология ограничена множествами с не более чем 32 элементами (иначе их не дают вносить в published).
GetProperties: тоже крадём и также реализуем подмену:
| procedure TMBTRProperty.GetProperties(Proc:
TGetPropEditProc); var I: Integer; begin with GetTypeData(GetTypeData(GetPropType)^.CompType^)^ do for I := MinValue to MaxValue do Proc(TMBTResProperty.Create(Self, I)); end; |
Код станет ясен до конца, когда мы реализуем TMBResProperty — для элементов.
Им и займёмся: из модуля Dsgnintf честно переписываем декларацию и реализацию TSetElementProperty (подчёркнуты привнесённые места):
| TMBTResProperty = class(TNestedProperty) protected FElement: Integer; constructor Create(Parent: TPropertyEditor; AElement: Integer); reintroduce; public function AllEqual: Boolean; override; function GetAttributes: TPropertyAttributes; override; function GetName: string; override; function GetValue: string; override; procedure GetValues(Proc: TGetStrProc); override; procedure SetValue(const Value: string); override; end; |
Директива reintroduce связана с замещением конструктора TPropertyEditor в классе TNestedProperty — в целях самореализации. Новшеством в отношении FElement является его перенесение из private в protected (это и есть то самое поле!) — из жалости к ближнему.
| constructor TMBTResProperty.Create(Parent:
TPropertyEditor; AElement: Integer); begin inherited Create(Parent); FElement := AElement; end; function TMBTResProperty.AllEqual: Boolean; var I: Integer; S: TIntegerSet; V: Boolean; begin Result := False; if PropCount > 1 then begin Integer(S) := GetOrdValue; V := FElement in S; for I := 1 to PropCount - 1 do begin Integer(S) := GetOrdValueAt(I); if (FElement in S) <> V then Exit; end; end; Result := True; end; function TMBTResProperty.GetAttributes: TPropertyAttributes; begin Result := [paMultiSelect, paValueList, paSortList]; end; function TMBTResProperty.GetName: string; begin Result:= GetEnumName(TypeInfo(TRT), FElement - 1); end; function TMBTResProperty.GetValue: string; var S: TIntegerSet; begin Integer(S) := GetOrdValue; Result := BooleanIdents[FElement in S]; end; procedure TMBTResProperty.GetValues(Proc: TGetStrProc); begin Proc(BooleanIdents[False]); Proc(BooleanIdents[True]); end; procedure TMBTResProperty.SetValue(const Value: string); var S: TIntegerSet; begin Integer(S) := GetOrdValue; if CompareText(Value, 'True') = 0 then Include(S, FElement) else Exclude(S, FElement); SetOrdValue(Integer(S)); end; |
Как видно, всё делалось исключительно ради метода GetName! Господа! Умоляю вас, пишите свои классы по-человечески!
Регистрируем созданный редактор в процедуре Register (обращаю внимание на то, что редактор для элементов регистрировать не надо):
| procedure Register; begin RegisterComponents('Custom', [TMsgBox]); {...} RegisterPropertyEditor(TypeInfo(TMBTRes), TMsgBox, 'TrueResults', TMBTRProperty); end; |
Компиляция — должно работать.
Должен сообщить Вам приятную вещь: если прочитанное Вам не прошло бесследно, то Вы должны знать, как писать пока простые компоненты и редакторы свойств к ним (мы не разбирали свойства-классы (никак не удалось их запихать в TMsgBox) — если торопитесь, загляните вперёд, если чувствуете уверенность, то в модуль Dsgnintf: TFontProperty)). Далее, во второй части мы займёмся проектированием визуальной компоненты, и тут уже главным будет объект, а не редакторы свойств. Правда и всей широты вопроса охватить не удастся.
