DelFusa Blog 総本山

プログラミングの話題とかです。

NEW | PAGE-SELECT | NEXT

≫ EDIT

スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

| スポンサー広告 | --:-- | comments(-) | trackbacks(-) | TOP↑

≫ EDIT

とうとう完成した拡張For構文(再び)の実装


          ,,,,,,,,∧,,∧    オサエテオサエテ
        @′ ミ;゚д゚彡  
        ,;と;,,;;;;;;U;;;;U;;彡;;,,,,     
     、,,;ミ;;          "''''彡'    ガルルルルル



ということで、実装できてしまえば簡単です。
パズルみたいなものでした。



どーぞ

unit ForExtUnit;

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.
スポンサーサイト

| 未分類 | 22:14 | comments:0 | trackbacks(-) | TOP↑

COMMENT















非公開コメント

PREV | PAGE-SELECT | NEXT

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。