type
TActorEvent =
procedure (Sender:TObject)
of object;
TMyTimer =
class
private
FOnTimer:TActorEvent;
FInterval:Cardinal;
FHandle:Cardinal;
FOwner:Cardinal;
protected
procedure SetInterval(Value:Cardinal);
public
constructor Create(AOwner:Cardinal);
procedure AfterConstruction();
override;
procedure BeforeDestruction();
override;
procedure DoTimerProc();
published
property OnTimer:TActorEvent
read FOnTimer
write FOnTimer;
property Interval:Cardinal
read FInterval
write SetInterval;
end;
[...]
procedure TimerCallBack( Hwnd_ : HWND;
// handle of window for timer messages
uMsg :UINT;
// WM_TIMER message
idEvent :UINT;
// timer identifier
dwTime :DWORD
// current system time
);
stdcall;
var CallingTimer:TMyTimer;
begin
CallingTimer := TMyTimer(idEvent);
CallingTimer.DoTimerProc();
end;
{ TMyTimer }
procedure TMyTimer.AfterConstruction();
begin
inherited;
FInterval := 1000;
FHandle := SetTimer(FOwner, Cardinal(Self), FInterval,@TimerCallBack);
end;
procedure TMyTimer.BeforeDestruction();
begin
inherited;
KillTimer(FOwner,Cardinal(Self));
end;
constructor TMyTimer.Create(AOwner: Cardinal);
begin
FOwner := AOwner;
end;
procedure TMyTimer.DoTimerProc();
begin
if Assigned(FOnTimer)
then
FOnTimer(Self);
end;
procedure TMyTimer.SetInterval(Value: Cardinal);
begin
if FInterval <> Value
then
begin
FInterval := Value;
KillTimer(FOwner,Cardinal(Self));
FHandle := SetTimer(FOwner, Cardinal(Self), FInterval,@TimerCallBack);
end;
end;