DelFusa Blog 総本山

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

NEW | PAGE-SELECT | NEXT

≫ EDIT

スポンサーサイト

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

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

≫ EDIT

FoォォォオオオオオオオオーSX

つくりましたよ!

          _______________
   ∧.,,∧   /
  ミ.,,゚Д゚彡< 生姜ねーな。
  ミ つ目(ミ . \
~ミ,,O,,,,,,つ     ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄



再帰や外部呼び出し対応のForSXです。

ForSX.Iを何重に呼び出しても毎回、クラスが作られて配列に累積追加されるので大丈夫なのですが、おかげで、こんな書式になっちゃった。



  value := 0;
  forSx.I := 1; try while toSX.I(9) do
  begin
   value := value + varSx_I.Index;
  end; finally end_forSx.I; end;
  Check(45, value);

try finally endが含まれてしょんぼりです。
長ったらしくて、書く気が失せるコードですな。

実装と、テストコードを掲載しておきまっす。

type
 TvarSX = class
 private
  var Increment: Integer;
 end;

 TvarSX_I = class(TvarSX)
 public
  var Index: Integer;
 end;

 TvarSX_J = class(TvarSX)
 public
  var Index: Integer;
 end;

 forSX = class
  class procedure SetI(const Value: Integer); static;
  class procedure SetJ(const Value: Integer); static;
 public
  class property I: Integer write SetI;
  class property J: Integer write SetJ;
 end;

 end_forSX = class
  class function I: Integer;
  class function J: Integer;
 end;

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

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

 parent_loop = class
  class function I: TvarSX_I;
  class function J: TvarSX_J;
 end;

var
uVarSX_I_Table: array of TvarSX_I;
uVarSX_J_Table: array of TvarSX_J;

class procedure forSX.SetI(const Value: Integer);
begin
 SetLength(uVarSX_I_Table, Length(uVarSX_I_Table)+1);
 uVarSX_I_Table[Length(uVarSX_I_Table)-1] := TvarSX_I.Create;

 uVarSX_I_Table[Length(uVarSX_I_Table)-1].Index := 0;
 uVarSX_I_Table[Length(uVarSX_I_Table)-1].Increment := Value;
end;
class procedure forSX.SetJ(const Value: Integer);
begin
 SetLength(uVarSX_J_Table, Length(uVarSX_J_Table)+1);
 uVarSX_J_Table[Length(uVarSX_J_Table)-1] := TvarSX_J.Create;

 uVarSX_J_Table[Length(uVarSX_J_Table)-1].Index := 0;
 uVarSX_J_Table[Length(uVarSX_J_Table)-1].Increment := Value;
end;

class function end_forSX.I: Integer;
begin
 uVarSX_I_Table[Length(uVarSX_I_Table)-1].Free;
 SetLength(uVarSX_I_Table, Length(uVarSX_I_Table)-1);
end;
class function end_forSX.J: Integer;
begin
 uVarSX_J_Table[Length(uVarSX_J_Table)-1].Free;
 SetLength(uVarSX_J_Table, Length(uVarSX_J_Table)-1);
end;

class function toSX.I(Value, IncValue: Integer): Boolean;
begin
 Inc(uVarSX_I_Table[Length(uVarSX_I_Table)-1].Index,
   uVarSX_I_Table[Length(uVarSX_I_Table)-1].Increment);

 uVarSX_I_Table[Length(uVarSX_I_Table)-1].Increment := IncValue;
 Result := uVarSX_I_Table[Length(uVarSX_I_Table)-1].Index <= value;
end;
class function toSX.J(Value, IncValue: Integer): Boolean;
begin
 Inc(uVarSX_J_Table[Length(uVarSX_J_Table)-1].Index,
   uVarSX_J_Table[Length(uVarSX_J_Table)-1].Increment);

 uVarSX_J_Table[Length(uVarSX_J_Table)-1].Increment := IncValue;
 Result := uVarSX_J_Table[Length(uVarSX_J_Table)-1].Index <= value;
end;

class function down_toSX.I(Value, IncValue: Integer): Boolean;
begin
 Inc(uVarSX_I_Table[Length(uVarSX_I_Table)-1].Index,
   uVarSX_I_Table[Length(uVarSX_I_Table)-1].Increment);

 uVarSX_I_Table[Length(uVarSX_I_Table)-1].Increment := IncValue;
 Result := value <= uVarSX_I_Table[Length(uVarSX_I_Table)-1].Index;
end;
class function down_toSX.J(Value, IncValue: Integer): Boolean;
begin
 Inc(uVarSX_J_Table[Length(uVarSX_J_Table)-1].Index,
   uVarSX_J_Table[Length(uVarSX_J_Table)-1].Increment);

 uVarSX_J_Table[Length(uVarSX_J_Table)-1].Increment := IncValue;
 Result := value <= uVarSX_J_Table[Length(uVarSX_J_Table)-1].Index;
end;

function varSx_I: TvarSX_I;
begin
 if Length(uVarSX_I_Table) = 0 then
  raise Exception.Create('Error: TvarSX_I');

 Result := uVarSX_I_Table[Length(uVarSX_I_Table)-1];
end;
function varSx_J: TvarSX_J;
begin
 if Length(uVarSX_J_Table) = 0 then
  raise Exception.Create('Error: TvarSX_J');

 Result := uVarSX_J_Table[Length(uVarSX_J_Table)-1];
end;

class function parent_loop.I: TvarSX_I;
begin
 if (Length(uVarSX_I_Table) = 0) then
  raise Exception.Create('Error parent_loop');

 Result := uVarSX_I_Table[Length(uVarSX_I_Table) - 2];
end;
class function parent_loop.J: TvarSX_J;
begin
 if (Length(uVarSX_J_Table) = 0) then
  raise Exception.Create('Error parent_loop');

 Result := uVarSX_J_Table[Length(uVarSX_J_Table) - 2];
end;

procedure testForSX;
var
 ReturnString: String;
 value: Integer;
begin

 value := 0;
 forSx.I := 1; try while toSX.I(9) do
 begin
  value := value + varSx_I.Index;
 end; finally end_forSx.I; end;
 Check(45, value);

 value := 0;
 forSx.I := 1; try while toSX.I(10) do
 begin
  value := value + varSx_I.Index;
 end; finally end_forSx.I; end;
 Check(55, value);

 value := 0;
 forSx.I := 10; try while toSX.I(100, 10) do
 begin
  value := value + varSX_I.Index;
 end; finally end_forSx.I; end;
 Check(550, value);

 value := 0;
 forSx.I := 1; try while toSX.I(9) do
 begin
  value := value + varSX_I.Index;
 end; finally Check(10, varSX_I.Index); end_forSx.I; end;

 value := 0;
 forSx.I := 1; try while toSX.I(10) do
 begin
  value := value + varSX_I.Index;
 end; finally Check(11, varSX_I.Index); end_forSx.I; end;

 value := 0;
 forSx.I := 10; try while toSX.I(1000, 5) do
 begin
  if varSX_I.Index mod 10 <> 0 then continue;
  value := value + varSX_I.Index;
  if 100 <= varSX_I.Index then break;
 end; finally end_forSx.I; end;
 Check(550, value);

 value := 0;
 forSx.I := 10; try while toSX.I(1000, 5) do
 begin
  value := value + varSX_I.Index;
  if 100 <= varSX_I.Index then break;
  Inc(varSX_I.Index, 2);
  varSX_I.Index := varSX_I.Index + 3;
 end; finally end_forSx.I; end;
 Check(550, value);

 value := 0;
 forSx.I := 10; try while down_toSX.i(1) do
 begin
  value := value + varSX_I.Index;
  Check(False, varSX_I.Index = 0);
 end; finally Check(0, varSX_I.Index); end_forSx.I; end;
 Check(55, value);

 value := 0;
 forSx.I := 100; try while down_toSX.i(10, -10) do
 begin
  value := value + varSX_I.Index;
  Check(False, varSX_I.Index <= 9);
 end; finally end_forSx.I; end;
 Check(550, value);

 ReturnString := '';
 forSx.I := 0; try while toSx.I(10) do
 begin
  forSx.I := 0; try while toSx.I(3) do
  begin
   ReturnString := ( IntToStr(parent_loop.I.Index) + '-' + IntToStr(varSX_I.Index) );
  end; finally end_forSx.I; end;
 end; finally end_forSx.I; end;
 Check('10-3', ReturnString);

 ReturnString := '';
 forSx.I := 0; try while toSx.I(10) do
 begin
  forSx.J := 0; try while toSx.J(3) do
  begin
   ReturnString := ( IntToStr(varSx_I.Index) + '-' + IntToStr(varSX_J.Index) );
  end; finally end_forSx.J; end;
 end; finally end_forSx.I; end;
 Check('10-3', ReturnString);

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 testForSX;
end;

────────────────────
進化したprocedure を含める事ができる Record型を駆使しても、やはり破棄タイミングがわからないために、こう実装するしか手がないかなあ。

ガーベージコレクションや、record型に、freeがあればいいのにな。というところ。

うーーん、、ややこしそうだったから
_FinalizeRecord には手を出していなかったのですが、やりますかね。

record型にイベントハンドラのような、procedure of record型なんて
つくったりできるのかしら?

次の名前は、ForRX・・・なのか?
スポンサーサイト

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

COMMENT















非公開コメント

PREV | PAGE-SELECT | NEXT

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