{
  Autor      : Michael Springwald
  Erstellt am: Donnerstag, 25. April 2013
}

unit uplthreadtimertest;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Unix;

type
  TPLOnTimerEvent = procedure  of object;

  { TPLThreadTimer }
  TPLThreadTimer = class(TThread)
  private
    fEnabled: Boolean;
    fInterval: DWord;
    fOnTimerEvent: TPLOnTimerEvent;
    Interval_Counter:DWord;
    procedure SetEnabled(AValue: Boolean);
    procedure SetInterval(AValue: DWord);
  protected
    procedure Execute; override;
    procedure DoTimerEvent;
  public
    constructor Create(CreateSuspended: Boolean; const StackSize: SizeUInt=DefaultStackSize);
    destructor Destroy; override;
  published
    property Interval:DWord read fInterval write SetInterval;
    property Enabled:Boolean read fEnabled write SetEnabled;
    property OnTimerEvent:TPLOnTimerEvent read fOnTimerEvent write fOnTimerEvent;
  end; // TPLThreadTimer

function MyGetTickCount:DWord;

implementation

function MyGetTickCount:DWord;
var
  tp: TTimeVal;
begin
  fpgettimeofday(@tp, nil);
  Result := (Int64(tp.tv_sec) * 1000) + (tp.tv_usec div 1000);
end; // MyGetTickCount

procedure TPLThreadTimer.SetInterval(AValue: DWord);
begin
  if fInterval=AValue then Exit;
  fInterval:=AValue;
end; // TPLThreadTimer.SetInterval

procedure TPLThreadTimer.SetEnabled(AValue: Boolean);
begin
  if fEnabled=AValue then Exit;
  fEnabled:=AValue;
  Interval_Counter:=0;
  if fEnabled then begin
    Start;
//    DoTimerEvent;
  end;
end; // TPLThreadTimer.SetEnabled

procedure TPLThreadTimer.Execute;
var
  newStatus : string;
  n:DWord;
begin
  // Die Schleife bleibt immer Aktiv, bis der Thread Beendet wird
  while (not Terminated) and (not Suspended) do begin
    if Enabled then begin
      n:=MyGetTickCount;
      if (Interval_Counter = 0) then
        Interval_Counter:=MyGetTickCount;

      if (N-Interval_Counter >=Interval) then begin
        Interval_Counter:=MyGetTickCount;
//        Synchronize(@DoTimerEvent);
        @DoTimerEvent;
      end;
    end;
    // Damit die CPU Last nicht auf 100% geht.
    sleep(1);
  end; // while
end; // TPLThreadTimer.Execute

procedure TPLThreadTimer.DoTimerEvent;
begin
  if Assigned(fOnTimerEvent) then fOnTimerEvent;
end; // TPLThreadTimer.DoTimerEvent

{ TPLThreadTimer }
constructor TPLThreadTimer.Create(CreateSuspended: Boolean; const StackSize: SizeUInt=DefaultStackSize);
begin
  FreeOnTerminate := false;
  inherited Create(CreateSuspended);
  fInterval:=0;
  Interval_Counter:=0;
  fOnTimerEvent:=nil;
end; // TPLThreadTimer.Create

destructor TPLThreadTimer.Destroy;
begin
  inherited Destroy;
end; // TPLThreadTimer.Destroy

end.