{*******************************************************}
{ KOL ThreadedTimer v1.00.1 - based of GT Threaded Timer}
{                     (GT Delphi Components)            }
{                     (http://www.gtdelphicomponents.gr)}
{                                                       }
{ Ported to KOL Threaded Timer (mays, 2009) by          }
{ Valery Dudashenko aka Abyss® [VMD]                    }
{ E-Mail: vmd.abyss@gmail.com                           }
{                                                       }
{ Last corrected - june, 5, 2009                        }
{                                                       }
{*******************************************************}

unit KOLThdTimer;

interface
{$UNDEF ASM_VERSION} //Pascal

uses Windows, Kol;

const
  DEFAULT_INTERVAL = 1000;

type

 PKolThreadedTimer = ^TKolThreadedTimer;
{------------------------------------------------------------------------------}
 PTimerThread = ^TTimerThread;
 TTimerThread = object(TThread)
 private
   FTimer : PKolThreadedTimer;
 protected
   procedure DoTimer;
 public
   constructor ThreadCreate;
   destructor Destroy; virtual;
   function Execute: integer; virtual;
 end;
{------------------------------------------------------------------------------}
  TKolThreadedTimer =  Object(TTimer)
  private
    FThreadPriority: Integer;
    procedure SetEnabled(const Value: Boolean); virtual;
    procedure SetInterval(const Value: Integer);
    procedure SetKeepAlive(const Value: Boolean);
  protected
    F_OnTimer: TOnEvent;
    FTimerThread : PTimerThread;
    FKeepAlive: Boolean;
    procedure UpdateTimer;
  public
    destructor Destroy; virtual;
    // KeepAlive : conduct of thread - terminate or suspend, if Enabled = True
    property KeepAlive : Boolean  read FKeepAlive  write SetKeepAlive;
    property Enabled : Boolean  read FEnabled  write SetEnabled;
    property Interval: Integer read FInterval write SetInterval;
    property OnTimer : TOnEvent read F_OnTimer write F_OnTimer;
    //Simplified analogue of property "Threadpriority"
    property ThreadPriority: Integer read FThreadPriority write FThreadPriority;
  end;

{------------------------------------------------------------------------------}
function NewKolThreadedTimer: PKolThreadedTimer;

implementation

{ TTimerThread }
{Ported of KOL two functions}
{------------------------------------------------------------------------------}
function ThreadFunc(Thread: PThread): integer; stdcall;
begin
  Result := Thread.Execute;
end;
{------------------------------------------------------------------------------}
constructor TTimerThread.ThreadCreate;
begin
  IsMultiThread := True;
  Create;
  FHandle := CreateThread( nil, 0, @ThreadFunc, @Self, CREATE_SUSPENDED, FThreadID );
end;
{------------------------------------------------------------------------------}
destructor TTimerThread.Destroy;
begin
 inherited;
end;
{------------------------------------------------------------------------------}
function NewTimerThread(ATimer: PKolThreadedTimer): PTimerThread;  //Not declared function
begin
  New(Result, ThreadCreate);
  Result.FTimer:= ATimer;
  Result.ThreadPriority:= ATimer.FThreadPriority;
end;
{------------------------------------------------------------------------------}

procedure TTimerThread.DoTimer;
begin
 if Assigned(FTimer.OnTimer) then
    FTimer.OnTimer(FTimer);
end;
{------------------------------------------------------------------------------}
function TTimerThread.Execute;
begin
  while (not Self.Terminated) and (FTimer.Enabled) do
  begin
    WaitForSingleObject(Self.Handle,FTimer.Interval);
    Synchronize(DoTimer);
  end;
end;

{ TKolThreadedTimer}
{------------------------------------------------------------------------------}
function NewKolThreadedTimer: PKolThreadedTimer;
begin
  New(Result, Create);
  Result.FInterval := DEFAULT_INTERVAL;
  Result.FKeepAlive:= True;
  Result.FEnabled  := False;
  Result.ThreadPriority:= THREAD_PRIORITY_NORMAL;
end;
{------------------------------------------------------------------------------}
destructor TKolThreadedTimer.Destroy;
begin
 FEnabled := False;
  FTimerThread.Free;
   inherited;
end;
{------------------------------------------------------------------------------}
procedure TKolThreadedTimer.UpdateTimer;
begin
  inherited;
   if Assigned(FTimerThread) then
    if not Enabled then
     if KeepAlive then
       FTimerThread.Suspend else
      begin
       FTimerThread.Terminate;
         FTimerThread.Free;
          FTimerThread:= nil;
      end;
  if Enabled then
  begin
    if FInterval > 0 then
     begin
      if not Assigned(FTimerThread) then
       FTimerThread := NewTimerThread(@Self);
        FTimerThread.Resume;
   end
     else Enabled := False;
  end;
end;
{------------------------------------------------------------------------------}
procedure TKolThreadedTimer.SetEnabled(const Value: Boolean);
begin
  inherited;
  FEnabled := Value;
  UpdateTimer;
end;
{------------------------------------------------------------------------------}
procedure TKolThreadedTimer.SetInterval(const Value: Integer);
begin
  inherited;
  if Value <> FInterval then
  begin
    FInterval := Value;
    UpdateTimer;
  end;
end;
{------------------------------------------------------------------------------}
procedure TKolThreadedTimer.SetKeepAlive(const Value: Boolean);
begin
  if Value <> FKeepAlive then
  begin
    FKeepAlive := Value;
    UpdateTimer;
  end;
end;
{------------------------------------------------------------------------------}


end.
