Когда-то, лет 5 назад у меня возникла такая-же проблема, только в Win32-сервисе. Тогда, для её решения, я написал 2 простеньких класса.
Вот код, может пригодится?
unit Utils.TimerThread;
interface
uses
System.Classes, System.SysUtils, System.SyncObjs;
type
TCustomTimerThread = class abstract (TThread)
private
FLock: TCriticalSection;
FCancelledEvent: TSimpleEvent;
FInterval: Integer;
FOnTimer: TNotifyEvent;
function GetInterval: Integer;
function GetOnTimer: TNotifyEvent;
procedure SetInterval(const Value: Integer);
procedure SetOnTimer(const Value: TNotifyEvent);
protected
procedure Lock;
procedure Unlock;
procedure Sleep(AInterval: Integer); reintroduce;
procedure TerminatedSet; override;
procedure DoOnTimer; virtual;
public
constructor Create(AInterval: Integer; AOnTimer: TNotifyEvent); reintroduce;
procedure BeforeDestruction; override;
procedure Cancel; virtual;
property Interval: Integer read GetInterval write SetInterval;
/// <summary>
/// <para>
/// За синхронизацией потоков отвечает поток в котором обрабатывается OnTimer
/// </para>
/// <para>
/// !!! НЕ ЗАБЫВАТЬ ПРО ЭТО !!!
/// </para>
/// </summary>
property OnTimer: TNotifyEvent read GetOnTimer write SetOnTimer;
end;
/// <summary>
/// Simple wait thread
/// </summary>
/// <remarks>
/// <para>
/// !!! Important !!!
/// </para>
/// <para>
/// Use Cancel instead of Terminate. You can get ThreadExternalTerminate
/// exception in multi-thread applications
/// </para>
/// </remarks>
TWaitThread = class(TCustomTimerThread)
protected
procedure Execute; override;
public
end;
/// <summary>
/// Thread independed timer
/// </summary>
/// <remarks>
/// <para>
/// !!! Important !!!
/// </para>
/// <para>
/// Use Cancel instead of Terminate. You can get ThreadExternalTerminate
/// exception in multi-thread applications
/// </para>
/// </remarks>
TTimerThread = class(TCustomTimerThread)
private
FEnabled: Boolean;
function GetEnabled: Boolean;
procedure SetEnabled(const Value: Boolean);
protected
procedure Execute; override;
public
constructor Create(AInterval: Integer; AOnTimer: TNotifyEvent; AEnabled: Boolean = True); reintroduce;
property Enabled: Boolean read GetEnabled write SetEnabled;
end;
implementation
{ TCustomTimerThread }
procedure TCustomTimerThread.BeforeDestruction;
begin
FLock.Free;
FreeAndNil(FCancelledEvent);
inherited;
end;
constructor TCustomTimerThread.Create(AInterval: Integer; AOnTimer: TNotifyEvent);
begin
inherited Create;
FInterval := AInterval;
FOnTimer := AOnTimer;
FreeOnTerminate := True;
FLock := TCriticalSection.Create;
FCancelledEvent := TSimpleEvent.Create;
FCancelledEvent.ResetEvent;
end;
procedure TCustomTimerThread.Cancel;
begin
FCancelledEvent.SetEvent;
end;
procedure TCustomTimerThread.DoOnTimer;
begin
if Assigned(OnTimer) then
OnTimer(Self);
end;
function TCustomTimerThread.GetInterval: Integer;
begin
Lock;
try
Result := FInterval;
finally
Unlock;
end;
end;
function TCustomTimerThread.GetOnTimer: TNotifyEvent;
begin
Lock;
try
Result := FOnTimer;
finally
Unlock;
end;
end;
procedure TCustomTimerThread.Lock;
begin
FLock.Enter;
end;
procedure TCustomTimerThread.SetInterval(const Value: Integer);
begin
Lock;
try
FInterval := Value;
finally
Unlock;
end;
end;
procedure TCustomTimerThread.SetOnTimer(const Value: TNotifyEvent);
begin
Lock;
try
FOnTimer := Value;
finally
Unlock;
end;
end;
procedure TCustomTimerThread.Sleep(AInterval: Integer);
begin
FCancelledEvent.WaitFor(AInterval);
end;
procedure TCustomTimerThread.TerminatedSet;
begin
inherited;
FCancelledEvent.SetEvent;
end;
procedure TCustomTimerThread.Unlock;
begin
FLock.Leave;
end;
{ TWaitThread }
procedure TWaitThread.Execute;
begin
if FCancelledEvent.WaitFor(FInterval) = wrTimeout then
DoOnTimer;
end;
{ TTimerThread }
constructor TTimerThread.Create(AInterval: Integer; AOnTimer: TNotifyEvent; AEnabled: Boolean);
begin
inherited Create(AInterval, AOnTimer);
FOnTimer := AOnTimer;
FEnabled := AEnabled;
end;
procedure TTimerThread.Execute;
begin
while not Terminated do
case FCancelledEvent.WaitFor(FInterval) of
wrTimeout:
begin
if Enabled then
DoOnTimer;
end;
else
Break;
end;
end;
function TTimerThread.GetEnabled: Boolean;
begin
Lock;
try
Result := FEnabled;
finally
Unlock;
end;
end;
procedure TTimerThread.SetEnabled(const Value: Boolean);
begin
Lock;
try
FEnabled := Value;
finally
Unlock;
end;
end;
end.