unit Timersu;{ Central point for registering timer event handlers by any objects }
{
  (C) 2000 - 2001 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}


interface
uses
  Classes, SysUtils, Timer, Compareu{v0.43}, CommObjs, ExeLogu{/v0.43}
  {.$IFNDEF CONSOLE}
  {v0.44}
  ,ExtCtrls{/v0.44}
  {.$ENDIF}
  {v0.47},UtlType, PropUtl{/v0.47};{ulantype}

{v0.47}
const
  TimersSec = 'Timers';

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.47}
    FTimerInterval: integer;
      { value used for FTimer, if active - ini property }
    {/v0.47}
    {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}
    {v0.47}
    procedure SetTimerInterval(AInterval: integer);
    {/v0.47}
  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}
  {v0.47}
    property TimerInterval: integer read FTimerInterval write SetTimerInterval;
  {/v0.47}
  end;

function Timers: TTimers;

implementation

const
  FTimers: TTimers = nil;

function Timers: TTimers;
begin
  if FTimers = nil then begin
    FTimers := TTimers.Create;
  end;
  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}
  {v0.47}
  FTimerInterval := 100;
  ConfigReadWriteValue(nil, rwRead, TimersSec, 'TimerInterval', @FTimerInterval, ptLongint);
  {/v0.47}
  Active := true;
end;

{v0.44}
function TTimers.GetTimer: TTimer;
begin
  if FTimer = nil then begin
    FTimer := TTimer.Create(nil);
    FTimer.Interval := {v0.47}FTimerInterval{/v0.47 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.47}
  ConfigReadWriteValue(nil, rwWrite, TimersSec, 'TimerInterval', @FTimerInterval, ptLongint);
  {/v0.47}
  {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;

{v0.47}
procedure TTimers.SetTimerInterval(AInterval: integer);
begin
  if FTimer <> nil then
    FTimer.Interval := AInterval;
  FTimerInterval := AInterval;
end;
{/v0.47}

{TTimers}

initialization

finalization
  FTimers.Free;
end.
