unit SystemTimer;
interface
uses
Windows, SysUtils, MMSystem, Classes, SyncObjs;
type
TSystemTimer =
class(TObject)
private
TimerID: Longword;
FOnTimer: TNotifyEvent;
FInterval: integer;
procedure SetInterval(Value: integer);
function GetInterval: integer;
public
procedure StartTimer;
procedure StopTimer;
constructor Create;
destructor Destroy;
override;
published
property Interval: integer
read GetInterval
write SetInterval;
property OnTimer: TNotifyEvent
read FOnTimer
write FOnTimer;
end;
implementation
var
Timers: TList;
IDs: TStringList;
CS: TCriticalSection;
procedure TSystemTimer.SetInterval(Value: integer);
begin
FInterval := Value;
end;
function TSystemTimer.GetInterval: integer;
begin
Result := FInterval;
end;
procedure TimerCallback(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD)
stdcall;
begin
CS.Enter;
if assigned(TSystemTimer(Timers[IDs.IndexOf(IntToStr(uTimerID))]).OnTimer)
then
TSystemTimer(Timers[IDs.IndexOf(IntToStr(uTimerID))]).OnTimer(TSystemTimer(Timers[IDs.IndexOf(IntToStr(uTimerID))]));
CS.Leave;
end;
constructor TSystemTimer.Create;
begin
inherited Create;
end;
destructor TSystemTimer.Destroy;
begin
inherited Destroy;
end;
procedure TSystemTimer.StartTimer;
begin
Timers.Add(Pointer(Self));
TimerID := timeSetEvent(FInterval, 0, TimerCallback, 0, TIME_PERIODIC);
IDs.Add(IntToStr(TimerID));
end;
procedure TSystemTimer.StopTimer;
begin
timeKillEvent(TimerID);
Timers.Delete(IDs.IndexOf(IntToStr(TimerID)));
IDs.Delete(IDs.IndexOf(IntToStr(TimerID)));
end;
initialization
IDs := TStringList.Create;
Timers := TList.Create;
CS := TCriticalSection.Create;
finalization
Timers.Free;
IDs.Free;
CS.Free;
end.