mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-07 13:27:50 +02:00
+ Timer component by warleyalex
This commit is contained in:
parent
ec92165146
commit
801f362c24
122
packages/rtl/timer.pas
Normal file
122
packages/rtl/timer.pas
Normal file
@ -0,0 +1,122 @@
|
||||
{
|
||||
This file is part of the Pas2JS run time library.
|
||||
Copyright (c) 2018 by warleyalex <warleyalex@yahoo.com.br>
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
unit timer;
|
||||
|
||||
Interface
|
||||
|
||||
uses JS, Web, Classes;
|
||||
|
||||
type
|
||||
TTimer = class(TComponent)
|
||||
private
|
||||
FEnabled: Boolean; // True
|
||||
FInterval: Integer; // 1000
|
||||
FOnTimer: TNotifyEvent;
|
||||
FID: Integer;
|
||||
procedure SetEnabled(Value: Boolean);
|
||||
procedure SetInterval(Value: Integer);
|
||||
protected
|
||||
function DesignEvent: Boolean; virtual;
|
||||
procedure DoUpdateTimer; virtual;
|
||||
procedure DoClearTimer; virtual;
|
||||
procedure DoTimer; virtual;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
published
|
||||
{ Specifies whether the timer is enabled }
|
||||
property Enabled: Boolean read FEnabled write SetEnabled default True;
|
||||
{ Specifies the interval, in milliseconds, between timer events }
|
||||
property Interval: Integer read FInterval write SetInterval default 1000;
|
||||
property Tag;
|
||||
{ Fired when the timer interval has elapsed }
|
||||
property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTimer }
|
||||
|
||||
constructor TTimer.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FEnabled := True;
|
||||
FInterval := 1000;
|
||||
DoUpdateTimer;
|
||||
end;
|
||||
|
||||
destructor TTimer.Destroy;
|
||||
begin
|
||||
Enabled := False;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TTimer.DesignEvent: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TTimer.DoUpdateTimer;
|
||||
begin
|
||||
FID := window.setInterval(@DoTimer, FInterval);
|
||||
end;
|
||||
|
||||
procedure TTimer.DoClearTimer;
|
||||
begin
|
||||
if (FID <> 0) then
|
||||
begin
|
||||
window.clearInterval(FID);
|
||||
FID := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTimer.SetEnabled(Value: Boolean);
|
||||
begin
|
||||
if (Value <> FEnabled) then
|
||||
begin
|
||||
if Value then
|
||||
DoUpdateTimer
|
||||
else
|
||||
DoClearTimer;
|
||||
FEnabled := Value;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTimer.SetInterval(Value: Integer);
|
||||
begin
|
||||
if (Value <> FInterval) then
|
||||
begin
|
||||
if Enabled then
|
||||
begin
|
||||
Enabled := False;
|
||||
try
|
||||
FInterval := Value;
|
||||
finally
|
||||
Enabled := True;
|
||||
end;
|
||||
end
|
||||
else
|
||||
FInterval := Value;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTimer.DoTimer;
|
||||
begin
|
||||
if Assigned(FOnTimer) then
|
||||
FOnTimer(Self);
|
||||
end;
|
||||
|
||||
end.
|
Loading…
Reference in New Issue
Block a user