Пример создания нового события unit halfmin; interface
Листинг 19.14.Пример создания нового события unit halfmin; interface
uses
SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs;
type
TTimeEvent - procedure (Sender: TObject; TheTime: TDateTime) of object;
THalfMinute = class (TComponent)
private
FTimer: TTimer;
FOnHalfMinute: TTimeEvent;
FOldSecond, FSecond: Word; procedure FTimerTimer (Sender: TObject);
protected
procedure DoHalfMinute (TheTime: TDateTime);
dynamic; public
constructor Create (AOwner: TComponent);
override;
destructor Destroy; override; published
property OnHalfMinute: TTimeEvent read FOnHalfMinute write FOnHalf- Minute;
end;
implementation constructor THalfMinute.Create (AOwner: TComponent);
begin inherited Create (AOwner);
if not (csDesigning in ComponentState) then begin FTimer:=TTimer.Create(self);
FTimer.Enabled:= True; FTimer..Interval:= 500; FTimer.OnTimer:=FTimerTimer; end; end;
destructor THalfMinute.Destroy; begin
FTimer.Free;
inherited Destroy; end;
procedure THalfMinute.FTimerTimer (Sender: TObject);
var
DT: TDateTime; Temp: Word; begin
DT:=Now;
FOldSecond:=FSecond;
DecodeTime (DT,Temp,Temp,FSecond,Temp);
if FSecond <>
TOldSecond then
if ((FSecond=30) or (FSecond=0)) then
DoHalfMinute (DT);
end;
procedure THalfMinute.DoHalfMinute(TheTime: TDateTime);
begin
if Assigned (FOnHalfMinute) then FOnHalfMinute (Self, TheTime);
end;
end.
Для проверки работоспособности вышеприведенного кода вы можете добавить еще одну процедуру для регистрации нового компонента с именем ThalfMinute, предварительно расположив в interface часть программы строку:
procedure Register;
Ниже представлен код для регистрации компонента:
procedure Register; begin
RegisterComponents('Samples', [THalfMinute]}; end;
Для просмотра работоспособности нового компонента, после его регистрации создадим новую форму и разместим на ней новый компонент. Добавим на форму компонент Tedit, а затем — обработчик события OnHalfMinute для формы (листинг 19.15).
