|
:: MVP ::
|
|
|
:: RSS ::
|
|
|
Сегодня я хочу немного углубиться в тему статьи "Технология
подмены класса". Этот прием идеально подходит в ситуациях, когда нужно расширить или модифицировать функциональность
какого-либо класса, не порождая его потомков, и уж тем более не устанавливая в RAD Studio новых компонентов. В своей
практике я довольно часто использую этот прием, примеры можно найти в материалах о:
"PageControl",
"MaskEdit",
"PopupMenu". Но ни один из этих примеров не раскрывает тему статьи - подмену
самого класса, так что пора исправить это упущение.
Давайте посмотрим на следующий код (пример надуман, зато нагляден):
type
TCheckBox = class(TRadioButton)
end;
TDemo1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
private
public
end;
implementation
end.
|
Код предельно прост - класс TCheckBox переопределяется до его непосредственного использования, и это изменение
будет применено ко всем объектам класса TCheckBox в модуле (правая картинка). Вот мы и произвели подмену класса!
К недостаткам можно отнести то, что хоть визуально в run-time мы будем видеть RadioButton, их ClassType по-прежнему
будет TCheckBox (будьте внимательны и учитывайте это). Этот пример находится в архиве в папке Demo1.
Пользоваться этим приемом нужно с осторожностью. Допустим мы положили на форму компонент Edit и переопределили
класс TEdit следующим образом:
type
TEdit = class(TButton)
end;
TForm1 = class(TForm)
Edit1: TEdit;
{...}
end;
|
В процессе компиляции мы получим следующую ошибку:
Вполне ожидаемо, ведь по умолчанию компонент Edit, брошенный на форму, содержит текст, идентичный свойству Name.
Заглянем в DFM:
object Edit1: TEdit
Left = 8
Top = 8
Width = 121
Height = 21
TabOrder = 0
Text = 'Edit1'
end
|
Но у TButton, которым мы подменили TEdit, свойства Text нет. Чтобы избавиться от этой ошибки нужно либо очистить
свойство Text, либо реализовать подмену следующим образом (что мне кажется более правильным):
type
TEdit = class(TButton)
private
function GetText: string;
procedure SetText(const Value: string);
published
property Text: string read GetText write SetText;
end;
implementation
function TEdit.GetText: string;
begin
Result := Caption;
end;
procedure TEdit.SetText(const Value: string);
begin
Caption := Value;
end;
|
Результат будет выглядеть примерно так:
Однако это не единственный способ реализации подобного трюка, посмотрим на следующий пример:
interface
uses
{...,} Vcl.StdCtrls;
type
TCheckBox = class(Vcl.StdCtrls.TCheckBox)
public
constructor Create(AOwner: TComponent); override;
end;
TDemo2 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
private
public
end;
var
Demo2: TDemo2;
implementation
constructor TCheckBox.Create(AOwner: TComponent);
type
PClass = ^TClass;
begin
inherited;
PClass(Self)^ := TRadioButton;
end;
|
Здесь переопределение класса происходит не при его объявлении, а в момент создания экземпляра этого класса,
в конструкторе. Это работает потому, что тип экземпляра объекта хранится в неявном поле экземпляра объекта в
памяти - первые SizeOf(Pointer) байт экземпляра всегда содержат ссылку на TClass (реализованную как указатель
на VMT класса), который был использован при создании объекта. Это зарезервированное поле инициализируется в
классовом методе InitInstance, определённым в TObject:
class function TObject.InitInstance(Instance: Pointer): TObject;
begin
FillChar(Instance^, InstanceSize, 0);
PInteger(Instance)^ := Integer(Self);
{...}
end;
|
Зная, что класс экземпляра объекта в run-time явно хранится в поле по нулевому смещению, становится понятно,
что для изменения класса экземпляра нужно перезаписать его TClass-ссылку на другую. Этот способ, как и предыдущий,
применятся ко всем объектам класса TCheckBox в модуле, однако теперь объекты не только выглядят в run-time как
RadioButton, но и их ClassType равен TRadioButton. Этот пример находится в архиве в папке Demo2.
А если нужно подменить не все экземпляры класса TCheckBox, а лишь некоторые? Тогда нужно немного изменить подход.
type
TDemo3 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Demo3: TDemo3;
implementation
procedure TDemo3.Button1Click(Sender: TObject);
procedure PatchCheckBox(CheckBox: TCheckBox);
type
PClass = ^TClass;
begin
PClass(CheckBox)^ := TRadioButton;
CheckBox.Perform(CM_RECREATEWND, 0, 0);
end;
var
i: Integer;
begin
for i := 0 to ComponentCount-1 do
if (Components[i] is TCheckBox) and (TCheckBox(Components[i]).Tag = 1) then
PatchCheckBox(Components[i] as TCheckBox);
end;
|
Здесь все практически идентично предыдущему примеру. Отличие в том, что подмена происходит не в конструкторе
класса, поэтому мы принудительно пересоздаем модифицированный объект. Этот пример находится в архиве в папке
Demo3.
Все это конечно хорошо, но какой во всем этом может быть практический смысл? Представим что у нас имеется большой
проект, в котором несколько сотен форм, на каждой из которых есть кнопка класса TButton, реализующая функционал
сохранения изменений, произведенных пользователем на форме. И вот от руководства прилетает задача - срочно
добавить на кнопку картинку, срок - вчера. Конечно, можно поменять кнопку на каждой форме, но теперь мы знаем,
как справиться с этим гораздо быстрее! Создадим следующий модуль и добавим его в секцию uses нужных форм после
модуля Vcl.Buttons.
unit BtnModify;
uses
Vcl.Buttons;
type
TButton = class(Vcl.Buttons.TBitBtn)
public
constructor Create(AOwner: TComponent); override;
end;
implementation
constructor TButton.Create(AOwner: TComponent);
var
PropInfo: PPropInfo;
begin
inherited;
Kind := bkOK;
end;
end.
|
.: Пример к данной статье :.
|
|
При использовании материала - ссылка на сайт обязательна
|
|
