DELPHI: Создание визуальных компонентов

Постановка задачи

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

Реализация

Наиболее правильным, с точки зрения иерархии VCL, методом решения первого пункта поставленной задачи, будет создание нового компонента, в качестве базового класса которого мы выберем TCustomControl. Этот класс является базовым для создания компонентов-надстроек над визуальными объектами Windows, и предоставляет методы для отрисовки объектов разных форм. Если же у вас нет необходимости наследовать все особенности поведения объектов Windows то можете в качестве базового класса использовать TGraphicControl, наследники которого отрисовываются быстрее, поскольку не должны следить за уймой Виндовских служебных сообщений.

Сам компонент TCustomControl определен в модуле controls.pas следующим образом:

TCustomControl = class(TWinControl)
  private
    fCanvas: TCanvas;
    procedure WMPaint(var message: TWMPaint); message WM_PAINT;
  protected
    procedure Paint; virtual;
    procedure PaintWindow(dc: HDC); override;
    property Canvas: TCanvas read FCanvas;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
end;

Здесь самым интересным для нас является метод Paint и свойство Canvas. Посредством этих двух членов класса TCustomControl мы и будет рисовать нашу кнопку.

Кроме этого мы немножко расширим функциональность нашего компонента и придадим ему возможность устанавливать цвет темного и светлого участка своей границы, а также ее толщину, и наконец определим свойство Flat которое отвечает за функциональность аналогичного свойства стандартных компонентов Delphi.

Исходя из вышесказанного прототип нашего компонента TEllipseButton будет выглядеть следующим образом:

