При первом знакомстве с Delphi несомненно удивляешься великому множеству разных визуальных компонентов. Кнопочки, панельки, надписи и многое другое. Но после нескольких месяцев пользования этой средой разработки появляется желание написать что-то свое. Именно эту задачу мы и попытаемся решить используя инвентарь 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;
{ Private declarations }
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;
{ Protected declarations }
public
constructor Create(AOwner:TComponent);override;
procedure AfterConstruction;override;
destructor Destory;virtual;
procedure Repaint;override;
procedure Paint;override;
{ Public declarations }
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;
{ Published declarations }
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 вы можете преспокойно написать любой замысловатый элемент интерфейса и даже продавать его как отдельный программный продукт за немаленькие деньги.
