@Tharon
Try this (it's not a visual component, but it should work on windows, linux and osx):
unit uThreadTimer;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, lclintf;
type
TOnTimer = procedure(Sender: TObject) of object;
{ TThreadTimer }
TThreadTimer = class(TThread)
private
FTime: QWORD;
FInterval: Cardinal;
FOnTimer: TOnTimer;
FEnabled: Boolean;
procedure DoOnTimer;
protected
procedure Execute; override;
public
property OnTimer: TOnTimer read FOnTimer write FOnTimer;
property Interval: Cardinal read FInterval write FInterval;
property Enabled: Boolean read FEnabled write FEnabled;
procedure StopTimer;
procedure StartTimer;
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
end;
implementation
constructor TThreadTimer.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
FInterval := 1000;
FreeOnTerminate := True;
FEnabled := False;
end;
destructor TThreadTimer.Destroy;
begin
//
inherited Destroy;
end;
procedure TThreadTimer.DoOnTimer;
begin
if Assigned(FOnTimer) then
FOnTimer(Self);
end;
procedure TThreadTimer.Execute;
begin
while not Terminated do
begin
Sleep(1);
if (GetTickCount64 - FTime > FInterval) and (FEnabled) then
begin
FTime := GetTickCount64;
Synchronize(@DoOnTimer);
end;
end;
end;
procedure TThreadTimer.StopTimer;
begin
FEnabled := False;
end;
procedure TThreadTimer.StartTimer;
begin
FTime := GetTickCount64;
FEnabled := True;
if Self.Suspended then
Start;
end;
end.
Don't forget to add the following lines to project source:
program project1;
{$mode objfpc}{$H+}
{$DEFINE UseCThreads} //add this line
uses
{$IFDEF UNIX}{$IFDEF UseCThreads} //add this line
cthreads, //add this line
{$ENDIF}{$ENDIF} //add this line
//...
Main form:
uses uThreadTimer, lclintf;
var
ThreadTimer: TThreadTimer;
procedure TForm1.FormCreate(Sender: TObject);
begin
ThreadTimer := TThreadTimer.Create(True);
ThreadTimer.Interval := 1000;
ThreadTimer.OnTimer := @OnTimer;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
if ThreadTimer.Enabled then
ThreadTimer.StopTimer;
ThreadTimer.Terminate;
end;
procedure TForm1.bStartStopClick(Sender: TObject);
begin
if ThreadTimer.Enabled then
ThreadTimer.StopTimer
else
ThreadTimer.StartTimer;
end;
procedure TForm1.OnTimer(Sender: TObject);
begin
Label1.Caption := IntToStr(GetTickCount64())
end;
Please run a few test and tell me if it's working as it should.