TEllipseButton = class(TCustomControl)
  private
    fDarkColor, fLightColor, fBackColor: TColor;
    fSize: integer;
    fPushed: boolean;
    rgn: HRGN;
    fFlat: boolean;
    fDrawFlat: boolean;
    fOnMouseEnter, fOnMouseLeave: TNotifyEvent;
  protected
    procedure SetDarkColor(value: TColor);
    procedure SetLightColor(value: TColor);
    procedure SetSize(size: integer);
    procedure SetBackColor(value: TColor);
    procedure DblClick; override;
    procedure DrawFlat; dynamic;
    procedure DrawNormal; dynamic;
    procedure DrawPushed; dynamic;
    procedure WMLButtonDown(var message: TWMMouse); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var message: TWMMouse); message WM_LBUTTONUP;
    procedure WMMouseMove(var message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure CMMouseEnter(var message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var message: TMessage); message CM_MOUSELEAVE;
    procedure CMTextChanged(var message: TMessage); message CM_TEXTCHANGED;
    procedure SetFlat(value: boolean);
    procedure DoMouseEnter;
    procedure DoMouseLeave;
  public
    constructor Create(AOwner: TComponent); override;
    procedure AfterConstruction; override;
    destructor Destory; virtual;
    procedure Repaint; override;
    procedure Paint; override;
    property Canvas;
  published
    property DarkColor: TColor read fDarkColor 
        write SetDarkColor default clBlack;
    property LightColor: TColor read fLightColor 
        write SetLightColor default clWhite;
    property BackColor: TColor read fBackColor 
        write SetBackColor default clBtnFace;
    property Size: integer read fSize write SetSize;
    property Flat: boolean read fFlat write SetFlat;
    property Caption;
  {events}
    property OnClick;
    property OnDblClick;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseEnter: TNotifyEvent read fOnMouseEnter 
        write fOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read fOnMouseLeave 
        write fOnMouseLeave;

end;

Как видим, здесь помимо базовых конструктора Create и метода AfterConstruction переопределены и методы Paint и Repaint.

Вся функциональность этого компонента в основном заключена в динамических методах DrawFlat, DrawNormal, DrawPushed которые отвечают за рисование компонента соответственно в режиме Flat, в нормальном приподнятом режиме и в нажатом режиме.

Собственно рисование делается с помощью метода Canvas.Arc, который рисует часть эллипса заданным цветом. Таким образом мы рисуем одну половину темным цветом а другую – светлым и получаем эффект выпуклости. Поменяв местами цвета мы достигаем эффекта «нажатия» для нашей кнопки. Ну а использовав в качестве цвета фона – средний между темным и светлым цветами границы – мы получаем ефект Flat:

procedure TEllipseButton.DrawFlat;
var
  x, y: integer;
begin
  Canvas.Lock;
  try
    inherited Paint; 
    Canvas.Brush.Color:= BackColor;
    Canvas.Pen.Color:= clGray;
    Canvas.Arc(0, 0, Width, Height, 0, Height, Width, 0);
    Canvas.Brush.Style:= bsClear;
    Canvas.Ellipse(ClientRect);
    Canvas.Font.Size:= 5;
    x:= Self.ClientWidth - Canvas.TextWidth(Caption);
    x:= x div 2;
    y:= Self.ClientHeight - Canvas.TextHeight(Caption);
    y:= y div 2;
    Canvas.TextRect(Self.ClientRect, x, y, Caption);
  finally
    Canvas.Unlock;
  end;
end;

procedure TEllipseButton.DrawNormal;
var
  i: integer;
  x, y: integer;
begin
  Canvas.Lock;
  try
    inherited Paint; 
    Canvas.Brush.Style:= bsClear;
    Canvas.Brush.Color:= BackColor;
    Canvas.Pen.Color:= DarkColor;
    Canvas.Arc(0, 0, Width, Height, 0, Height, Width, 0);
    for i:= 0 to fSize do
      Canvas.Arc(i, i, Width - i, Height - i, i, 
          Height - i, Width - i, i);
    Canvas.Pen.Color:= LightColor;
    Canvas.Arc(0, 0, Width, Height, Width, 0, 0, Height);
    for i:= 0 to fSize do
      Canvas.Arc(i, i, Width - i, Height - i, 
          Width - i, i, i, Height - i);
    Canvas.Brush.Style:= bsClear;
    Canvas.Font.Size:= 5;
    x:= Self.ClientWidth - Canvas.TextWidth(Caption);
    x:= x div 2;
    y:= Self.ClientHeight - Canvas.TextHeight(Caption);
    y:= y div 2;
    Canvas.TextRect(Self.ClientRect, x, y, Caption);
  finally
    Canvas.Unlock;
  end;
end;

procedure TEllipseButton.DrawPushed;
var
  i: integer;
  x, y: integer;
begin
  Canvas.Lock;
  try
    inherited Paint;
    Canvas.Brush.Style:= bsClear;
    Canvas.Brush.Color:= BackColor;
    Canvas.Pen.Color:= LightColor;
    Canvas.Arc(0, 0, Width, Height, 0, Height, Width, 0);
    for i:= 0 to fSize do
      Canvas.Arc(i, i, Width - i, Height - i, i, 
          Height - i, Width - i, i);
    Canvas.Pen.Color:= DarkColor;
    Canvas.Arc(0, 0, Width, Height, Width, 0, 0, Height);
    for i:= 0 to fSize do
      Canvas.Arc(i, i, Width - i, Height - i, 
          Width - i, i, i, Height - i);
    Canvas.Brush.Style:= bsClear;
    Canvas.Font.Size:= 5;
    x:= Self.ClientWidth - Canvas.TextWidth(Caption);
    x:= x div 2;
    y:= Self.ClientHeight - Canvas.TextHeight(Caption);
    y:= y div 2;
    Canvas.TextRect(Self.ClientRect, x, y, Caption);
  finally
    Canvas.Unlock;
  end;
end;

Теперь, оснастив наш компонент необходимыми функциями мы можем приступить к его «причесыванию», т.е. написанию рутинных методов по присвоению значений свойствам и отладке. Первым делом здесь надо реализовать реакцию компонента на события мыши. Это мы делаем посредством методов WMLButtonDown, WMLButtonUp, WMMouseMove.

procedure TEllipseButton.WMLButtonDown;
begin
  inherited;
  Paint;
end;

procedure TEllipseButton.WMLButtonUp;
begin
  inherited;
  Paint;
end;

procedure TEllipseButton.WMMouseMove;
begin
  inherited;
  if csClicked in ControlState then
  begin
    if PtInRect(ClientRect, SmallPointToPoint(message.pos)) then
    begin
      if not fPushed then DrawPushed;
      fPushed:= true;
    end else
    begin
      if fPushed then DrawNormal;
    fPushed:= false;
    end
  end;
end;

Здесь также мы реализуем функциональность свойства Flat (в WMMouseMove).

Кроме этого мы используем методы CMMouseEnter, CMMouseLeave для вызова соответствующих обработчиков событий.

А также реализовываем метод CMTextChanged для правильного отображения текста кнопки:

procedure TEllipseButton.CMTextChanged;
begin
  invalidate;
end;

Теперь же дело только за методами Paint и Repaint, которые мы реализовываем следующим образом:

procedure TEllipseButton.Paint;
begin
  if not fFlat then
  begin
    if not (csClicked in ControlState) then
      DrawNormal else DrawPushed;
  end else
    if fDrawFlat then DrawFlat else
  if not (csClicked in ControlState) then 
      DrawNormal else DrawPushed;
end;

procedure TEllipseButton.Repaint;
begin
  inherited;
  Paint;
end;

Все. Теперь наш компонент готов к испытаниям. И перед тем как его регистрировать и кидать на палитру компонентов настоятельно рекомендую Вам проверить его функциональность в runtime режиме. В противном же случае вы рискуете повесить всю IDE Delphi при добавлении компонента на форму.

Проверка компонента

Проверка компонента в runtime режиме не вызовет осложнений даже у новичка. Всего-то лишь надо:

• создать новое приложение
• в секции uses разместить ссылку на модуль с вашим компонентом ellipsebutton.pas
• объявить переменную типа TEllipseButton
• создать компонент, заполнить все его свойства и показать

unit main;

interface

uses
  windows, messages, sysutils, variants, classes, 
  graphics, controls, forms, dialogs, mycontrols;

type
  TForm1 = class(TForm)
    EllipseButton1: TEllipseButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



procedure TForm1.FormCreate(Sender: TObject);
begin
  EllipseButton1:= TEllipseButton.Create(Self);
  EllipseButton1.Parent:= Self;
  EllipseButton1.SetBounds(10, 10, 100, 100);
  EllipseButton1.Visible:= true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  EllipseButton1.Free;
end;

end.

После такой, наглядной проверки и отладки вы можете спокойно регистрировать ваш компонент:

procedure Register;
begin
  RegisterComponents('usable', [TEllipseButton]);
end;

И использовать уже в ваших приложениях для быстрого создания эллипсоидных кнопок.

Итоги

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

Автор статьи: Михаил Продан