Переопределение визуальных компонентов в Delphi

Источник: delphi2010

Александр Божко

Недавно у меня возникла проблема с расширением функционала одного довольно известного набора сторонних компонентов. Решение нашлось тут же, на сайте производителя и представляло собой довольно интересную синтаксическую конструкцию. Собственно, никакого откровения там не было, скорее меня удивило то, насколько эффективно использован описываемый ниже прием.Попытаюсь объяснить все "на пальцах". Допустим, у нас имеется приложение, в котором жестко изменен цвет всех форм. Однако все находящиеся на форме экземпляры класса TButton будут иметь цвет clBtnFace. Изменить цвет кнопки - не проблема. Здесь я пропущу реализацию класса, приведу только его описание.

unit ColorButton;

interface

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

type
TDrawButtonEvent = procedure(Control: TWinControl;
Rect: TRect; State: TOwnerDrawState) of object;

TColorButton = class(TButton)
private
FCanvas: TCanvas;
IsFocused: Boolean;
FOnDrawButton: TDrawButtonEvent;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure SetButtonStyle(ADefault: Boolean); override;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
procedure DrawButton(Rect: TRect; State: UINT);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read FCanvas;
published
property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton;
property Color;
end;

procedure Register;

implementation

{skiped}
End.
Соответственно, процедура Register отвечает за регистрацию класса в палитре компонентов.
procedure Register;
begin
RegisterComponents('Samples', [TColorButton]);
end;

Не буду здесь описывать механику сборки компонента из исходного кода. Более интересный вопрос заключается в том, как максимально эффективно преобразовать наше приложение к требуемому виду. Иными словами, заменить все компоненты TButton на компоненты TcolorButton.
В принципе, тоже ничего сложного. Если речь идет о версии Delphi более поздней чем Delphi 2005, то использование Replace Components решает проблему. Но, с другой стороны, тащить за проектом дополнительный компонент - не всегда удобно. К тому же, в случае изменения кода компонента, необходимо каждый раз пересобирать пакет, в котором он (компонент) размещен.
Решение, о котором я говорил в начале, предполагает несколько другой подход. В модуле, содержащем форму, мы перекрываем объявление класса. Примерно так.

unit uMain;

interface

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

Type

// Перекрываем класс
TButton = class(ColorButton.TColorButton)
end;

TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

Implementation
{skiped}

ColorButton - имя модуля, в котором определен класс TColorButton.
Теперь мы можем просто оставить на форме старые компоненты TButton, но в режиме исполнения вместо них будут создаваться экземпляры TcolorButton.
Перекрыть класс TButton это все, что нам потребуется. Из модуля ColorButton можно убрать процедуру Register, что бы не регистрировать TColorButton на панели компонентов.
Действительно, изменив цвет формы и запустив приложение, мы увидим, что цвет кнопки соответствует цвету формы
Но можно поступить еще проще.

Объявить тип TButton непосредственно в модуле ColorButton.

unit ColorButton;

interface

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

type
TDrawButtonEvent = procedure(Control: TWinControl;
Rect: TRect; State: TOwnerDrawState) of object;

TColorButton = class(TButton)
private
FCanvas: TCanvas;
IsFocused: Boolean;
FOnDrawButton: TDrawButtonEvent;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure SetButtonStyle(ADefault: Boolean); override;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
procedure DrawButton(Rect: TRect; State: UINT);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read FCanvas;
published
property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton;
property Color;
end;
// Объявить тип TButton непосредственно в модуле ColorButton.
TButton = class(ColorButton.TColorButton)
end;

Тогда, для достижения результата нам следует просто подключить модуль ColorButton в интерфейс формы.

unit uMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ColorButton; // ' подключили модуль ColorButton

type

TForm1 = class(TForm)
{skiped}

Тут следует обратить внимание на один нюанс.
Стандартный VCL-евский класс TButton объявлен в модуле StdCtrls. И если в секции Uses модуль StdCtrls будет следовать за модулем ColorButton, то поведение экземпляров TButton будет стандартное.

unit uMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ColorButton, StdCtrls; // ' меняем местами модули и возвращаем старое поведение компонента.

type

TForm1 = class(TForm)
{skiped}

В ряде случае такой подход можно использовать довольно эффективно. Хотя бы только потому, вписав одну строку в код, мы автоматически меняем поведение всех кнопок данного класса на форме. Конечно, все это справедливо только в том случае, если измененный (перекрывающий) компонент является потомком изменяемого компонента.
P.S. В одной из статей, посвященных Turbo Delphi, я упоминал о том, что ограничение на подключение дополнительных компонентов в бесплатной версии продукта, можно обойти. Вот пример такого решения. В IDE мы не устанавливаем TcolorButton, но, тем не менее, эффективно с ним работаем.

Ссылки по теме