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

При первом знакомстве с 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, form s,
dialogs, mycontrols;

type
t form 1 = class(t form)
ellipsebutton1: tellipsebutton;
procedure form create(sender:tobject);
procedure form destroy(sender:tobject);
private
{ private declarations }
public
{ public declarations }
end;

var
form 1: t form 1;

implementation

{$r *.dfm}
procedure t form 1. form create(sender:tobject);
begin
ellipsebutton1:=tellipsebutton.create(self);
ellipsebutton1.parent:=self;
ellipsebutton1.setbounds(10,10,100,100);
ellipsebutton1.visible:=true;
end;

procedure t form 1. form destroy(sender:tobject);
begin
ellipsebutton1.free;
end;

End.

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

procedure register;
begin
registercomponents('usable', [tellipsebutton]);
end;

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

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