RTTI.
	Банников Н.А.	www.stikriz.narod.ru	Почта	На главную страницу

RTTI

В далеком 1996 году я первый раз увидел, как работает программист в Delphi1. У меня уже был кое-какой опыт программирования под DOS на Borland C++ 3.1. Я тогда был начинающим программистом, но не настолько, чтобы не удивится и не оценить красоты. Поэтому я подумал, что это либо волшебство, либо жестко запрограммированные возможности как в других RAID, наподобие Clarion. Однако,  это и не то и не другое. Я не буду обсуждать здесь зачем RTTI нужно, полагая, что если Вы ищите информацию об RTTI, значит Вы знаете что к чему. Здесь я постараюсь рассказать мои соображения о том, как работает IDE Delphi. Это некое расследование, это знания, которые я на протяжении нескольких лет собирал по крупицам специально изучая исходники VCL или случайно натыкаясь на те или иные строчки кода. Надо сказать, что неоценимую помощь в изучении я получил, прочитав книгу  “Delphi 4 Руководство разработчика” Ксавье Пачеко и Стива Тейксера. Сейчас можно найти множество переизданий этой книги для более поздних версий Delphi. Где-то год назад я занялся этим вопросом более-менее вплотную. Здесь я буду рассматривать код Delphi3, но думаю, что до Delphi 5 у Вас проблем не будет, далее, некоторые классы станут интерфейсами, а так… все, практически, одинаково. Начнем сначала.

RegisterClasses

Вот его объявление: procedure RegisterClasses(AClasses: array of TPersistentClass); Здесь перебирается массив и все классы, которые в нем присутствуют регистрируются вызовом procedure RegisterClass(AClass: TPersistentClass);

Куда регистрируются классы ?

В переменную ClassList – глобальную переменную, которая объявлена в модуле, является Tlist и инициализируется в секции initialization.

Зачем регистрировать классы ?

Чтобы можно было вызвать вот эту процедуру:

function GetClass(const ClassName: string): TPersistentClass;

и создать экземпляр класса по имени, например, если Вы зарегистрировали класс TmyObject, то можете создать его на манер:

var V: Tobject;

begin

 V:= GetClass(‘TmyObject’).Create;

end;

Если Вы пишете методы записи-чтения каких-то объектов в поток, например, являетесь одним из разработчиков FreeReport J  И прочитав из файла отчета имя можете сразу создать нужный компонент.

Конечно, безопаснее было бы вызвать function FindClass(const ClassName: string): TPersistentClass; Тогда, если такого класса нет, то поднимется внятное исключение.

RegisterComponentsProc

Эта переменная указатель на процедуру тоже объявлена в модуле Classes:

RegisterComponentsProc: procedure(const Page: string; ComponentClasses: array of TComponentClass) = nil;

Этой процедуры Вы нигде не найдете. Она объявляется в IDE Delphi и служит для того, чтобы на палитре появлялись странички и кнопочки с соответствующими иконками. Если Вам нужна такая возможность в программе, то Вам нужно объявить эту процедуру самостоятельно и присвоить её переменной RegisterComponentsProc. Что Вы там и как будете делать – это Ваши проблеммы.

Где она используется?

Процедура эта используется в процедуре:

procedure RegisterComponents(const Page: string; ComponentClasses: array of TComponentClass);

Здесь проверяется на не равенство nil RegisterComponentsProc, и вызывается через указатель та процедура, что указана в RegisterComponentsProc либо поднимается исключение. И все. Т.е. здесь мы видим часть кода IDE Delphi.

Надо сказать, что так регистрируются компоненты, которые можно поместить на форму, взяв их из палитры, но есть такие компоненты, которые не должны быть видны на форме во время проектирования. Даже если Вы редактором компонента создадите на форме новый компонент как часть редактируемого, то появится квадратик, возможно, без иконки, если такого компонента нет в палитре. Это мы увидим т.н. SubClass. И ткнув по этому квадратику мы увидим в инспекторе свойства компонента. Возможно такое поведение Вам не нужно. Например, Вы создали класс сетки данных, а каждый столбик у Вас – это потомок от Tcomponent, чтобы в DFM правильно записывались его свойства, Вам нужно указать ему в качестве Parent форму, на которую ставится сетка, но сами эти компоненты, понятно, отображать не нужно. А они появляются. Что делать?

