ettimers.pas

a voice guide client ,it is the second part of voice guide center

{
  $create by mous 2006-03-18
    1、可添加多个后台任务的线程类
    2、能同时指向多个任务的定时器类

}
unit etTimers;

interface

uses
  classes  
  , ExtCtrls
  , Forms
  ;

type

  //////////////////////////////////////////////////////////////////////////////
  // 后台执行线程，用于偷偷做某些任务而不影响主程序的工作
  TEtDaemonWorker = class(TThread)
  private
    FTasks      : TThreadList;
    procedure   Run;
  protected
    procedure   Execute; override;
  public
    constructor Create;
    destructor  Destroy; override;

    procedure   AddTask( _name: String; _ev: TThreadMethod );
    procedure   DelTask( _name: String );
    procedure   ClearTasks;
  end;

  //////////////////////////////////////////////////////////////////////////////
  // 可以同时执行多任务的定时器，避免在一个程序中使用多个 Timer 浪费系统资源
  TEtTimerTasks  = class( TObject )
  private
    FName       : String;
    FTimer      : TTimer;
    FTasks      : TList;

    procedure   DoTimer(Sender: TObject);
    procedure   setActive(const Value: Boolean);
    function    getActive: Boolean;
  protected
  public
    constructor Create( _name: String );
    destructor  Destroy; override;

    procedure   AddTask( _name: String; _method: TThreadMethod; _seconds: Cardinal);
    procedure   DelTask( _name: String );
    procedure   ClearAll;

    property    Name: String read FName;
    property    Active: Boolean read getActive write setActive;
  end;

implementation

type

  PEtDaemonTask   = ^TEtDaemonTask;
  TEtDaemonTask   = record
    taskName    : String;
    DoTask      : TThreadMethod;
  end;

  T_TimerTask  = class
  private
    Name        : String;
    Process     : TThreadMethod;
    Interval    : Cardinal;
    Ticks       : Cardinal;
  public
    procedure   CheckTicks;
  end;

{ 以下是 TDaemonWorkre 的定义 }
(*----------------------------------------------------------------------------*)
procedure TEtDaemonWorker.AddTask(_name: String; _ev: TThreadMethod);
var
  i       : Integer;
  p_task  : PEtDaemonTask;
  b_found : Boolean;
begin

  with FTasks.LockList do
  try
    b_found := False;

    for i := 0 to Count - 1 do
    begin
      p_task  := Items[i];
      b_found := ( p_task.taskName = _name );
      if b_found then Break;
    end;

    if not b_found then
    begin
      new( p_task );
      p_task.taskName := _name;
      p_task.DoTask   := _ev;

      Add( p_task );
    end;

  finally
    FTasks.UnlockList;
  end;

  if self.Suspended then
    self.Resume;
end;

procedure TEtDaemonWorker.ClearTasks;
var
  p : Pointer;
begin
  with FTasks.LockList do
  try
    while Count > 0 do
    begin
      P := Items[0];
      Dispose( p );
      Delete( 0 );
    end;
  finally
    FTasks.UnlockList;
  end;
end;

constructor TEtDaemonWorker.Create;
begin
  inherited Create( True );
  FreeOnTerminate := False;
  FTasks    := TThreadList.Create;
end;

procedure TEtDaemonWorker.DelTask(_name: String);
var
  tt  : PEtDaemonTask;
  i   : Integer;
begin
  with FTasks.LockList do
  try
    for i := 0 to Count - 1 do
    begin
      tt  := Items[i] ;
      if tt.taskName = _name then
      begin
        Delete( 0 );
        Dispose( tt );
        Break;
      end;
    end;

  finally
    FTasks.UnlockList;
  end;
end;

destructor TEtDaemonWorker.Destroy;
begin
  ClearTasks;
  FTasks.Free;
  inherited;
end;

procedure TEtDaemonWorker.Execute;
begin
  while Assigned(Self) and (not Terminated) do
    Run;
end;

procedure TEtDaemonWorker.Run;
var
  p_task  : PEtDaemonTask;
begin

  p_task  := nil;
  with FTasks.LockList do
  try
    if Count > 0 then
    begin
      p_task  := Items[0];
      Delete(0);
    end;
  finally
    FTasks.UnlockList;
  end;

  if p_task = nil then
    self.Suspend
  else
  begin
    Synchronize( p_task.DoTask );
    
    Dispose( p_task );
  end;

end;
(*============================================================================*)


{ TTimerTask }
procedure T_TimerTask.CheckTicks;
begin
  inc( Ticks );
  if Ticks >= Interval then
  begin
    Ticks := 0;
    Process;
  end;
end;

function TEtTimerTasks.getActive: Boolean;
begin
  Result  := FTimer.Enabled;
end;

procedure TEtTimerTasks.setActive(const Value: Boolean);
begin
  FTimer.Enabled  := Value;
end;

constructor TEtTimerTasks.Create( _name: String );
begin
  Inherited Create;

  FName           := _name;
  FTasks          := TList.Create;

  FTimer          := TTimer.Create(nil);
  FTimer.OnTimer  := DoTimer;
  FTimer.Interval := 1000;  // loop every one second
  FTimer.Enabled  := False;
end;

procedure TEtTimerTasks.AddTask( _name: String; _method: TThreadMethod;
  _seconds: Cardinal);
var
  i   : Integer;
  tt  : T_TimerTask;
begin
  Assert( _seconds > 0 );

  for i := 0 to FTasks.Count - 1 do
  begin
    tt  := FTasks[i] ;
    if tt.Name = _name then
      Exit;
  end;

  tt  := T_TimerTask.Create;

  tt.Name     := _name;
  tt.Process  := _method;
  tt.Interval := _seconds;
  tt.Ticks    := 0;

  FTasks.Add( tt );
end;

procedure TEtTimerTasks.DelTask( _name: String );
var
  tt  : T_TimerTask;
  i   : Integer;
begin
  for i := 0 to FTasks.Count - 1 do
  begin
    tt  := FTasks[i] ;
    if tt.Name = _name then
    begin
      FTasks.Delete( i );
      tt.Free;
      Break;
    end;
  end;
end;

procedure TEtTimerTasks.ClearAll;
var
  o : TObject;
begin
  while FTasks.Count > 0 do
  begin
    o := FTasks[0];
    o.Free;
    FTasks.Delete(0);
  end;
end;

destructor TEtTimerTasks.Destroy;
begin
  FTimer.Enabled  := False;
  ClearAll;
  FTasks.Free;

  FTimer.Free;

  inherited;
end;

procedure TEtTimerTasks.DoTimer(Sender: TObject);
var
  i     : Integer;
  tt    : T_TimerTask;
begin
  for i := 0 to self.FTasks.Count - 1 do
  begin
    tt  := FTasks[i];
    tt.CheckTicks;
    Application.ProcessMessages;
  end;
end;

end.