14. Пример создания компонента часы

Текущее время отображается на компоненте-потомке TCustomLabel по событию OnTimer компонента Ttimer.

unit TimeLabel;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, extctrls;

type

TTimeLabel = class(TCustomLabel)

private

FActive: Boolean;

protected

T: Ttimer; // таймер

procedure GetTime (s: Tobject);

procedure ChangeActive(a: boolean);

public

constructor Create (Owner: Tcomponent); override;

destructor Destroy; override;

published

property Active: Boolean read FActive write ChangeActive;

property Color;

property Font;

end;

procedure Register;

implementation

procedure TTimeLabel.GetTime;

begin

// Этот метод отображает на заголовке время. Чтобы все

// работало, его надо будет назначить событию OnTimer

// таймер.

if Active then

50

Caption:=TimeToStr(Time);

end;

procedure TTimeLabel.ChangeActive;

begin

FActive:=A;

T.Enabled:=A;

Visible:=A;

end;

constructor TTimeLabel.create;

begin

Inherited create(Owner);

T:=TTimer.Create(Self);

T.Enabled:=true;

T.Interval:=1000;

// Присваиваем событию обработчик:

T.OnTimer:=GetTime;

FActive:=True;

Width:=50;

Height:=30;

end;

destructor TTimeLabel.destroy;

begin

T.Free;

inherited Destroy;

end;

procedure Register;

begin

RegisterComponents('Samples', [TTimeLabel]);

end;

end.

Для тестирования создайте новый проект, добавьте в секцию uses ссылку на модуль TimeLabel и в обработчик OnCreate для формы запишите:

procedure TForm1.FormCreate(Sender: TObject);

var L: TTimeLabel;

begin

L:=TTimeLabel.Create(self);

L.Parent:=Self;

L.top:=0;

L.Left:=Clientwidth-L.width;

end;

15. Пример создания компонента с опубликованным свойством Tstrings.

unit CalcBox;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

type

TCalcBox = class(TCustomGroupBox)

52

private

FText: TStrings;

btCalc: TButton;

lbResult: TLabel;

protected

procedure SetText(value: TStrings);

procedure btCalcClick(sender: TObject);

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

{ Published declarations }

property Caption;

property Top;

property Height;

property Width;

// Свойство класса TStrings

property Text: TStrings read FText write SetText;

end;

procedure Register;

implementation

constructor TCalcBox.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

Width := 200; Height := 150;

caption:='сумма';

btCalc:=TButton.Create (self);

with btCalc do begin

Width := 75; Height := 25;

53

Parent:=Self;

Top:=120;

Left:=0;

Caption:='Calculate';

// делегируем метод btCalcClick событию OnClick

OnClick:=btCalcClick;

end;

lbResult:=TLabel.Create (self);

with lbResult do begin

Width := 75; Height := 25;

Parent:=Self;

top:=60;

Left:=0;

Caption:='';

end;

//Создаем потомок абстрактного класса TStrings

FText:=TStringList.create;

FText.clear;

end;

procedure TCalcBox.SetText(Value: TStrings);

begin

// копируем в поле FText содержимое TStrings

FText.Assign(Value);

end;

procedure TCalcBox.btCalcClick(Sender: TObject);

var sum: extended;

i: integer;

begin

// Подсчитываем сумму введенных значений

try

Sum:=0;

54

for i:=0 to Text.Count-1 do

Sum:=Sum+ StrToFloat(Text[i]);

lbResult.Caption:=FloatToStr(Sum);

except

ShowMessage('Ошибка преобразования!');

end;

end;

destructor TCalcBox.Destroy;

begin

btCalc.free;

lbResult.Free;

inherited Destroy;

end;

procedure Register;

begin

RegisterComponents('Samples', [TCalcBox]);

end;

end.