RegisterNoIcon

В таком случае, на помощь приходит процедура:

procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);

Эта процедура регистрирует классы, которые не должны быть видны на форме, и устроена наподобие  RegisterComponents. Она использует глобальную переменную:

RegisterNoIconProc: procedure(ComponentClasses: array of TComponentClass) = nil;

Которая является указателем на процедуру регистрации. Этой процедуры, как Вы уже, наверное, догадались нет в VCL. Она объявлена в IDE Delphi, и опять же, если Вам в программе нужно подобное поведение, то нужно её создать самостоятельно.

И RegisterClasses, и RegisterComponents, и RegisterNoIcon Вам пригодятся при написании компонент самостоятельно, чтобы указать IDE Delphi как нужно обращатся с Вашим компонентом во время проектирования. Обычно, все эти процедуры вызываются из процедуры Register, в модуле библиотеки времени разработки.

TypInfo & DsgnIntf

Не будем заниматься пересказом прекрасной книги “Delphi 4 Руководство разработчика” Ксавье Пачеко и Стива Тейксера, где на стр.249 русского издания Вы можете найти, практически, полную информацию о модуле TypInfo. Однако, можно подойти к вопросу получения информации о типах и с другой стороны, заодно рассмотрев вопросы, связанные с построением редакторов компонентов  и свойств.

Что происходит в инспекторе объектов, когда Вы кликаете мышкой по компоненту? Очевидно, что у инспектора объектов должно быть свойство указатель на выделенный компонент или список выделенных компонентов. На самом деле так оно и есть и этот список зовут не иначе как TcomponentList. Объявлен он в модуле DsgnIntf. Имея такой список, а получить его можно из дизайнера формы (о нем мы поговорим позже, сейчас же не путайте форму, которую Вы создаете и её дизайнер – это разные классы), мы можем вызвать процедуру:

procedure GetComponentProperties(Components: TComponentList; Filter: TTypeKinds; Designer: TFormDesigner; Proc: TGetPropEditProc);

Этой процедуре нужно передать список выделенных компонентов - Components: TcomponentList, фильтр, который определяет какие именно свойства Вам нужно получить. Сам фильтр объявлен в модуле TypInfo:

  TTypeKind = (

tkUnknown,                 // Что-нибудь

tkInteger,                     // Целые

tkChar,                        // Символы

tkEnumeration, // Перечисления

tkFloat,                        // Дробные

…

tkWString,                   // Wide строки

tkVariant,                    // Вариантные

tkArray,                       // Массивы

tkRecord,                    // Записи

tkInterface                   // Интерфейсы

);

  TTypeKinds = set of TTypeKind;

Designer: TformDesigner – потомок от TformDesigner, т.к. сам TformDesigner – это полностью абстрактный класс. Если Вам нужна в программе функциональность ObjectInspector, то Вам придется его реализовывать самостоятельно. И, наконец, Proc: TgetPropEditProc – процедура, обратного вызова. Она будет вызываться столько раз, сколько совместных свойств у объектов в списке Components. Ну, а если там только один компонент, то столько раз, сколько у него свойств:

TGetPropEditProc = procedure(Prop: TPropertyEditor) of object;

Эту процедуру Вы должны объявить самостоятельно. В ней то Вы и получите все редакторы свойств. Т.е. перед вызовом GetComponentProperties Вам нужно почистить некий список редакторов, а в Proc добавлять редакторы в этот список. Т.е. сам ObjectInspector не работает напрямую через методы модуля TypInfo. А вместо этого использует удобные методы редакторов свойств, полученные в TgetPropEditProc вызовом GetComponentProperties. Вот пример вызова, как это делается у меня в программе:

procedure TfObjectInspector.RefreshComponentPropertys;

var List: TComponentList;

begin

 ClearComponentPropertys;    // Очистка списка свойств

 List:=TComponentList.Create;

 try

   Designer.GetSelections(List) // Получили список выделенных объектов

   GetComponentProperties(List, [tkInteger, tkChar, tkEnumeration, tkFloat, // Получаем свойства

                               tkString, tkSet, tkClass, tkMethod, tkWChar,

                               tkLString, tkWString], Designer, DoGetPropertyEditor);

 finally

  List.Free;

 end;

end;

// Процедура обратного вызова для получения редакторов свойств

