Code: Alles auswählen
unit utimer;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, LMessages, LCLIntf;
const
LM_THREADTIMER = LM_USER + 0;
type
{ TThreadTimer }
TOnTimerTick=procedure(aElapsed:Longword) of Object;
TThreadTimer = class(TThread)
private
FOnTimerTick : TOnTimerTick;
FElapsed : Longword;
FInterval : Longword;
FPaused : boolean;
procedure SetElapsed(const AValue: Longword);
procedure SyncMethod;
public
constructor Create;
destructor Destroy; override;
procedure Execute; override;
procedure Stop;
property OnTimerTick:TOnTimerTick read FOnTimerTick write FOnTimerTick;
property Pause:boolean write FPaused;
property Interval:Longword read FInterval write FInterval;
property Elapsed:Longword write SetElapsed;
end;
implementation
{ TThreadTimer }
procedure TThreadTimer.SyncMethod;
begin
if assigned(FOnTimerTick) then FOnTimerTick(FElapsed div 1000);
if ((FElapsed div 1000)>=FInterval) then
begin
PostMessage(Application.Mainform.Handle, LM_THREADTIMER, 0, 0);
FPaused:=true;
end;
end;
procedure TThreadTimer.SetElapsed(const AValue: Longword);
begin
FElapsed:=aValue*1000;
end;
procedure TThreadTimer.Stop;
begin
OnTimerTick:=nil;
Terminate;
WaitForThreadTerminate(self.Handle,1000);
// FTimer.WaitFor; <- so muss gekillt werden
end;
constructor TThreadTimer.Create;
begin
inherited Create(false);
FreeOnTerminate:=true;
Priority:=tpHigher;
FPaused:=true;
end;
destructor TThreadTimer.Destroy;
begin
inherited Destroy;
end;
procedure TThreadTimer.Execute;
var LastTickCount : Longword;
begin
LastTickCount:=GetTickCount;
while not Terminated do
begin
Sleep(100);
if not Terminated and ((GetTickCount-LastTickCount)>1000) then
begin
if not FPaused then
begin
inc(FElapsed,(GetTickCount-LastTickCount));
Synchronize(@SyncMethod);
end;
LastTickCount:=GetTickCount;
end;
end;
end;
end.
Verein
Links
Suche