//////////////////////////////////////////////////// // // // ThreadedTimer 1.24 // // // // Copyright (C) 1996, 2000 Carlos Barbosa // // email: delphi@carlosb.com // // Home Page: http://www.carlosb.com // // // // Portions (C) 2000, Andrew N. Driazgov // // email: andrey@asp.tstu.ru // // // // Last updated: November 24, 2000 // // // //////////////////////////////////////////////////// unit ThdTimer; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; const DEFAULT_INTERVAL = 1000; type TThreadedTimer = class; TTimerThread = class(TThread) private FOwner: TThreadedTimer; FInterval: Cardinal; FStop: THandle; protected procedure Execute; override; end; TThreadedTimer = class(TComponent) private FOnTimer: TNotifyEvent; FTimerThread: TTimerThread; FEnabled, FAllowZero: Boolean; procedure DoTimer; procedure SetEnabled(Value: Boolean); function GetInterval: Cardinal; procedure SetInterval(Value: Cardinal); function GetThreadPriority: TThreadPriority; procedure SetThreadPriority(Value: TThreadPriority); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property AllowZero: Boolean read FAllowZero write FAllowZero default False; property Enabled: Boolean read FEnabled write SetEnabled default False; property Interval: Cardinal read GetInterval write SetInterval default DEFAULT_INTERVAL; property OnTimer: TNotifyEvent read FOnTimer write FOnTimer; property ThreadPriority: TThreadPriority read GetThreadPriority write SetThreadPriority default tpNormal; end; procedure Register; implementation { TTimerThread } procedure TTimerThread.Execute; begin repeat if WaitForSingleObject(FStop, FInterval) = WAIT_TIMEOUT then Synchronize(FOwner.DoTimer); until Terminated; end; { TThreadedTimer } constructor TThreadedTimer.Create(AOwner: TComponent); begin inherited Create(AOwner); FTimerThread := TTimerThread.Create(True); with FTimerThread do begin FOwner := Self; FInterval := DEFAULT_INTERVAL; Priority := tpNormal; // Event is completely manipulated by TThreadedTimer object FStop := CreateEvent(nil, False, False, nil); end; end; destructor TThreadedTimer.Destroy; begin with FTimerThread do begin FEnabled := False; Terminate; // When this method is called we must be confident that the event handle was not closed SetEvent(FStop); if Suspended then Resume; WaitFor; CloseHandle(FStop); // Close event handle in the primary thread Free; end; inherited Destroy; end; procedure TThreadedTimer.DoTimer; begin // We have to check FEnabled in the primary thread // Otherwise we get AV when the program is closed if FEnabled and Assigned(FOnTimer) and not (csDestroying in ComponentState) then try FOnTimer(Self); except end; end; procedure TThreadedTimer.SetEnabled(Value: Boolean); begin if Value <> FEnabled then begin FEnabled := Value; if FEnabled then begin if (FTimerThread.FInterval > 0) or ((FTimerThread.FInterval = 0) and FAllowZero) then begin SetEvent(FTimerThread.FStop); FTimerThread.Resume; end; end else FTimerThread.Suspend; end; end; function TThreadedTimer.GetInterval: Cardinal; begin Result := FTimerThread.FInterval; end; procedure TThreadedTimer.SetInterval(Value: Cardinal); var PrevEnabled: Boolean; begin if Value <> FTimerThread.FInterval then begin PrevEnabled := FEnabled; Enabled := False; FTimerThread.FInterval := Value; Enabled := PrevEnabled; end; end; function TThreadedTimer.GetThreadPriority: TThreadPriority; begin Result := FTimerThread.Priority; end; procedure TThreadedTimer.SetThreadPriority(Value: TThreadPriority); begin FTimerThread.Priority := Value; end; procedure Register; begin RegisterComponents('System', [TThreadedTimer]); end; end.