При первом знакомстве с 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;
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 вы можете преспокойно написать любой замысловатый элемент интерфейса и даже продавать его как отдельный программный продукт за немаленькие деньги.
Источник: gigabyte.iatp.org.ua
Автор: Михаил Продан
|