Пособие по написанию своих компонентов
Falk0ner, вс, 06/07/2008 - 15:34.
Теперь в конструкторе (Create), нам надо создать этот компонент:
Теперь надо объявить процедуры ChangeBackColor, ChangeFontColor. Чтобы они были доступны пользователю их надо поместить в директиву Public:
Осталось написать сами процедуры. Все очень просто: открываете диалог методом Execute, а затем присваиваете полученное значение цвета метке. У меня эти процедуры имеют такой вид:
Доступ к свойствам другого компонента
Сейчас нам предстоит более сложная задача. Мы будем создавать компонент, вместе с которым будет создаваться какой-нибудь визуальный компонент. Например создадим кнопку, которая будет сопровождаться поясняющей надписью сверху. За основу возмем тип TButton. Нам надо будет создать еще и Label. Здесь существует одна проблемка: при перемещении компонента по форме, метка должна двигаться вместе с кнопкой, поэтому нам придется обрабатывать сообщение WmMove. Итак, объявляем переменную Label (в данном примере она объявлена в директиве Private, что тоже допустимо):
Можно сделать доступ к любым свойствам метки, например, к шрифту, цвету и так далее, используя необходимые процедуры.
Использование в качестве предка класс TWinControl
Предыдущий пример был очень сложным, к тому же пришлось обрабатывать системные сообщения. Есть другое решение этой проблемы, более простое для понимания и для реализации: использовать в качестве контейнера класс TWinControl и в этот контейнер помещать другие компоненты. Теперь попробуем совместить Edit и Label. Давайте вместе создадим такой компонент. В качестве предка нужно выбрать класс TWinControl, а в качестве типа вашего компонента выберите TlabelEdit. Будем разбирать код по кусочкам.
Попробуйте установить этот компонент. Когда вы будете размещать его на форме, то будет виден "контейнер", на котором располагаются Edit и Label. Использование в качестве предка компонента класса TWinControl, очень удобно если вы хотите объединить несколько визуальных компонентов.
А в директиве Published надо написать:
Ну и теперь осталось описать нужные процедуры:
Таким образом весь код компонента был таким:
Имплантируем таймер в компонент Очень часто бывает, что вам необходимо вставить в компонент, какой-нибудь другой компонент, например, таймер. Как обычно будем рассматривать этот процесс на конкретном примере. Сделаем так, что через каждые 10 секунд значение счетчика кликов будет удваиваться. Для этого мы встроим таймер в нашу кнопку. Нам понадобиться сделать несколько несложных шагов. После раздела uses, где описаны добавленные в программу модули, объявите переменную типа TTimer. Назовем ее Timer. Приведу небольшой участок кода:
unit CountBtn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
var Timer: TTimer;
type
Дальше в директиву Protected необходимо добавить обработчик события OnTimer для нашего таймера. Это делается так:
procedure OnTimer(Sender: TObject);
Поскольку наш таймер это не переменная, а компонент, его тоже надо создать, для этого в конструктор нашей кнопки напишем:
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
var Timer: TTimer;
type
constructor TCountBtn.Create(aowner:Tcomponent);
begin
inherited create(Aowner);
Timer:=TTimer.Create(self);
Timer.Enabled:=true;
Timer.OnTimer:=OnTimer;
Timer.Interval:=10000;
end;
Здесь создается экземпляр нашего таймера и его свойству Iterval (измеряется в миллисекундах) присваивается значение 10000 (то есть 10 секунд если по простому).
Собственно осталось написать саму процедуру OnTimer. Я сделал это так:
begin
inherited create(Aowner);
Timer:=TTimer.Create(self);
Timer.Enabled:=true;
Timer.OnTimer:=OnTimer;
Timer.Interval:=10000;
end;
procedure TCountBtn.OnTimer(Sender: TObject);
begin
FCount:=FCount*2;
end;
Вот примерно то, что у вас должно получиться в конце:
unit CountBtn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
var Timer: TTimer;
type
TShowTp = (Normal, CountToCaption);
TCountBtn = class(TButton)
private
{ Private declarations }
FCount:integer;
FShowType:TShowTp;
protected
{ Protected declarations }
procedure OnTimer(Sender: TObject);
procedure Click;override;
public
{ Public declarations }
procedure ShowCount;
published
{ Published declarations }
property Count:integer read FCount write FCount;
constructor Create(aowner:Tcomponent);override;
property ShowType: TshowTp read FshowType write FShowType;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Mihan Components', [TCountBtn]);
end;
constructor TCountBtn.Create(aowner:Tcomponent);
begin
inherited create(Aowner);
Timer:=TTimer.Create(self);
Timer.Enabled:=false;
Timer.OnTimer:=OnTimer;
Timer.Interval:=1000;
end;
procedure Tcountbtn.Click;
begin
inherited click;
FCount:=Fcount+1;
Timer.Enabled:=true;
if ShowType = Normal then
Caption:=Caption;
if ShowType = CountToCaption then
Caption:='Count= '+inttostr(count);
end;
procedure TCountBtn.ShowCount;
begin
Showmessage('По кнопке '+ caption+' вы сделали: '+inttostr(FCount)+' клик(а/ов)');
end;
procedure TCountBtn.OnTimer(Sender: TObject);
begin
FCount:=FCount*2;
end;
end.
Если у вас что-то не сработало, то в начале проверьте все ли у вас написано правильно. Затем проверьте может у вас не хватает какого-нибудь модуля в разделе Uses.
Переустановка компонента
Очень часто бывает необходимо переустановить ваш компонент. Если вы попробуете сделать это путем выбора Component->Install Component, то Дельфи вас честно предупредит о том, что пакет уже содержит модуль с таким именем. Перед вами открывается окно с содержимым пакета. В нем вы должны найти имя вашего компонента и удалить его (либо нажать кнопочку Remove). Теперь в пакете уже нет вашего компонента. Затем проделайте стандартную процедуру по установке компонента.
Редактирование значения, которое ввел пользователь, изменяя какое-нибудь свойство.
Простой пример. Допустим у нас есть компонент (основанный на Tedit), у него есть два свойства: FirstNumber и SecondNumber. И у него есть процедура Division, в которой первое число делится на второе и результат присаивается свойству текст нашего компонента. Вот код этого компонента:
begin
FCount:=FCount*2;
end;
Вот примерно то, что у вас должно получиться в конце:
unit CountBtn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
var Timer: TTimer;
type
TShowTp = (Normal, CountToCaption);
TCountBtn = class(TButton)
private
{ Private declarations }
FCount:integer;
FShowType:TShowTp;
protected
{ Protected declarations }
procedure OnTimer(Sender: TObject);
procedure Click;override;
public
{ Public declarations }
procedure ShowCount;
published
{ Published declarations }
property Count:integer read FCount write FCount;
constructor Create(aowner:Tcomponent);override;
property ShowType: TshowTp read FshowType write FShowType;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Mihan Components', [TCountBtn]);
end;
constructor TCountBtn.Create(aowner:Tcomponent);
begin
inherited create(Aowner);
Timer:=TTimer.Create(self);
Timer.Enabled:=false;
Timer.OnTimer:=OnTimer;
Timer.Interval:=1000;
end;
procedure Tcountbtn.Click;
begin
inherited click;
FCount:=Fcount+1;
Timer.Enabled:=true;
if ShowType = Normal then
Caption:=Caption;
if ShowType = CountToCaption then
Caption:='Count= '+inttostr(count);
end;
procedure TCountBtn.ShowCount;
begin
Showmessage('По кнопке '+ caption+' вы сделали: '+inttostr(FCount)+' клик(а/ов)');
end;
procedure TCountBtn.OnTimer(Sender: TObject);
begin
FCount:=FCount*2;
end;
end.
unit DivEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TDivEdit = class(Tedit)
private
{ Private declarations }
FFirstNumber:integer;
FSecondNumber:integer;
FResult:Single; //в компонентах нельзя использовать Real!!!
protected
{ Protected declarations }
public
{ Public declarations }
procedure Division;
published
{ Published declarations }
constructor create(aowner:Tcomponent);override;
property FirstNumber:integer read FFirstNumber write FFirstNumber;
property SecondNumber:integer read FSecondNumber write FSecondNumber;
property Result:Single read Fresult write FResult;
end;
procedure Register;
implementation
Constructor TDivEdit.create(aowner:Tcomponent);
begin
inherited create(aowner);
FFirtsNumber:=1;
FSecondNumber:=1;
end;
procedure TDivEdit.Division;
begin
FResult:=FFirstNumber/FSecondNumber;
text:=floattostr(FResult);
end;
procedure Register;
begin
RegisterComponents('Mihan Components', [TDivEdit]);
end;
end.
Хочется обратить ваше внимание на то, что в компонентах нельзя использовать переменные и поля типа Real, вместо него нужно брать переменные типов Single, Double, Extended.
Здесь все просто. Но вот если пользователю вздумается поделить на ноль (ну вдруг он математики не знает), то компонент выдаст ошибку DivisionByZero, а кому они нужны. Обойти эту проблему можно так: в код компонента добавить процедуру, которая проанализирует данные введенные пользователь и если все будет в порядке, то она присвоит значения соответствующим свойтсвам. В директиве Private объявите такую процедуру:
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TDivEdit = class(Tedit)
private
{ Private declarations }
FFirstNumber:integer;
FSecondNumber:integer;
FResult:Single; //в компонентах нельзя использовать Real!!!
protected
{ Protected declarations }
public
{ Public declarations }
procedure Division;
published
{ Published declarations }
constructor create(aowner:Tcomponent);override;
property FirstNumber:integer read FFirstNumber write FFirstNumber;
property SecondNumber:integer read FSecondNumber write FSecondNumber;
property Result:Single read Fresult write FResult;
end;
procedure Register;
implementation
Constructor TDivEdit.create(aowner:Tcomponent);
begin
inherited create(aowner);
FFirtsNumber:=1;
FSecondNumber:=1;
end;
procedure TDivEdit.Division;
begin
FResult:=FFirstNumber/FSecondNumber;
text:=floattostr(FResult);
end;
procedure Register;
begin
RegisterComponents('Mihan Components', [TDivEdit]);
end;
end.
procedure SetSecondNumber(value:integer);
Обычно такие процедуры начинаются с приставки Set, затем идет имя свойства, и в конце тип переменной. Теперь в директиве Published надо сделать небольшие изменения:
property SecondNumber:integer read FSecondNumber write SetSecondNumber;
А теперь напишем саму процедуру:
procedure TDivEdit.SetSecondNumber(value:Integer);
begin
if value<>FSecondNumber then //надо проверить совпадают ли исходное и вводимое значения
FSecondNumber:=value; //если нет, то изменить значение
if FSecondNumber=0 then
FSecondNumber:=1;
end;
begin
if value<>FSecondNumber then //надо проверить совпадают ли исходное и вводимое значения
FSecondNumber:=value; //если нет, то изменить значение
if FSecondNumber=0 then
FSecondNumber:=1;
end;
Теперь сколько бы пользователь не вводил нулей значение SecondNumber будет единицей. Такие процедуры проверки рекомендуется использовать везде, где только допустимо появление исключительной ситуации.
Использование другого компонента в вашем
Попробуем создать такой компонент. Это будет обычная метка (Label), у которой будет две процедуры: ChangeBackColor и ChangeFontColor, которые соответственно будут менять цвет фона метки и цвет текста. Для этого нам понадобиться ColorDialog, который будет создаваться вместе с компонентом, а потом с помощью процедур он будет активироваться. Назовем компонент ColorLabel. Вначале добавим в uses два модуля: Dialogs, StdCtrls (в них находятся описания классаов диалога и метки). Теперь нам надо объявить переменную типа TColorDialog. Объявление идет сразу после секции Uses.
Примерно это выглядит так:
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls;
var ColorDialog:TColorDialog;
type
...
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls;
var ColorDialog:TColorDialog;
type
...
Теперь в конструкторе (Create), нам надо создать этот компонент:
constructor TColorLabel.create(aowner:Tcomponent);
begin
Inherited Create(aowner);
ColorDialog:=TColorDialog.Create(self);
end;
begin
Inherited Create(aowner);
ColorDialog:=TColorDialog.Create(self);
end;
Теперь надо объявить процедуры ChangeBackColor, ChangeFontColor. Чтобы они были доступны пользователю их надо поместить в директиву Public:
public
{ Public declarations }
procedure ChangeBackColor;
procedure ChangeFontColor;
published
{ Public declarations }
procedure ChangeBackColor;
procedure ChangeFontColor;
published
Осталось написать сами процедуры. Все очень просто: открываете диалог методом Execute, а затем присваиваете полученное значение цвета метке. У меня эти процедуры имеют такой вид:
procedure TColorLabel.ChangeBackColor;
begin
if ColorDialog.Execute then
color:=ColorDialog.color;
end;
procedure TColorLabel.ChangeFontColor;
begin
if ColorDialog.Execute then
font.color:=ColorDialog.color;
end;
Если у вас вдруг что-то не получилось, то взгляните на мой код целиком:
unit ColorLabel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls;
var ColorDialog:TColorDialog;
type
TColorLabel = class(Tlabel)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
procedure ChangeBackColor;
procedure ChangeFontColor;
published
{ Published declarations }
constructor create(aowner:tcomponent);override;
end;
procedure Register;
implementation
constructor TColorLabel.create(aowner:Tcomponent);
begin
Inherited Create(aowner);
ColorDialog:=TColorDialog.Create(self);
end;
procedure TColorLabel.ChangeBackColor;
begin
if ColorDialog.Execute then
color:=ColorDialog.color;
end;
procedure TColorLabel.ChangeFontColor;
begin
if ColorDialog.Execute then
font.color:=ColorDialog.color;
end;
procedure Register;
begin
RegisterComponents('Mihan Components', [TColorLabel]);
end;
end.
begin
if ColorDialog.Execute then
color:=ColorDialog.color;
end;
procedure TColorLabel.ChangeFontColor;
begin
if ColorDialog.Execute then
font.color:=ColorDialog.color;
end;
Если у вас вдруг что-то не получилось, то взгляните на мой код целиком:
unit ColorLabel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls;
var ColorDialog:TColorDialog;
type
TColorLabel = class(Tlabel)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
procedure ChangeBackColor;
procedure ChangeFontColor;
published
{ Published declarations }
constructor create(aowner:tcomponent);override;
end;
procedure Register;
implementation
constructor TColorLabel.create(aowner:Tcomponent);
begin
Inherited Create(aowner);
ColorDialog:=TColorDialog.Create(self);
end;
procedure TColorLabel.ChangeBackColor;
begin
if ColorDialog.Execute then
color:=ColorDialog.color;
end;
procedure TColorLabel.ChangeFontColor;
begin
if ColorDialog.Execute then
font.color:=ColorDialog.color;
end;
procedure Register;
begin
RegisterComponents('Mihan Components', [TColorLabel]);
end;
end.
Доступ к свойствам другого компонента
Сейчас нам предстоит более сложная задача. Мы будем создавать компонент, вместе с которым будет создаваться какой-нибудь визуальный компонент. Например создадим кнопку, которая будет сопровождаться поясняющей надписью сверху. За основу возмем тип TButton. Нам надо будет создать еще и Label. Здесь существует одна проблемка: при перемещении компонента по форме, метка должна двигаться вместе с кнопкой, поэтому нам придется обрабатывать сообщение WmMove. Итак, объявляем переменную Label (в данном примере она объявлена в директиве Private, что тоже допустимо):
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls,buttons;
type
TLabelButton = class(TButton)
private
FLabel : TLabel ;
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls,buttons;
type
TLabelButton = class(TButton)
private
FLabel : TLabel ;
Теперь я приведу весь код этого компонента и походу буду вставлять необходимые пояснения:
unit LabelBtn;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls,buttons;
type
TLabelButton = class(TButton)
private
FLabel : TLabel ; {создаем поле типа Tlabel}
procedure WMMove( var Msg : TWMMove ) ; message WM_MOVE ;{процедура для обработки сообщения Wm_move, чтобы метка перемещалась вместе с кнопкой}
protected
procedure SetParent( Value : TWinControl ) ; override ;{необходимо воспользоваться и этой процедурой, так как нужно убедиться, имеют ли кнопка и метка общего предка}
function GetLabelCaption : string ; virtual ; {Вот пример доступа из компонента к свойствам другого. Эти две процедуры для изменения текста метки}
procedure SetLabelCaption( const Value : string ) ; virtual ;
public
constructor Create( AOwner : TComponent ) ; override ;
destructor Destroy ; override ;
published
property LabelCaption : string read GetLabelCaption write
SetLabelCaption ;
end;
procedure Register;
implementation
constructor TLabelButton.Create( AOwner : TComponent ) ;
begin
inherited Create( AOwner ) ;
{ создаем TLabel }
FLabel := TLabel.Create( NIL ) ;
FLabel.Caption := 'Описание:' ;
end ;
procedure TLabelButton.SetParent( Value : TWinControl ) ;
begin
{надо убедиться, что у них предок один, чтоб проблем потом не было}
if ( Owner = NIL ) or not ( csDestroying in Owner.ComponentState ) then
FLabel.Parent := Value ;
inherited SetParent( Value ) ;
end ;
destructor TLabelButton.Destroy ;
begin
if ( FLabel <> NIL ) and ( FLabel.Parent = NIL ) then
FLabel.Free ;{Уничтожаем метку, т.к. она нам больше не нужна}
inherited Destroy ;
end ;
function TLabelButton.GetLabelCaption : string ;
begin
Result := FLabel.Caption ;
end ;
procedure TLabelButton.SetLabelCaption( const Value : string ) ;
begin
FLabel.Caption := Value ;
end ;
procedure TLabelButton.WMMove( var Msg : TWMMove ) ;
begin
inherited ;
if FLabel <> NIL then with Flabel do
SetBounds( Msg.XPos, Msg.YPos - Height, Width,Height ) ; {изменяем левое и верхнее положение метки исходя из полученных координат}
end;
procedure Register;
begin
RegisterComponents('Mihan Components', [TLabelButton]);
end;
initialization
RegisterClass( TLabel ) ; {Это делается для обеспечения поточности, но об этом не думайте, этим редко придется пользоваться}
end.{Вы можете пользоваться этим компонентом сколько угодно, но распространять его можно только указывая авторство}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls,buttons;
type
TLabelButton = class(TButton)
private
FLabel : TLabel ; {создаем поле типа Tlabel}
procedure WMMove( var Msg : TWMMove ) ; message WM_MOVE ;{процедура для обработки сообщения Wm_move, чтобы метка перемещалась вместе с кнопкой}
protected
procedure SetParent( Value : TWinControl ) ; override ;{необходимо воспользоваться и этой процедурой, так как нужно убедиться, имеют ли кнопка и метка общего предка}
function GetLabelCaption : string ; virtual ; {Вот пример доступа из компонента к свойствам другого. Эти две процедуры для изменения текста метки}
procedure SetLabelCaption( const Value : string ) ; virtual ;
public
constructor Create( AOwner : TComponent ) ; override ;
destructor Destroy ; override ;
published
property LabelCaption : string read GetLabelCaption write
SetLabelCaption ;
end;
procedure Register;
implementation
constructor TLabelButton.Create( AOwner : TComponent ) ;
begin
inherited Create( AOwner ) ;
{ создаем TLabel }
FLabel := TLabel.Create( NIL ) ;
FLabel.Caption := 'Описание:' ;
end ;
procedure TLabelButton.SetParent( Value : TWinControl ) ;
begin
{надо убедиться, что у них предок один, чтоб проблем потом не было}
if ( Owner = NIL ) or not ( csDestroying in Owner.ComponentState ) then
FLabel.Parent := Value ;
inherited SetParent( Value ) ;
end ;
destructor TLabelButton.Destroy ;
begin
if ( FLabel <> NIL ) and ( FLabel.Parent = NIL ) then
FLabel.Free ;{Уничтожаем метку, т.к. она нам больше не нужна}
inherited Destroy ;
end ;
function TLabelButton.GetLabelCaption : string ;
begin
Result := FLabel.Caption ;
end ;
procedure TLabelButton.SetLabelCaption( const Value : string ) ;
begin
FLabel.Caption := Value ;
end ;
procedure TLabelButton.WMMove( var Msg : TWMMove ) ;
begin
inherited ;
if FLabel <> NIL then with Flabel do
SetBounds( Msg.XPos, Msg.YPos - Height, Width,Height ) ; {изменяем левое и верхнее положение метки исходя из полученных координат}
end;
procedure Register;
begin
RegisterComponents('Mihan Components', [TLabelButton]);
end;
initialization
RegisterClass( TLabel ) ; {Это делается для обеспечения поточности, но об этом не думайте, этим редко придется пользоваться}
end.{Вы можете пользоваться этим компонентом сколько угодно, но распространять его можно только указывая авторство}
Можно сделать доступ к любым свойствам метки, например, к шрифту, цвету и так далее, используя необходимые процедуры.
Использование в качестве предка класс TWinControl
Предыдущий пример был очень сложным, к тому же пришлось обрабатывать системные сообщения. Есть другое решение этой проблемы, более простое для понимания и для реализации: использовать в качестве контейнера класс TWinControl и в этот контейнер помещать другие компоненты. Теперь попробуем совместить Edit и Label. Давайте вместе создадим такой компонент. В качестве предка нужно выбрать класс TWinControl, а в качестве типа вашего компонента выберите TlabelEdit. Будем разбирать код по кусочкам.
unit LabelEdit;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, stdctrls;
type
TLabelEdit = class(TWinControl)
private
{ Private declarations }
FEdit: TEdit;
FLabel: TLabel;
//Здесь объявляются поля для метки и для Edita.
function GetLabelCaption: string;
procedure SetLabelCaption(LabelCaption: string);
function GetEditText: string;
procedure SetEditText(EditText: string);
//Здесь объявлены функции для работы со свойствами Caption у метки и Text у Edita.
protected
{ Protected declarations }
public
{ Public declarations } constructor Create(AOwner: TComponent); override; published
property LabelCaption: string read GetLabelCaption write SetLabelCaption;
property EditText: string read GetEditText write SetEditText;
{ Published declarations }
end;
procedure Register;
implementation
constructor TLabelEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEdit := TEdit.Create(self);{создаем поле редактирования Edit}
FLabel := TLabel.Create(self);{создаем Label}
with FLabel do begin
Width := FEdit.Width;
visible := true;
Parent := self;
Caption := 'Описание:';
end;
with FEdit do begin
:= FLabel.Height+2;
Parent := self;
Visible := true;
end;
:= 0;
Left := 0;
Width := FEdit.Width;
Height := FEdit.Height+FLabel.Height;{определяются размеры и положение компонентов}
Visible := true;
end;
function TLabelEdit.GetLabelCaption: string;
begin
Result := FLabel.Caption;
end;
procedure TLabelEdit.SetLabelCaption(LabelCaption: string);
begin
FLabel.Caption := LabelCaption;
end;
function TLabelEdit.GetEditText: string;
begin
Result := FEdit.Text;
end;
procedure TLabelEdit.SetEditText(EditText: string);
begin
FEdit.Text := EditText;
end;
procedure Register;
begin
RegisterComponents('Mihan Components', [TLabelEdit]);
end;
end.
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, stdctrls;
type
TLabelEdit = class(TWinControl)
private
{ Private declarations }
FEdit: TEdit;
FLabel: TLabel;
//Здесь объявляются поля для метки и для Edita.
function GetLabelCaption: string;
procedure SetLabelCaption(LabelCaption: string);
function GetEditText: string;
procedure SetEditText(EditText: string);
//Здесь объявлены функции для работы со свойствами Caption у метки и Text у Edita.
protected
{ Protected declarations }
public
{ Public declarations } constructor Create(AOwner: TComponent); override; published
property LabelCaption: string read GetLabelCaption write SetLabelCaption;
property EditText: string read GetEditText write SetEditText;
{ Published declarations }
end;
procedure Register;
implementation
constructor TLabelEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEdit := TEdit.Create(self);{создаем поле редактирования Edit}
FLabel := TLabel.Create(self);{создаем Label}
with FLabel do begin
Width := FEdit.Width;
visible := true;
Parent := self;
Caption := 'Описание:';
end;
with FEdit do begin
:= FLabel.Height+2;
Parent := self;
Visible := true;
end;
:= 0;
Left := 0;
Width := FEdit.Width;
Height := FEdit.Height+FLabel.Height;{определяются размеры и положение компонентов}
Visible := true;
end;
function TLabelEdit.GetLabelCaption: string;
begin
Result := FLabel.Caption;
end;
procedure TLabelEdit.SetLabelCaption(LabelCaption: string);
begin
FLabel.Caption := LabelCaption;
end;
function TLabelEdit.GetEditText: string;
begin
Result := FEdit.Text;
end;
procedure TLabelEdit.SetEditText(EditText: string);
begin
FEdit.Text := EditText;
end;
procedure Register;
begin
RegisterComponents('Mihan Components', [TLabelEdit]);
end;
end.
Попробуйте установить этот компонент. Когда вы будете размещать его на форме, то будет виден "контейнер", на котором располагаются Edit и Label. Использование в качестве предка компонента класса TWinControl, очень удобно если вы хотите объединить несколько визуальных компонентов.
Обработка событий OnMouseDown, OnMouseMove и OnMouseUp
Часто возникает необходимость обработки событий нажатия и отпускания кнопки в вашем компоненте. Сейчас мы это и рассмотрим. Только ради примера сделаем компонент, который будет считать количество нажатий и отпусканий кнопки в его области, допустим это будет панель (Tpanel). Для этого в директиве Private надо объявить следующие процедуры и поля:
FClickCount:integer;
FUpCount:integer;
procedure MouseDown(Button:TMouseButton; Shift: TShiftState; X,Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y: Integer); override;
FUpCount:integer;
procedure MouseDown(Button:TMouseButton; Shift: TShiftState; X,Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y: Integer); override;
А в директиве Published надо написать:
constructor create(aowner:tcomponent);override;
property ClickCount:integer read FclickCount write FClickCount;
property UpCount:integer read FUpCount write FUpCount;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property ClickCount:integer read FclickCount write FClickCount;
property UpCount:integer read FUpCount write FUpCount;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
Ну и теперь осталось описать нужные процедуры:
procedure TMpanel.MouseDown(Button:TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
FClickCount:=FClickCount+1;
end;
procedure TMpanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
caption:=inttostr(x)+' '+inttostr(y);{для демонстрации работы этой процедуры. Надпись на панели будет отражать координаты курсора мыши над этой панелью}
end;
procedure TMpanel.MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y: Integer);
begin
FUpCount:=FUpCount+1;
end;
begin
FClickCount:=FClickCount+1;
end;
procedure TMpanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
caption:=inttostr(x)+' '+inttostr(y);{для демонстрации работы этой процедуры. Надпись на панели будет отражать координаты курсора мыши над этой панелью}
end;
procedure TMpanel.MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y: Integer);
begin
FUpCount:=FUpCount+1;
end;
Таким образом весь код компонента был таким:
unit Mpanel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TMpanel = class(TPanel)
private
{ Private declarations }
FClickCount:integer;
FUpCount:integer;
procedure MouseDown(Button:TMouseButton; Shift: TShiftState; X,Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y: Integer); override;
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
constructor create(aowner:tcomponent);override;
property ClickCount:integer read FclickCount write FClickCount;
property UpCount:integer read FUpCount write FUpCount;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
constructor TMpanel.create(aowner:Tcomponent);
begin
inherited create(aowner);
end;
procedure TMpanel.MouseDown(Button:TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
FClickCount:=FClickCount+1;
end;
procedure TMpanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
caption:=inttostr(x)+' '+inttostr(y);
end;
procedure TMpanel.MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y: Integer);
begin
FUpCount:=FUpCount+1;
end;
procedure Register;
begin
RegisterComponents('Mihan Components', [TMpanel]);
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TMpanel = class(TPanel)
private
{ Private declarations }
FClickCount:integer;
FUpCount:integer;
procedure MouseDown(Button:TMouseButton; Shift: TShiftState; X,Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y: Integer); override;
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
constructor create(aowner:tcomponent);override;
property ClickCount:integer read FclickCount write FClickCount;
property UpCount:integer read FUpCount write FUpCount;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
constructor TMpanel.create(aowner:Tcomponent);
begin
inherited create(aowner);
end;
procedure TMpanel.MouseDown(Button:TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
FClickCount:=FClickCount+1;
end;
procedure TMpanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
caption:=inttostr(x)+' '+inttostr(y);
end;
procedure TMpanel.MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y: Integer);
begin
FUpCount:=FUpCount+1;
end;
procedure Register;
begin
RegisterComponents('Mihan Components', [TMpanel]);
end;
end.
Создание и использование своей иконки для компонента
Когда вы создали свой компонент и установили его, та на палитре компонентов, его иконка будет такой же как и у компонента, который вы выбрали в качестве предка. Конечно же вам хотелось бы видеть свой компонент со своей иконкой. Для этого необходимо создать файл ресурсов компонента. Сейчас я расскажу вам как это делается.
Откройте Image Editor (Tools->Image Editor) и выберите File->New->Component Resourse File. Перед вами появится небольшое окно с надписью Untitled.dcr в нем будет только одно слово: Contents. Нажмите на него правой кнопкой и в появившемся меню выберите New->Bitmap. Откроется диалоговое окно для настройки параметров изображения. Они должны быть такими: Размер 32x32, цветовой режим VGA (16 colors). Теперь нажмите ok. Теперь надо нажать правой кнопкой на появившейся надписи Bitmap1 и выбрать пункт Rename. Название картинки должно совпадать с названием класса компонента, для которого вы делаете эту иконку (например, TMPanel). Нажмите два раза на Bitmap1 и перед вами появится окно для рисования. Нарисуйте, что вам надо и перейдите на окно с надписью Untitled.dcr и в меню File выберите Save. Имя файла ресурса компонента должно совпадать с именем модуля компонента (без расширения конечно же, например, Mpanel). Файл ресурса готов. Теперь установите ваш компонент заново и в палитре компонентов ваш компонент будет уже с новой иконкой.
Источник: http://delphid.dax.ru
Отправить комментарий