procedure TfObjectInspector.DoGetPropertyEditor(Prop: TPropertyEditor);

var InspProp: TObjectInspProperty; {Некий класс, в котором мне удобно хранить редакторы, и который умеет себя рисовать в инспекторе.}

begin

 InspProp:=TObjectInspProperty.Create;

 FListPropertys.Add(InspProp);

 InspProp.Editor:=Prop;

 InspProp.Inspector:=self;

…

end;

Итак, мы получили все редакторы. Что же происходит, когда в инспекторе объектов выделяется (активизируется) некое свойство? Это зависит от метода редактора свойства:

function GetAttributes: TPropertyAttributes; virtual;

TpropertyAttributes объявлен в модуле DsgnIntf:

TPropertyAttribute = (

paValueList,                // Список значений в ListBox

paSubProperties,         // Есть вложенные свойства, например Tfont, раскрываемые вниз

paDialog,                     // Есть редактор в диалоговом окне (кнопка с тремя точками)

paMultiSelect,              // Свойство может быть отредактировано сразу у нескольких компонентов

paAutoUpdate,            // Значения изменяются сразу по мере ввода, например, Caption окна.

paSortList,                   // Список свойств нужно сортировать

paReadOnly,               // Свойство не для редактирования, например, номер версии компонента или авторство

paRevertable               // Значение можно отменить нажатием Esc, например, строка, число, но такие как шрифт – нельзя…

);

  TPropertyAttributes = set of TPropertyAttribute;

В зависимости от того, какая функциональность Вам нужна, Вы можете переопределить метод GetAttributes, чтобы свойство в инспекторе объектов отображалось так, как Вам нужно. Давайте посмотрим как строятся редакторы свойств. Рассмотрим редактор с модальным и немодальным диалоговым окном.

Редактор с модальным окном.

Такие редакторы делают для тех свойств, которые должны быть обязательно полностью отредактированы, причем, без использования инспектора объектов, т.е. в самом диалоговом окне. Для примера возьмем редактор картинки:

  TUnImageEditor = class(TPropertyEditor)

   private

   protected

   public

    procedure Edit; override;

    function GetAttributes: TPropertyAttributes; override;

    procedure SetValue(const Value: string); override;

    function GetValue: string; override;

  end;

Я понимаю, что это неактуально, но как учебный пример вполне подойдет. Кроме того, в исходных текстах, поставляемых с Delphi нет редакторов большинства свойств, а если Вы хотите иметь подобную функциональность в своей программе, то Вам либо придется как-то обходить этот вопрос (возможно, все редакторы есть в DCU), либо писать самим. Т.к. я всегда имею все исходники своих программ полностью и не использую компоненты, поставляемые другими разработчиками без исходников, то я даже не стал искать, где именно находятся редакторы, а разработал их самостоятельно.

Итак, вот реализация редактора картинки.

{----------------------------TUnImageEditor------------------------------------}

function TUnImageEditor.GetAttributes: TPropertyAttributes;

begin

// Унас можно устанавливать одну и ту же картинку разным компонентам (paMultiSelect) и редактируется все, понятно, в диалоге(paDialog).

 Result:=[paDialog, paMultiSelect];

end;

procedure TUnImageEditor.Edit;

var F: TfPictureEditor;

    Addr: Integer;

begin

 inherited;

// Создаем форму – редактор картинки

F:=TfPictureEditor.Create(nil);

 Try

// Получили адрес, по которому находится картинка. Даже если у нас таких картинок много, нам все равно нужно только первую получить.

    Addr:=GetOrdValueAt(0);

// Вставили картинку в окно редактора

    F.Image1.Picture.Bitmap.Assign(TPicture(Pointer(Addr)).Bitmap);

  if F.ShowModal = mrOk then

   begin

// Если была нажата кнопка Ok, то установим всем свойствам картинку из редактора.

    SetValue(IntToStr(Integer(F.Image1.Picture)));

   end;

 finally

  F.Free;

 end;

end;

procedure TUnImageEditor.SetValue(const Value: string);

var I, Addr: Integer;

begin

// Перебираем все свойства по порядку

  for I := 0 to PropCount - 1 do

   begin

// Эта функция (IsIntegerValue) проверяет строку, чтобы в ней было именно число. Я написал её сам

    if IsIntegerValue(Value) then

     begin

      Addr:=GetOrdValueAt(I);

