Практика
Технология подмены класса

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика


Подмена класса - интересная возможность, предоставленная нам разработчики языка Delphi. Однако мне до сих пор не попадалось в интернете ни одной статьи, в которой были бы освещены различные аспекты ее применения... Единственное, что я встречал, это хак, позволяющий как добраться до свойств и методов объекта, объявленных в секцях private и protected, если класс объявлен в другом модуле. Данной статьей мне хочется восполнить этот информационный пробел. Ну а начнем мы, пожалуй, с хака.

Допустим, перед нами стоит задача – узнать ширину заголовка TSpeedButton в пикселях. Для этого нам необходим доступ к свойству Canvas, но вот беда, у TSpeedButton его почему-то нет (хотя это графический компонент). Зато это свойство есть у одного из предков, класса TGraphicControl, и спрятано оно в секции protected. Очевидным решением было бы создать класс наследник от TSpeedButton (можно даже оформить этот класс отдельным компонентом, но мы этого делать не будем, чтобы не усложнять пример).

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;

type
  TMySpeedButton = class( TSpeedButton )
  public
    property Canvas;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    MySB: TMySpeedButton;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
   MySB := TMySpeedButton.Create( Self );
   with MySB do
   begin
      Parent := Self;
      Left := 10;
      Top := 10;
      Caption := 'test';
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ts: TSize;
begin
   with MySB do
      GetTextExtentPoint( Canvas.Handle, PChar( Caption ), Length( Caption ), ts );
   ShowMessage( 'Ширина: ' + IntToStr( ts.cx ) + #13 +
                'Высота: ' + IntToStr( ts.cy ) );
end;

end.

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

Лично мне это решение не нравится еще по 2 причинам. Во-первых, создание нового компонента вызывает некоторые (хоть и несущественные) неудобства, связанные с переносом проекта на другой компьютер. Ведь на этом компьютере придется устанавливать созданный нами компонент (если не предполагается его динамическое создание в runtime). Во-вторых, задача, поставленная нами в этом примере слишком мала и проста, чтобы ради ее решения писать новый компонент.

Подумаем, можно ли решить эту задачу как то проще. Как уже упоминалось ранее, получить доступ к полям и методам класса, объявленным в секциях private и protected возможно, если этот класс объявлен в том же модуле в котором мы пишем свой код. Писать код в “стандартных” (поставляемых со средой разработки) модулях категорически не приветствуется, а переносить код класса TSpeedButton в свой модуль лишено всяческого смысла. Вот тут-то нам на помощь и приходит хак. Посмотрим, как можно решить задачу с его помощью.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, ExtCtrls;

type
  TSpeedButton = class( Buttons.TSpeedButton )
  public
    property Canvas;
  end;

  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  ts: TSize;
begin
   with SpeedButton1 do
      GetTextExtentPoint( Canvas.Handle, PChar( Caption ), Length( Caption ), ts );
   ShowMessage( 'Ширина: ' + IntToStr( ts.cx ) + #13 +
                'Высота: ' + IntToStr( ts.cy ) );
end;

end.

В данном случае мы подменили класс самим собой (если так можно выразиться). Теперь компилятор считает что класс TSpeedButton объявлен в нашем модуле и позволяет обращаться к приватным свойствам класса. Для решения данной задачи совсем не обязательно было писать

public
  property Canvas;

просто на этом примере продемонстрирована еще одна возможность – расширение (увеличение) области видимости свойств и методов объекта.

Продолжая эксперименты в этой области, можно “на лету” подменять одни компоненты другими, главное не зайти далеко и не довести эту идею до абсурда! К примеру, следующие подмены врятли имеют хоть какой-то смысл, хотя будут прекрасно работать.

TPanel = class( StdCtrls.TButton )
end;

TCheckBox = class( StdCtrls.TRadioButton )
end;

А вот, например, такая ситуация вполне имеет место быть (хотя для Delphi XE это уже не актуально, прогресс не стоит на месте!). Допустим у нас на форме много экземпляров объектов класса TButton. С целью улучшения пользовательского интерфейса мы решаем заменить все TButton на TBitBtn, чтобы добавить кнопкам картинки. Можно конечно заняться этой работой в дизайнере, а можно поступить следующим образом.

type
  TButton = class( Buttons.TBitBtn )
  private
    FBitmap: TBitmap;
  public
    constructor Create( AOwner: TComponent ); override;
    procedure Click; override;
  end;

{...}

implementation

{...}

procedure TButton.Click;
begin
   inherited;
   ( Parent as TForm ).Caption := IntToStr( Random( 1000 ) );
end;

constructor TButton.Create(AOwner: TComponent);
begin
   inherited;
   // Self.Kind := bkOK;
   FBitmap := TBitmap.Create;
   FBitmap.Width := 16;
   FBitmap.Height := 16;
   FBitmap.Canvas.Brush.Color := Self.Color;
   FBitmap.Canvas.FillRect( Rect( 0, 0, FBitmap.Width, FBitmap.Height ) );
   FBitmap.Canvas.Font.Style := FBitmap.Canvas.Font.Style + [fsBold];
   FBitmap.Canvas.Font.Size := 18;
   FBitmap.Canvas.TextOut( 0, -3, '*' );
   Self.Glyph := FBitmap;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if ( Sender as TBitBtn ).Caption = Sender.ClassName then
      ( Sender as TBitBtn ).Caption := ( Sender as TBitBtn ).Name
   else
      ( Sender as TBitBtn ).Caption := Sender.ClassName;
end;

Бросим на форму экземпляр объекта TButton и запустим приложение. Мы добились того, чего хотели, заменили TButton на TBitBtn. Кроме того данный пример показывает, что мы можем добавить свой обработчик на интересующее нас событие (если у разработчика компонента были “прямые” руки, и событие вынесено в отдельную процедуру с директивой virtual или dynamic). Это событие будет у каждого экземпляра объекта нашего класса, но это не мешает добавить обработчик этого же события в дизайнере для конкретного экземпляра объекта класса.

Последний шаг – вынести код в отдельный модуль, подключая который к различным модулям своего проекта мы без каких либо усилий изменим их функциональность (главное чтобы наш модуль был объявлен в секции uses после модуля, в котором объявлен подменяемый нами класс). Именно это демонстрирует пример, прилагаемый к статье.

В примере произведена подмена класса TEdit. Перекрытие методов DoEnter и DoExit позволило изменять фоновый цвет компонента, имеющего в данный момент фокус ввода, дополнительно визуально выделяя его на форме. Перекрытие метода KeyPress позволяет реализовать фильтр (аналог маски ввода), снижая вероятность ошибок ввода пользователем. Для большей дружелюбности, в случае, если пользователь все же ошибся, компонент уведомляет пользователя о совершенной им ошибке по средствам цветовой индикации. При этом ни что не мешает написать обработчик для любого из этих событий любому экземпляру класса TEdit в дизайнере.

Фактически, мы получаем в свои руки технологию, позволяющую наделять экземпляры объектов одного класса схожим функционалом, при этом “разгружая” модуль с формой (вынося код в отдельный модуль), да еще и события компонентов в дизайнере остаются свободными для творчества! Убедитесь в этом сами, добавьте на форму сколько хотите Edit'ов, все они будут иметь схожий между собой расширенный функционал.

Бонусом к примеру прилагаю модуль, реализующий подмену класса TForm, добавляющий форме эффект прозрачности при ее перетаскивании.

И это все, что мне хотелось сказать в данной статье. Смотрите, разбирайтесь, применяйте! Удачи в программировании.

.: Пример к данной статье :.


При использовании материала - ссылка на сайт обязательна