unit ForExtension;

interface

uses
  SysUtils,
end_uses;

type
  TForLoop = (flTo, flDownTo);

  Tvar_ = class(TInterfacedObject)
    FIndex: Integer;
    FIncrement: Integer;
    FLoopCount: Integer;
    FCompareValue: Integer;
    FCompareForLoop: TForLoop;
  end;

  Ivar_I = interface
    procedure Set_I(const Value: Integer);
    function Get_I: Integer;
    property I: Integer read Get_I write Set_I;
  end;

  Tvar_I = class(Tvar_, Ivar_I)
  private
    procedure Set_I(const Value: Integer);
    function Get_I: Integer;
  public
    destructor Destroy; override;
    property I: Integer read Get_I write Set_I;
  end;

  Ivar_J = interface
    procedure Set_J(const Value: Integer);
    function Get_J: Integer;
    property J: Integer read Get_J write Set_J;
  end;

  Tvar_J = class(Tvar_, Ivar_J)
  private
    procedure Set_J(const Value: Integer);
    function Get_J: Integer;
  public
    destructor Destroy; override;
    property J: Integer read Get_J write Set_J;
  end;

  Ivar_K = interface
    procedure Set_K(const Value: Integer);
    function Get_K: Integer;
    property K: Integer read Get_K write Set_K;
  end;

  Tvar_K = class(Tvar_, Ivar_K)
  private
    procedure Set_K(const Value: Integer);
    function Get_K: Integer;
  public
    destructor Destroy; override;
    property K: Integer read Get_K write Set_K;
  end;

  for_ = class
    class procedure Set_I(const Value: Integer); static;
    class procedure Set_J(const Value: Integer); static;
    class procedure Set_K(const Value: Integer); static;
  public
    class property I: Integer write Set_I;
    class property J: Integer write Set_J;
    class property K: Integer write Set_K;
  end;

  to_ = class
    class function I(Value: Integer; IncValue: Integer = 1): Boolean;
    class function J(Value: Integer; IncValue: Integer = 1): Boolean;
    class function K(Value: Integer; IncValue: Integer = 1): Boolean;
  end;

  down_to_ = class
    class function I(Value: Integer; IncValue: Integer = -1): Boolean;
    class function J(Value: Integer; IncValue: Integer = -1): Boolean;
    class function K(Value: Integer; IncValue: Integer = -1): Boolean;
  end;

  loop = class
    type I = class
      class function count: Integer;
      class function value: Integer;
      class function first: Boolean;
      class function last:  Boolean;
    end;
    type J = class
      class function count: Integer;
      class function value: Integer;
      class function first: Boolean;
      class function last:  Boolean;
    end;
    type K = class
      class function count: Integer;
      class function value: Integer;
      class function first: Boolean;
      class function last:  Boolean;
    end;
  end;

function varI: Ivar_I;
function varJ: Ivar_J;
function varK: Ivar_K;

implementation

uses
  Contnrs,
uses_end;

var
  uIncrement_I, uIncrement_J, uIncrement_K: Integer;
  List_I, List_J, List_K: TObjectList;

function varI: Ivar_I;
var
  Value: Tvar_I;
begin
  Value := Tvar_I.Create;
  Value.FIndex := 0;
  Value.FIncrement := uIncrement_I;
  Value.FLoopCount := 0;
  Value.FCompareValue := 0;
  Value.FCompareForLoop := flTo;
  List_I.Add(Value);
  Result := Value;
end;

function varJ: Ivar_J;
var
  Value: Tvar_J;
begin
  Value := Tvar_J.Create;
  Value.FIndex := 0;
  Value.FIncrement := uIncrement_J;
  Value.FLoopCount := 0;
  Value.FCompareValue := 0;
  Value.FCompareForLoop := flTo;
  List_J.Add(Value);
  Result := Value;
end;


function varK: Ivar_K;
var
  Value: Tvar_K;
begin
  Value := Tvar_K.Create;
  Value.FIndex := 0;
  Value.FIncrement := uIncrement_K;
  Value.FLoopCount := 0;
  Value.FCompareValue := 0;
  Value.FCompareForLoop := flTo;
  List_K.Add(Value);
  Result := Value;
end;

destructor Tvar_I.Destroy;
var
  SearchIndex: Integer;
begin
  inherited;

  SearchIndex :=  List_I.IndexOf(Self);
  if SearchIndex <> -1 then
  begin
    List_I.Delete(SearchIndex);
  end else
  begin
    raise Exception.Create('Error:Tvar_I.Destroy');
  end;
end;

destructor Tvar_J.Destroy;
var
  SearchIndex: Integer;
begin
  inherited;

  SearchIndex :=  List_J.IndexOf(Self);
  if SearchIndex <> -1 then
  begin
    List_J.Delete(SearchIndex);
  end else
  begin
    raise Exception.Create('Error:Tvar_J.Destroy');
  end;
end;

destructor Tvar_K.Destroy;
var
  SearchIndex: Integer;
begin
  inherited;

  SearchIndex :=  List_K.IndexOf(Self);
  if SearchIndex <> -1 then
  begin
    List_K.Delete(SearchIndex);
  end else
  begin
    raise Exception.Create('Error:Tvar_K.Destroy');
  end;
end;

procedure Tvar_I.Set_I(const Value: Integer);
begin
  FIndex := Value;
end;

function Tvar_I.Get_I: Integer;
begin
  Result :=  FIndex;
end;

procedure Tvar_J.Set_J(const Value: Integer);
begin
  FIndex := Value;