// Получили очередной адрес и присвоили картинку.

      TPicture(Pointer(Addr)).Bitmap.Assign(TPicture(Pointer(StrToInt(Value))).Bitmap);

     end;

   end;

// Этот метод служит для того, чтобы перерисовать окно с компонентом,  инспектор объектов и, конечно, сделать кнопку сохранения активной (т.е. были изменения)

 Modified;

end;

function TUnImageEditor.GetValue: string;

var Addr: Integer;

begin

// Метод должен вернуть строку, которая печатается в инспекторе объектов. Понятно, что адрес свойства нам не нужен J , зато приятно было бы видеть, а заполнено ли это свойство?. Поэтому здесь я просто проверяю, что картинка есть.

 Addr:=GetOrdValueAt(0);

 if (TPicture(Pointer(Addr)).Bitmap.Height > 0) or (TPicture(Pointer(Addr)).Bitmap.Width > 0) then

  Result:='(TPicture)'

 else

  Result:='(None)';

end;

Из всех методов окна редактора, пожалуй, только метод очистки  заслуживает внимания, и сделан он так:

var B: TBitmap;

begin

 B:=TBitmap.Create;

 try

  Image1.Picture.Bitmap.Assign(B);

 finally

  B.Free;

 end;

end;

Т.е. просто делаем пустую картинку, и присваиваем её.

Редактор с немодальным окном.

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

  TUnCollectionItemEditor = class(TPropertyEditor)

   private

    F: TfUnItemEditor;

   protected

    procedure DoItemClick(Item: TCollectionItem);

   public

    procedure Initialize; override;

    destructor Destroy; override;

    procedure Edit; override;

    function GetAttributes: TPropertyAttributes; override;

    function GetValue: string; override;

  end;

{------------------------TUnCollectionItemEditor-------------------------------}

procedure TUnCollectionItemEditor.Initialize;

begin

 inherited;

// Мы не можем перегрузить конструктор, так как он не виртуальный, а этот метод вызывается один раз сразу после создания редактора. Но, все равно, мало ли что, мы обезопасим себя проверкой указателя на форму. Если nil, то создаем форму редактора.

 if F = nil then

  F:=TfUnItemEditor.Create(nil);

end;

destructor TUnCollectionItemEditor.Destroy;

begin

 if F <> nil then

  F.Free;

F:=nil;

 inherited;

end;

procedure TUnCollectionItemEditor.Edit;

var Addr: Integer;

begin

 // Инициализируем окно редактора

 Addr:=GetOrdValueAt(0);

 F.Component:=Pointer(Addr);

 F.OnItemClick:=DoItemClick;

// Показываем форму редактора.

 F.Show;

// Форма не будет мешать работать в IDE, и если её не закрыть, то так и будет показывать список. Главное, что она одна на всю IDE, а значит, что при вызове на редактирование другого списка она заново перечитает его и отобразит уже другой список.

end;

procedure TUnCollectionItemEditor.DoItemClick(Item: TCollectionItem);

begin

// Устанавливаем в инспекторе объектов свойства выбранного элемента списка.

Designer.SelectComponent(Item);

end;

function TUnCollectionItemEditor.GetAttributes: TPropertyAttributes;

begin

// Редактировать в диалоговом окне

 Result:=[paDialog];

end;

function TUnCollectionItemEditor.GetValue: string;

begin

// Никаких Value J - возвращаем строку, символизирующую собой список

 Result:='(TCollection)';

end;

procedure TfUnItemEditor.ButtonAddClick(Sender: TObject);

begin

// lbItems – это TlistBox – список.

 lbItems.Items.BeginUpdate;

 try

 // Component – это указатель на свойство Tcollection, которое мы редактируем.

  if Component <> nil then

   Component.Add;

  RefreshItems;

 finally

  lbItems.Items.EndUpdate;

 end;

end;

procedure TfUnItemEditor.ButtonDeleteClick(Sender: TObject);

begin

 lbItems.Items.BeginUpdate;

 try

  if lbItems.ItemIndex > 0 then

   Component.Items[lbItems.ItemIndex].Free;

  RefreshItems;

 finally

  lbItems.Items.EndUpdate;

 end;

end;

procedure TfUnItemEditor.ButtonUpClick(Sender: TObject);

var TempIndex: Integer;

