unit Timersu;

interface
uses
  Classes, SysUtils, Timer, Compareu{v0.43}, CommObjs, ExeLogu{/v0.43}
  {v0.44},ExtCtrls{/v0.44};

type
  {TTimerProcOption = (poPeriodic, poOneShot, poAutoDelete);}
  {TTimerProcOptions = set of TTimerProcOption;}
  TTimerProc = class(TObject)
  private
    {FOptions: TTimerProcOptions;}
    FDoTimer: TNotifyEvent;{TMethod}
    FInterval: integer;
    FNextTime: integer;
    FShouldDelete:boolean;
      { Set true if DeleteTimerProc was called for this TimerProc record but
        FDoTimer of this record was active. Will be deleted during next
        DoTimer proc. }
  public
    procedure DoTimer(Sender: TObject);
    constructor Create(ADoTimer: TNotifyEvent; AInterval: integer{; ATimerProcOptions: TTimerProcOptions});
  end;

  TTimers = class(TList)
  private
    FActive: boolean;
    {v0.26}
    FAddingTimerProc: boolean;
    {/v0.26}
    {v0.43}
    FCriticalSection: TCriticalSection;
    {/v0.43}
    {v0.44}
    FTimer: TTimer;
      { internal timer, used only if explicitely called: Timers.Timer.Enabled := true;
        otherwise the application must call Timers.DoTimer periodically (e.g. from
        MainForm Timer) }
    function GetTimer: TTimer;
    {/v0.44}
  public
    procedure AddTimerProc(ADoTimer: TNotifyEvent; AInterval: integer);
    procedure DeleteTimerProc(ADoTimer: TNotifyEvent);
    procedure DoTimer(Sender: TObject);
    constructor Create; reintroduce;
    destructor Destroy; override;
    property Active: boolean read FActive write FActive;{waitforsingleobject}
    {v0.44}
    property Timer: TTimer read GetTimer;
    {/v0.44}
  end;

function Timers: TTimers;

implementation

const
  FTimers: TTimers = nil;

function Timers: TTimers;
begin
  if FTimers = nil then
    FTimers := TTimers.Create;
  Result := FTimers;
end;

{TTimerProc}
constructor TTimerProc.Create(ADoTimer: TNotifyEvent; AInterval: Integer);
begin
  inherited Create;
  if not Assigned(ADoTimer) then
    raise Exception.Create('TTimerProc.Create ADoTimer = nil');
  FDoTimer := ADoTimer;
  FInterval := AInterval;
  FNextTime := mstime + FInterval;
end;

procedure TTimerProc.DoTimer(Sender: TObject);
begin
  if integer(mstime - FNextTime) >= 0 then begin
    FNextTime := FNextTime + FInterval;
    FDoTimer(Self);
    {if poAutoDelete in FOptions then}
  end;
end;
{/TTimerProc}

{TTimers}
constructor TTimers.Create;
begin
  inherited Create;
  {v0.43}
  FCriticalSection := TCriticalSection.Create;
  {/v0.43}
  Active := true;
end;

{v0.44}
function TTimers.GetTimer: TTimer;
begin
  if FTimer = nil then begin
    FTimer := TTimer.Create(nil);
    FTimer.Interval := 1000;
    FTimer.OnTimer := DoTimer;
    FTimer.Enabled := false;
  end;
  Result := FTimer;
end;
{/v0.44}

procedure TTimers.AddTimerProc(ADoTimer: TNotifyEvent; AInterval: integer);
begin
  {v0.26}
  FAddingTimerProc := true;
  try
  {/v0.26}
    Add(TTimerProc.Create(ADoTimer, AInterval));
  {v0.26}
  finally
    FAddingTimerProc := false;
  end;
  {/v0.26}
end;

procedure TTimers.DeleteTimerProc(ADoTimer: TNotifyEvent);
var
  i: integer;
  t: TTimerProc;
begin
  {v0.43}
  {commobjs commint}
  FCriticalSection.Enter;
  try
  {/v0.43}
  for i := 0 to Count - 1 do begin
    t := TTimerProc(Items[i]);
    if CompareRec(ADoTimer, t.FDoTimer, sizeof(TNotifyEvent)) = 0 then begin {ulobjact}
      {compareu commint}
      t.FShouldDelete := true;
      exit;
    end;
  end;
  {v0.43}{extctrls ttimer}
  finally
    FCriticalSection.Leave;
  end;
  {/v0.43}
end;

procedure TTimers.DoTimer(Sender: TObject);
var {logfrm}
  i: integer;
  t: TTimerProc;
begin
  if not FActive then
    exit;
  {v0.26}
  if FAddingTimerProc then
    exit;
  {/v0.26}
  {v0.43}
  DebLog('Timers.DoTimer begin');
  try
  {/v0.43}
    i := 0;
    while i < Count do begin
      t := TTimerProc(Items[i]);
      if t.FShouldDelete then begin
        Delete(i);
        t.Free;
      end else begin
        t.DoTimer(Sender);
        inc(i);
      end;
    end;
  {v0.43}
  finally
    DebLog('Timers.DoTimer end');
  end;
  {/v0.43}
end;

destructor TTimers.Destroy;
var
  i: integer;
begin
  Active := false;{commint}
  {v0.43}
  FTimer.Free;
  {v0.43}
  if FCriticalSection <> nil then begin
    FCriticalSection.Enter;
    for i := 0 to Count - 1 do
      TTimerProc(Items[i]).Free;
    FCriticalSection.Leave;
    FCriticalSection.Free;
  end else
  {/v0.43}
  begin
    for i := 0 to Count - 1 do
      TTimerProc(Items[i]).Free;
  end;
  inherited Destroy;
end;
{TTimers}

initialization

finalization
  FTimers.Free;
end.
