unit Scheduler;
interface
uses Windows, SysUtils, Generics.Collections;
type
TSchedule =
procedure of object;
TScheduler =
class;
TDescriptor =
record
Proc: TSchedule;
Timer: THandle;
Sched: TScheduler;
end;
PDescriptor = ^TDescriptor;
TScheduler =
class
private
FQueue: THandle;
FRems: TList<THandle>;
procedure RemoveInactiveTimers;
public
constructor Create;
destructor Destroy;
override;
procedure AddSchedule(Milliseconds: Cardinal; Proc: TSchedule);
procedure SetTimerRemovable(Timer: THandle);
end;
implementation
{ TScheduler }
constructor TScheduler.Create;
begin
FQueue := CreateTimerQueue;
FRems := TList<THandle>.Create;
end;
destructor TScheduler.Destroy;
begin
RemoveInactiveTimers;
DeleteTimerQueue(FQueue);
FRems.Free;
inherited;
end;
procedure OnTimer(Context: Pointer; Success: Boolean);
stdcall;
begin
try
PDescriptor(Context)^.Proc;
PDescriptor(Context)^.Sched.SetTimerRemovable(PDescriptor(Context)^.Timer);
finally
Dispose(Context);
end;
end;
procedure TScheduler.SetTimerRemovable(Timer: THandle);
begin
FRems.Add(Timer);
end;
procedure TScheduler.AddSchedule(Milliseconds: Cardinal; Proc: TSchedule);
var
Timer: THandle;
PDesc: PDescriptor;
begin
RemoveInactiveTimers;
New(PDesc);
PDesc^.Proc := Proc;
PDesc^.Sched := Self;
if not CreateTimerQueueTimer(Timer, FQueue, OnTimer, PDesc, Milliseconds, 0, WT_EXECUTEONLYONCE)
then
raise Exception.Create('
Creating a timer failed!');
PDesc^.Timer := Timer;
end;
procedure TScheduler.RemoveInactiveTimers;
var
i: Integer;
begin
for i := 0
to FRems.Count - 1
do
if not DeleteTimerQueueTimer(FQueue, FRems[i], 0)
then
raise Exception.Create('
Deleting a timer failed!');
FRems.Clear;
end;
end.