begin

 lbItems.Items.BeginUpdate;

 try

  TempIndex:=Component.Items[lbItems.ItemIndex].Index;

  TempIndex:=TempIndex-1;

  if TempIndex < 0 then

   TempIndex:=0;

  if TempIndex < Component.Count then

   begin

    Component.Items[lbItems.ItemIndex].Index:=TempIndex;

    RefreshItems;

    lbItems.ItemIndex:=TempIndex;

   end;

 finally

  lbItems.Items.EndUpdate;

 end;

end;

procedure TfUnItemEditor.ButtonDownClick(Sender: TObject);

var TempIndex: Integer;

begin

 lbItems.Items.BeginUpdate;

 try

  TempIndex:=Component.Items[lbItems.ItemIndex].Index;

  TempIndex:=TempIndex+1;

  if TempIndex >= Component.Count then

   TempIndex:=Component.Count-1;

  if (TempIndex > 0) and (TempIndex < Component.Count) then

   begin

    Component.Items[lbItems.ItemIndex].Index:=TempIndex;

    RefreshItems;

    lbItems.ItemIndex:=TempIndex;

   end;

 finally

  lbItems.Items.EndUpdate;

 end;

end;

procedure TfUnItemEditor.lbItemsClick(Sender: TObject);

begin

 if lbItems.Items.Count > 0 then

  if Assigned(FOnItemClick) then

    FOnItemClick(Component.Items[lbItems.ItemIndex]);

end;

procedure TfUnItemEditor.FormActivate(Sender: TObject);

begin

 RefreshItems;

end;

procedure TfUnItemEditor.RefreshItems;

var I: Integer;

    OldSelection: Integer;

begin

 OldSelection:=lbItems.ItemIndex;

 lbItems.Items.Clear;

 if Component <> nil then

  for I:=0 to FComponent.Count - 1 do

   begin

    lbItems.Items.Add(IntToStr(I)+' - '+Component.Items[I].ClassName);

   end;

 if ( OldSelection >= 0 ) and (lbItems.Items.Count > 0) then

  begin

   if OldSelection >= lbItems.Items.Count then

    OldSelection:=lbItems.Items.Count-1;

   lbItems.ItemIndex:=OldSelection;

  end;

end;

В общем, особо комментировать тут нечего – все предельно ясно и прозрачно. Вот как редакторы регистрируются в IDE:

RegisterPropertyEditor(TypeInfo(TPicture), nil, '', TUnImageEditor);

RegisterPropertyEditor(TypeInfo(TCollection), nil, '', TUnCollectionItemEditor);

Первым параметром передается указатель на TypeInfo класса, который, собственно, будет редактироваться, второй параметр – это класс, в котором встречается такое свойство. Если указан nil, то это значит, что все равно какой тип, главное, чтобы у него было соответствующее свойство. Третий параметр – это имя свойства. Если указать пустую строку, то будут редактироваться любые свойства указанного типа. Последний параметр – это класс редактора свойства.

Редактор компонента.

Редактор компонента служит для того, чтобы показать всплывающее меню, когда Вы кликаете левой кнопкой мыши по компоненту, точнее, некоторое количество дополнительных пунктов. И для того, чтобы их, понятное дело, выполнить. Если Вы кликнете по компоненту двойным щелчком, то будет выполнен первый пункт в меню. Часто делают так, что редактор компонентов по двойному щелчку просто начинает редактирование одного из свойств компонента. Давайте посмотрим как устроены редакторы компонентов. Например, в Delphi3 нет возможности экспорта картинок в файл из редактора TimageList. Вот его-то мы и создадим.

  TUnImageListEditor = class(TDefaultEditor)

   private

   protected

    procedure DoOnChange;

   public

    procedure ExecuteVerb(Index: Integer); override;

    function GetVerb(Index: Integer): string; override;

    function GetVerbCount: Integer; override;

  end;

{---------------------------TUnImageListEditor---------------------------------}

procedure TUnImageListEditor.ExecuteVerb(Index: Integer);

var V: TfUnImageListEditor;

begin

 V:=TfUnImageListEditor.Create(nil);

 Try

// Component – свойство редактора компонента. В нем находится указатель на выделенный компонент. Заметьте, что редактор компонента может редактировать только один компонент, а не список, как это было у редакторов свойств.

  V.Component:=Component as TCustomImageList;

  V.ImageList1.Assign(Component);

  V.InitializeSizes;

  V.OnChangeProp:=DoOnChange;

  if V.ShowModal = mrOk then

   begin

    Component.Assign(V.ImageList1);

    Designer.Modified;

   end;

 finally

  V.Free;

 end;

