unit uTimerEx;
interface
uses
Math, Classes, ExtCtrls;
type
TOnTimerExTimer =
procedure(Timer: integer)
of object;
TTimerEx =
class
private
FIntervall, FEnabled, FTickCount, FTimerTickCount: TList;
FTimer: TTimer;
FActive, FStoreActive: boolean;
FOnTimerExTimer: TOnTimerExTimer;
function GetCount: integer;
function GetEnabled(
Index: integer): boolean;
function GetIntervall(
Index: integer): integer;
procedure SetActive(
const Value: boolean);
procedure SetEnabled(
Index: integer;
const Value: boolean);
procedure SetIntervall(
Index: integer;
const Value: integer);
function GetTickCount(
Index: integer): integer;
function GetTimerTickCount(
Index: integer): integer;
procedure SetTickCount(
Index: integer;
const Value: integer);
procedure SetTimerTickCount(
Index: integer;
const Value: integer);
property TickCount[
Index: integer]: integer
read GetTickCount
write SetTickCount;
property TimerTickCount[
Index: integer]: integer
read GetTimerTickCount
write SetTimerTickCount;
function GreatestCommonDivisor(A, B: integer): integer;
function TimerIntervall: integer;
procedure BeginUpdate;
procedure EndUpdate;
procedure TimerExTimer(Sender: TObject);
public
procedure Add(Intervall: integer = 1000; Enabled: boolean = true);
procedure Delete(
Index: integer);
property Intervall[
Index: integer]: integer
read GetIntervall
write SetIntervall;
property Enabled[
Index: integer]: boolean
read GetEnabled
write SetEnabled;
property Active: boolean
read FActive
write SetActive;
property Count: integer
read GetCount;
property OnTimerExTimer: TOnTimerExTimer
read FOnTimerExTimer
write FOnTimerExTimer;
constructor Create;
destructor Destroy;
override;
end;
implementation
{ TTimerEx }
constructor TTimerEx.Create;
begin
FTimer := TTimer.Create(
Nil);
FTimer.Enabled := false;
FTimer.OnTimer := TimerExTimer;
FIntervall := TList.Create;
FEnabled := TList.Create;
FTickCount := TList.Create;
FTimerTickCount := TList.Create;
end;
destructor TTimerEx.Destroy;
begin
FActive := false;
FTimer.Free;
FIntervall.Free;
FEnabled.Free;
FTickCount.Free;
FTimerTickCount.Free;
inherited;
end;
procedure TTimerEx.Add(Intervall: integer = 1000; Enabled: boolean = true);
begin
BeginUpdate;
FIntervall.Add(Pointer(Intervall));
if Enabled
then
FEnabled.Add(Pointer(1))
else
FEnabled.Add(Pointer(0));
FTickCount.Add(Pointer(0));
FTimerTickCount.Add(Pointer(0));
EndUpdate;
end;
procedure TTimerEx.Delete(
Index: integer);
begin
BeginUpdate;
FIntervall.Delete(
Index);
FEnabled.Delete(
Index);
FTickCount.Delete(
Index);
FTimerTickCount.Delete(
Index);
EndUpdate;
end;
function TTimerEx.GetCount: integer;
begin
Result := FIntervall.Count;
end;
function TTimerEx.GetEnabled(
Index: integer): boolean;
begin
if Integer(FEnabled[
Index]) = 1
then
Result := true
else
Result := false;
end;
function TTimerEx.GetIntervall(
Index: integer): integer;
begin
Result := Integer(FIntervall[
Index]);
end;
function TTimerEx.GetTickCount(
Index: integer): integer;
begin
Result := Integer(FTickCount[
Index]);
end;
function TTimerEx.GetTimerTickCount(
Index: integer): integer;
begin
Result := Integer(FTimerTickCount[
Index]);
end;
procedure TTimerEx.SetActive(
const Value: boolean);
begin
if Value
then
begin
BeginUpdate;
EndUpdate;
end;
FActive := Value;
FTimer.Enabled := Value;
end;
procedure TTimerEx.SetEnabled(
Index: integer;
const Value: boolean);
begin
if Value
then
FEnabled[
Index] := Pointer(1)
else
FEnabled[
Index] := Pointer(0);
end;
procedure TTimerEx.SetIntervall(
Index: integer;
const Value: integer);
begin
BeginUpdate;
FIntervall[
Index] := Pointer(Value);
EndUpdate;
end;
procedure TTimerEx.SetTickCount(
Index: integer;
const Value: integer);
begin
FTickCount[
Index] := Pointer(Value);
end;
procedure TTimerEx.SetTimerTickCount(
Index: integer;
const Value: integer);
begin
FTimerTickCount[
Index] := Pointer(Value);
end;
function TTimerEx.GreatestCommonDivisor(A, B: integer): integer;
var
C: integer;
begin
while B <> 0
do
begin
C := A
mod B;
A := B;
B := C;
end;
Result := A;
end;
function TTimerEx.TimerIntervall: integer;
var
I, J: integer;
begin
Result := 1000;
if Count = 1
then
Result := Intervall[0]
else
if Count > 1
then
begin
Result := MaxInt;
for I := 0
to Count - 2
do
for J := I + 1
to Count - 1
do
Result := Min(Result, GreatestCommonDivisor(Intervall[I], Intervall[J]));
end;
for I := 0
to Count - 1
do
TickCount[I] := Intervall[I]
div Result;
end;
procedure TTimerEx.BeginUpdate;
begin
FStoreActive := FActive;
FActive := false;
FTimer.Enabled := false;
end;
procedure TTimerEx.EndUpdate;
var
I: integer;
begin
FTimer.Interval := TimerIntervall;
for I := 0
to Count - 1
do
TimerTickCount[I] := 0;
FActive := FStoreActive;
FTimer.Enabled := FStoreActive;
end;
procedure TTimerEx.TimerExTimer(Sender: TObject);
var
I: integer;
begin
FTimer.Enabled := false;
try
I := 0;
while FActive
and (I < Count)
do
begin
TimerTickCount[I] := TimerTickCount[I] + 1;
if TickCount[I] = TimerTickCount[I]
then
begin
TimerTickCount[I] := 0;
if Enabled[I]
and Assigned(FOnTimerExTimer)
then
FOnTimerExTimer(I);
end;
Inc(I);
end;
finally
if FActive
then
FTimer.Enabled := true;
end;
end;
end.