end;

function Tvar_J.Get_J: Integer;
begin
  Result :=  FIndex;
end;

procedure Tvar_K.Set_K(const Value: Integer);
begin
  FIndex := Value;
end;

function Tvar_K.Get_K: Integer;
begin
  Result :=  FIndex;
end;

class procedure for_.Set_I(const Value: Integer);
begin
  uIncrement_I := Value;
end;

class procedure for_.Set_J(const Value: Integer);
begin
  uIncrement_J := Value;
end;

class procedure for_.Set_K(const Value: Integer);
begin
  uIncrement_K := Value;
end;

class function to_.I(Value: Integer; IncValue: Integer = 1): Boolean;
begin
  with Tvar_I( List_I.Last ) do
  begin
    FCompareForLoop := flTo;
    FCompareValue := Value;

    Inc(FIndex, FIncrement);

    FIncrement := IncValue;

    Result := FIndex <= Value;

    if Result then Inc( FLoopCount );
  end;
end;

class function to_.J(Value: Integer; IncValue: Integer = 1): Boolean;
begin
  with Tvar_J( List_J.Last ) do
  begin
    FCompareForLoop := flTo;
    FCompareValue := Value;

    Inc(FIndex, FIncrement);

    FIncrement := IncValue;

    Result := FIndex <= Value;

    if Result then Inc( FLoopCount );
  end;
end;

class function to_.K(Value: Integer; IncValue: Integer = 1): Boolean;
begin
  with Tvar_K( List_K.Last ) do
  begin
    FCompareForLoop := flTo;
    FCompareValue := Value;

    Inc(FIndex, FIncrement);

    FIncrement := IncValue;

    Result := FIndex <= Value;

    if Result then Inc( FLoopCount );
  end;
end;

class function down_to_.I(Value: Integer; IncValue: Integer = -1): Boolean;
begin
  with Tvar_I( List_I.Last ) do
  begin
    FCompareForLoop := flDownTo;
    FCompareValue := Value;

    Inc(FIndex, FIncrement);

    FIncrement := IncValue;

    Result := Value <= FIndex;

    if Result then Inc( FLoopCount );
  end;
end;

class function down_to_.J(Value: Integer; IncValue: Integer = -1): Boolean;
begin
  with Tvar_J( List_J.Last ) do
  begin
    FCompareForLoop := flDownTo;
    FCompareValue := Value;

    Inc(FIndex, FIncrement);

    FIncrement := IncValue;

    Result := Value <= FIndex;

    if Result then Inc( FLoopCount );
  end;
end;

class function down_to_.K(Value: Integer; IncValue: Integer = -1): Boolean;
begin
  with Tvar_K( List_K.Last ) do
  begin
    FCompareForLoop := flDownTo;
    FCompareValue := Value;

    Inc(FIndex, FIncrement);

    FIncrement := IncValue;

    Result := Value <= FIndex;

    if Result then Inc( FLoopCount );
  end;
end;

class function loop.I.count: Integer;
begin
  Result := Tvar_I( List_I.Last ).FLoopCount;
end;

class function loop.I.value: Integer;
begin
  Result := Tvar_I( List_I.Last ).FIndex;
end;

class function loop.I.first: Boolean;
begin
  Result := Tvar_I( List_I.Last ).FLoopCount = 1;
end;

class function loop.I.last: Boolean;
begin
  with Tvar_I( List_I.Last ) do
    case FCompareForLoop of
    flTo:
    begin
      Result := (FIndex + FIncrement) <= FCompareValue;
      Result := not Result;
    end;
    flDownTo:
    begin
      Result := FCompareValue <= (FIndex + FIncrement);
      Result := not Result;
    end;
    else Assert(False); Result := False; end;
end;

class function loop.J.count: Integer;
begin
  Result := Tvar_J( List_J.Last ).FLoopCount;
end;

class function loop.J.value: Integer;
begin
  Result := Tvar_J( List_J.Last ).FIndex;
end;

class function loop.J.first: Boolean;
begin
  Result := Tvar_J( List_J.Last ).FLoopCount = 1;
end;

class function loop.J.last: Boolean;
begin
  with Tvar_J( List_J.Last ) do
    case FCompareForLoop of
    flTo:
    begin
      Result := (FIndex + FIncrement) <= FCompareValue;
      Result := not Result;
    end;
    flDownTo:
    begin
      Result := FCompareValue <= (FIndex + FIncrement);
      Result := not Result;
    end;
    else Assert(False); end;
end;

class function loop.K.count: Integer;
begin
  Result := Tvar_K( List_K.Last ).FLoopCount;
end;

class function loop.K.value: Integer;
begin
  Result := Tvar_K( List_K.Last ).FIndex;
end;

class function loop.K.first: Boolean;
begin
  Result := Tvar_K( List_K.Last ).FLoopCount = 1;
end;

class function loop.K.last: Boolean;
begin
  with Tvar_K( List_K.Last ) do
    case FCompareForLoop of
    flTo:
    begin
      Result := (FIndex + FIncrement) <= FCompareValue;
      Result := not Result;
    end;
    flDownTo:
    begin
      Result := FCompareValue <= (FIndex + FIncrement);
      Result := not Result;
    end;
    else Assert(False); Result := False; end;
end;

initialization
  List_I := TObjectList.Create(False);
  List_J := TObjectList.Create(False);
  List_K := TObjectList.Create(False);

finalization
  List_I.Free;
  List_J.Free;
  List_K.Free;

end.