end;

function TUnImageListEditor.GetVerb(Index: Integer): string;

begin

 Result:='Edit...';

end;

function TUnImageListEditor.GetVerbCount: Integer;

begin

 Result:=1;

end;

procedure TUnImageListEditor.DoOnChange;

begin

 Designer.Modified;

end;

Как видите, редактор довольно прост. В методе GetVerbCount просто указывается сколько пунктов меню добавит редактор. В методе GetVerb указывается строка, которая будет Caption пункта меню. Вы можете проанализировать Index и вернуть нужную строку, например, через Case. Т.к. у нас один пункт, то мы просто возвращаем строку без всякого анализа. И самое главное – это метод ExecuteVerb. Здесь тоже присутствует Index. По нему Вы должны принять решение о том, что именно нужно сделать. Index – это номер пункта меню. В нашем случае мы создаем форму редактора, инициализируем её и открываем как модальный диалог.

Я немного упростил само окно редактора, решив для себя, что глупо масштабировать картинку, если она не того размера, и что операция перетаскивания, особенно на большие расстояния в списке картинок не самое приятное занятие, а лучше бы просто указать картинке её номер, чтобы она туда встала. Хотя, Вам ничто, как говорится, не мешает. Вот реализация самого окна:

type

  TOnChangeProp = procedure of Object;

  TfUnImageListEditor = class(TForm)

    ImageList1: TImageList;

…

  private

    FListCaptions: TList;

    FListImages: TList;

    FActiveSelected: Integer;

    FComponent: TCustomImageList;

    FOnChangeProp: TOnChangeProp;

    procedure SetActiveSelected(AValue: Integer);

    procedure pImagesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

  public

    procedure InitializeSizes;

    property ActiveSelected: Integer read FActiveSelected write SetActiveSelected;

    property Component: TCustomImageList read FComponent write FComponent;

    property OnChangeProp: TOnChangeProp read FOnChangeProp write FOnChangeProp;

  end;

procedure TfUnImageListEditor.ButtonApplyClick(Sender: TObject);

begin

 FComponent.Assign(ImageList1);

end;

procedure TfUnImageListEditor.ButtonAddClick(Sender: TObject);

var TempBitmat, AddBitmap, Mask: TBitmap;

    I: Integer;

    Files: TFileStream;

    Dest: TRect;

    Source: TRect;

    TempColor: TColor;

begin

 if OpenPictureDialog1.Execute then

  begin

   Files:=TFileStream.Create(OpenPictureDialog1.FileName, fmOpenRead);

   try

    TempBitmat:=TBitmap.Create;

    try

     TempBitmat.LoadFromStream(Files);

     if TempBitmat.Width mod TempBitmat.Height = 0 then

      begin

       AddBitmap:=TBitmap.Create;

       try

        AddBitmap.Width:=TempBitmat.Height;

        AddBitmap.Height:=TempBitmat.Height;

        Mask:=TBitmap.Create;

        try

         Mask.Width:=TempBitmat.Height;

         Mask.Height:=TempBitmat.Height;

         for I:=0 to (TempBitmat.Width div TempBitmat.Height) - 1 do

          begin

           Dest.Left:=0;

           Dest.Top:=0;

           Dest.Right:=AddBitmap.Width;

           Dest.Bottom:=AddBitmap.Height;

           Source.Left:=I*AddBitmap.Width;

           Source.Top:=0;

           Source.Right:=I*AddBitmap.Width+AddBitmap.Width;

           Source.Bottom:=AddBitmap.Height;

           AddBitmap.Canvas.CopyRect(Dest, TempBitmat.Canvas, Source);

           Mask.Assign(AddBitmap);

           Mask.Mask(TempBitmat.Canvas.Pixels[0, 0]);

           ImageList1.Add(AddBitmap, Mask);

          end;

        finally

         Mask.Free;

        end;

       finally

        AddBitmap.Free;

       end;

      end

     else

      begin

       Mask:=TBitmap.Create;

       try

        if ImageList1.Count = 0 then

         begin

          ImageList1.Height:=TempBitmat.Height;

          ImageList1.Width:=TempBitmat.Width;

         end;

        Mask.Assign(TempBitmat);

        Mask.Mask(TempBitmat.Canvas.Pixels[0, 0]);

        ImageList1.Add(TempBitmat, Mask);

       finally

        Mask.Free;

       end;

      end;

    finally

     TempBitmat.Free;

    end;

   finally

    Files.Free;

   end;

   InitializeSizes;

   ActiveSelected:=0;

  end;

