|
В далеком 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. И прочитав из
файла отчета имя можете сразу создать нужный компонент.
Конечно, безопаснее было бы вызвать 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. Возможно у Вас есть ответы на эти вопросы, так поделитесь же со
мной и со всеми нами.
Автор: Банников Н.А.
| 
