(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTMultiThread;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,AHMSystemClass;
type
  TAHMTimedThread = class;
  TAHMTimerThread = class(TThread)
    OwnerTimer: TAHMTimedThread;
    Procedure Execute; override;
    Procedure DoTimer;
  end;
  TAHMMultiThreader = class;
  TAHMTimedThreads = class;
  TAHMTimedThread = class(TCollectionItem)
  private
    FEnabled: Boolean;
    FInterval: Word;
    FThreadID : String;
    FTag : LongInt;
    FOnTimer: TNotifyEvent;
    FTimerThread: TAHMTimerThread;
    FThreadPriority: TThreadPriority;
    FAHMMultiThreader : TAHMMultiThreader;
    Procedure SetEnabled(Const Value: Boolean);
    Procedure SetInterval(Const Value: Word);
    Procedure SetThreadPriority(Const Value: TThreadPriority);
  protected
    function GetDisplayName: string; override;
    Procedure UpdateTimer;
    Procedure Timer; dynamic;

  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
    property Owner : TAHMMultiThreader read FAHMMultiThreader;
    property DisplayName : String read GetDisplayName;
    destructor Destroy; override;
  published
    Property Enabled: Boolean read FEnabled write SetEnabled default true;
    Property Tag : LongInt read FTag write FTag default 0;
    Property ThreadID : String read FThreadID write FThreadID;
    Property Interval: Word read FInterval write SetInterval default 1000;
    Property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    Property Priority: TThreadPriority read FThreadPriority write SetThreadPriority default tpTimeCritical;
  end;
  TAHMTimedThreads = class(TCollection)
  private
    FAHMMultiThreader : TAHMMultiThreader;
    function GetAHMTimedThread(Index: Integer): TAHMTimedThread;
    procedure SetAHMTimedThread(Index: Integer; Value: TAHMTimedThread);
  protected
    function GetOwner : TPersistent; override;
  public
    constructor Create(AOwner: TAHMMultiThreader);
    function Add : TAHMTimedThread;
   Function Delete(Index :Integer) :Boolean;
    property Owner : TAHMMultiThreader read FAHMMultiThreader;
    property Items[Index: Integer]: TAHMTimedThread read GetAHMTimedThread write SetAHMTimedThread; default;

  end;
  TAHMMultiThreader = class(TAHMSystemsComponent)
  private
    FAHMTimedThreads : TAHMTimedThreads;
    procedure SetAHMTimedThreads(Value: TAHMTimedThreads);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property About;
    property Threads: TAHMTimedThreads read FAHMTimedThreads write SetAHMTimedThreads;
  end;

implementation

Procedure TAHMTimerThread.Execute;
begin
  Priority := OwnerTimer.FThreadPriority;
  repeat
    SleepEx(OwnerTimer.FInterval, False);
    Synchronize(DoTimer);
  until Terminated;
end;

Procedure TAHMTimerThread.DoTimer;
begin
  OwnerTimer.Timer;
end;

constructor TAHMTimedThread.Create(Collection: TCollection);
begin
  FThreadID:='';
  inherited Create(Collection);
  FAHMMultiThreader :=(((Collection as TAHMTimedThreads).GetOwner) as TAHMMultiThreader);
  FEnabled := True;
  FInterval := 1000;
  FThreadPriority := tpTimeCritical;
  FTimerThread := TAHMTimerThread.Create(false);
  FTimerThread.OwnerTimer := Self;
  FTag := 0;
  UpdateTimer;
end;

destructor TAHMTimedThread.Destroy;
begin
  FEnabled := False;
  UpdateTimer;
  FTimerThread.Free;
  inherited Destroy;
end;

Procedure TAHMTimedThread.UpdateTimer;
begin
  if not(FTimerThread.Suspended) then FTimerThread.Suspend;
  if not(csDesigning in FAHMMultiThreader.Componentstate) then
  if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
  if (FTimerThread.Suspended) then  FTimerThread.Resume;
end;

Procedure TAHMTimedThread.SetEnabled(Const Value: Boolean);
begin
  if Value <> FEnabled then FEnabled := Value;
  UpdateTimer;
end;

Procedure TAHMTimedThread.SetInterval(Const Value: Word);
begin
  if Value <> FInterval then FInterval := Value;
  UpdateTimer;
end;

Procedure TAHMTimedThread.SetThreadPriority(Const Value: TThreadPriority);
begin
  if Value <> FThreadPriority then FThreadPriority := Value;
  UpdateTimer;
end;

Procedure TAHMTimedThread.Timer;
begin
  if Assigned(FOnTimer) then FOnTimer(Self);
end;

function TAHMTimedThread.GetDisplayName: string;
begin
  Result := inherited GetDisplayName+' ['+IntToStr(Interval)+']';
end;

function TAHMTimedThreads.GetOwner: TPersistent;
begin
  Result := FAHMMultiThreader;
end;

constructor TAHMTimedThreads.Create(AOwner: TAHMMultiThreader);
begin
  inherited Create(TAHMTimedThread);
  FAHMMultiThreader := AOwner;
end;

function TAHMTimedThreads.Add: TAHMTimedThread;
begin
  Result := TAHMTimedThread(inherited Add);
end;

function TAHMTimedThreads.GetAHMTimedThread(Index: Integer): TAHMTimedThread;
begin
  Result := TAHMTimedThread(inherited GetItem(Index));
end;

procedure TAHMTimedThreads.SetAHMTimedThread(Index: Integer; Value: TAHMTimedThread);
begin
  inherited SetItem(Index, Value);
end;

constructor TAHMMultiThreader.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  FAHMTimedThreads:=TAHMTimedThreads.Create(self);
end;

destructor TAHMMultiThreader.Destroy;
begin
  FAHMTimedThreads.Free;
  inherited Destroy;
end;

procedure TAHMMultiThreader.SetAHMTimedThreads(Value: TAHMTimedThreads);
begin
  FAHMTimedThreads.Assign(Value);
end;


function TAHMTimedThreads.Delete(Index: Integer): Boolean;
begin
  result := true;
  Try
    Items[Index].free;
  Except
    result := false;
    Application.handleexception(self);
  End;
end;

procedure TAHMTimedThread.Assign(Source: TPersistent);
begin
  if Source is TAHMTimedThread then
  begin
    Tag := TAHMTimedThread(Source).Tag;
    ThreadID := TAHMTimedThread(Source).ThreadID;
    Enabled  := TAHMTimedThread(Source).Enabled;
    Interval := TAHMTimedThread(Source).Interval;
    OnTimer  := TAHMTimedThread(Source).OnTimer;
    Priority := TAHMTimedThread(Source).Priority;
    Exit;
  end;
  inherited Assign(Source);
end;

end.