end;

procedure TfUnImageListEditor.ButtonDeleteClick(Sender: TObject);

begin

 if FActiveSelected >= 0 then

  if MessageDlg('Delete bitmap ?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then

   begin

    ImageList1.Delete(FActiveSelected);

    InitializeSizes;

    ActiveSelected:=FActiveSelected;

   end;

end;

procedure TfUnImageListEditor.ButtonClearClick(Sender: TObject);

begin

 if MessageDlg('Clear bitmaps ?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then

  begin

   ImageList1.Clear;

   InitializeSizes;

   ActiveSelected:=FActiveSelected;

  end;

end;

procedure TfUnImageListEditor.ButtonExportClick(Sender: TObject);

var TempBitmat: TBitmap;

    I: Integer;

    Files: TFileStream;

begin

 if SavePictureDialog1.Execute then

  begin

   Files:=TFileStream.Create(SavePictureDialog1.FileName, fmCreate);

   try

    TempBitmat:=TBitmap.Create;

    try

     TempBitmat.Height:=ImageList1.Height;

     TempBitmat.Width:=ImageList1.Width*ImageList1.Count;

     for I:=0 to ImageList1.Count-1 do

      ImageList1.Draw(TempBitmat.Canvas, I*ImageList1.Width, 0, I);

     TempBitmat.SaveToStream(Files);

    finally

     TempBitmat.Free;

    end;

   finally

    Files.Free;

   end;

  end;

end;

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

procedure TfUnImageListEditor.InitializeSizes;

var I: Integer;

    Img: TImage;

    Lab: TLabel;

    Temp: TControl;

Begin

// В этом методе создаются картинки на панели pImages, которая стоит в ScrollBox.

 while pImages.ComponentCount > 0 do

  begin

 // Все удаляем с панели

   Temp:=pImages.Controls[0];

   pImages.RemoveControl(Temp);

   Temp.Free;

  end;

// Очищаем списки и устанавливаем размер панели так, чтобы все поместилось

 FListCaptions.Clear;

 FListImages.Clear;

 pImages.Height:=ImageList1.Height+18;

 pImages.Width:=ImageList1.Count*(ImageList1.Width+4);

 for I:=0 to ImageList1.Count-1 do

  begin

// Пролистываем все картинки и создаем на панели рисунок, а сверху ставим Tlabel с номером картинки

   Img:=TImage.Create(pImages);

   Img.Height:=ImageList1.Height;

   Img.Width:=ImageList1.Width;

   Img.Top:=16;

   Img.Left:=I*(ImageList1.Width + 4);

   FListImages.Add(Img);

   Img.OnMouseUp:=pImagesMouseUp;

   ImageList1.GetBitmap(I, Img.Picture.Bitmap);

   pImages.InsertControl(Img);

   Img.Tag:=I;

   Lab:=TLabel.Create(pImages);

   Lab.Top:=0;

   Lab.AutoSize:=false;

   Lab.Left:=I*(ImageList1.Width + 4);

   Lab.Width:=ImageList1.Width;

   Lab.Height:=14;

   Lab.Alignment:=taCenter;

   Lab.Caption:=IntToStr(I);

   Lab.Tag:=I;

   Lab.OnMouseUp:=pImagesMouseUp;

   pImages.InsertControl(Lab);

   FListCaptions.Add(Lab);

  end;

end;

procedure TfUnImageListEditor.pImagesMouseUp(Sender: TObject;

  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var Index: Integer;

    Bmp: TBitmap;

begin

 for Index:=0 to FListCaptions.Count-1 do

  begin

// Всем надписям присваиваем цвет по умолчанию

   TLabel(FListCaptions[Index]).Color:=clWhite;

   TLabel(FListCaptions[Index]).Font.Color:=clWindowText;

  end;

 Bmp:=TBitmap.Create;

 Try

// Копируем картинку в просмотр и выделяем надпись с номером картинки.

  ImageList1.GetBitmap((Sender as TComponent).Tag, Bmp);

  Image1.Picture.Bitmap.Assign(Bmp);

  TLabel(FListCaptions[(Sender as TComponent).Tag]).Color:=clHighlight;

  TLabel(FListCaptions[(Sender as TComponent).Tag]).Font.Color:=clHighlightText;

  SpinEdit1.Value:=(Sender as TComponent).Tag;

  FActiveSelected:=(Sender as TComponent).Tag;

 finally

  Bmp.Free;

 end;

end;

Остальное совсем тривиально J и здесь не рассматривается. Чтобы наш редактор начал работать, его нужно зарегистрировать:

RegisterComponentEditor(TCustomImageList, TUnImageListEditor);

Первый параметр – это класс, для которого регистрируется редактор, а второй параметр – это класс редактора.

TFormDesigner

Ключевым объектом IDE, которую Вы могли бы написать сами является класс TformDesigner. Он объявлен в модуле DsgnIntf. Это полностью абстрактный класс. Самое главное, что он должен иметь свойство Form – потомок от TCustomForm, который не имеет никаких дополнительных опубликованных свойств по сравнению с Tform, и никаких компонентов на себе. Эта форма будет тем полигоном, на котором Вы будете размещать компоненты во время дизайна. Более того, у всех форм есть свойство Designer, которое нужно перед работой установить в один из экземпляров TformDesigner, а этому TformDesigner указать в свойстве Form Вашу форму. Тогда дизайнер оживет, и начнет уже получать некоторые события от формы, которая будет вызывать соответствующие методы. У TformDesigner есть ряд методов, которые Вам нужно реализовать самостоятельно. Рассмотрим некоторые из них:

    function IsDesignMsg(Sender: TControl; var Message: TMessage): Boolean; override;

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

    procedure PaintGrid; override;

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

    procedure ValidateRename(AComponent: TComponent; const CurName, NewName: string); override;

Проверка на корректность переименования компонента.

    function GetPrivateDirectory: string; override;

Это рабочая директория, куда можно, например, помещать файлы с Undo – Redo информацией и т.д.

    procedure GetSelections(List: TComponentList); override;

Заполняет список выделенными компонентами.

    procedure SelectComponent(Instance: TPersistent); override;

Выделяет на форме один компонент.

    procedure SetSelections(List: TComponentList); override;

Выделяет все компоненты, указанные в списке.

    function UniqueName(const BaseName: string): string;override;

Возвращает уникальное для формы имя по образцу BaseName. Обычно, BaseName – это имя класса.

    procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc); override;

Просматривает всю форму, и если встретит класс TypeData или его потомка, вызывает метод Proc, в котором передает его имя. Метод важен для редактора свойств, в котором выпадающий список, например, DataSet у TdataSource.

    function GetComponent(const Name: string): TComponent; override;

Возвращает указатель на компонент по имени.

    function GetComponentName(Component: TComponent): string; override;

Возвращает имя компонента. Это совсем уж тривиально, например, Result:= Component.Name, но все-таки…

    function CreateComponent(ComponentClass: TComponentClass; Parent: TComponent; Left, Top, Width, Height: Integer): TComponent; override;

Создает нужный компонент на форме.

    function GetRoot: TComponent; override;

Возвращает директорию с проектом.

Есть еще ряд методов, но эти наиболее интересны. Некоторые мне, пока, непонятны, а методы работы с методами формы я просто не реализовывал, но судя по названиям там нет неоднозначности.

Собственно, это пока все, что я хотел рассказать. Тема эта – настоящая находка для настоящего хакера. Если кто-то имеет немного свободного времени, например студент или школьник, а у меня его постоянно недостает, много самолюбия и желания утвердится, то вместо того, чтобы писать поганые вирусы, займитесь изучением RTTI, и порадуйте нас своими статьями на эту тему. Например, за скобками остается вызов методов используя RTTI, например, из какого-нибудь интерпретатора, в котором этот метод и объявлен. Очень печалит еще тот факт, что непонятно, по крайней мере мне,  как узнать номер виртуального метода и получить указатель в таблице, если он не published, а просто public или protected. Возможно у Вас есть ответы на эти вопросы, так поделитесь же со мной и со всеми нами.

     Банников Н.А. www.stikriz.narod.ru Почта 2003 г.