(*----------------------------------------
block構文のためのユニット

 次のような構文を使うことができます。
 
 ・ block構文
        
        procedure TForm1.Button1Click(Sender: TObject);
        var
          s: String;
        begin
          s := 'TEST';
 
          block(procedure
          var
            a: Integer;
            b: Integer;
          begin
            a := 1;
            b := 2;
            s := s + IntToStr(a+b);
          end );
        ShowMessage(s); //TEST3 と表示される
      end;
 
 ・ local.block構文

        procedure TForm1.Button2Click(Sender: TObject);
        var
          s: string;
        begin
          s := 'TEST';
 
          local.block := procedure
          var
            a, b, I: Integer;
          begin
            a := 1; b := 2;
            s := s + '-' +IntToStr(a+b);
            a := 0;
            for I := 0 to 10 do
              a := a + I;   //0+1+2+…10=55
            s := s + '-' +IntToStr(a);
          end;
          ShowMessage(s); //TEST-3-55 と表示される
        end;

・	block_string構文

        procedure TForm1.Button4Click(Sender: TObject);
        var
          s: String;
        begin
          s := 'TEST';
          ShowMessage(
            block_string(function: string
            var
              a, b: string;
            begin
              a := 'A';
              b := 'B';
              Result := s + a+ b;
            end ) );  //TESTAB と表示される
        end;

・	local.result<型>構文

        procedure TForm1.Button5Click(Sender: TObject);
        var
          s: String;
        begin
          s := 'TEST';
          s := s +
            local.result<string>(function: string
            var
              a, b: string;
            begin
              a := 'A';
              b := 'B';
              Result := a + b + s;
            end );
          ShowMessage(s); //TESTABTEST と表示される
          s := 'TEST';
          s := s + IntToStr(
            local.result<Integer>(function: Integer
            var
              a, b: Integer;
            begin
              a := 1;
              b := 2;
              Result := a + b;
            end ) );
          ShowMessage(s); //TEST3 と表示される
        end;

・	local<型>.block構文

        procedure TForm1.Button6Click(Sender: TObject);
        var
          s: String;
        begin
          s := 'TEST';
          local<string>.block := function: string
          var
            a, b: string;
          begin
            a := 'A';
            b := 'B';
            Result := a + b + s;
          end;
          s := s + local<string>.result;
          ShowMessage(s); //TESTABTEST と表示される
          s := 'TEST';
          local<Integer>.block := function: Integer
          var
            a, b: Integer;
          begin
            a := 1;
            b := 2;
            Result := a + b;
          end;
          s := s + IntToStr(local<Integer>.result);
          ShowMessage(s); //TEST3 と表示される
        end;


ネストして使うことも出来ます。

備考:   
履歴:   
2011/12/12(月)
・  作成済み
//----------------------------------------*)

unit LocalBlock;

interface

uses
  SysUtils,
uses_end;

procedure block(p: TProc);

type
  local = class
  private
    class procedure SetBlock(const Value: TProc); static;
  public
    class property block: TProc write SetBlock;


    class function result<TResult>(f: TFunc<TResult>): TResult;
  end;

{----------------------------------------
function block_result<TResult>(f: TFunc<TResult>): TResult;

function block_result<TResult>(f: TFunc<TResult>): TResult;
begin
  Result := f;
end;

このように書くと下記のエラーが出てコンパイルできません。
[DCC エラー] LocalBlock.pas(39): E2530 型パラメータはグローバル プロシージャや関数で許可されません。
//----------------------------------------}

function block_string(f: TFunc<String>): string;

type
  local<TResult> = class
  private
    class var FValue: TResult;
    class procedure SetBlock(const Value: TFunc<TResult>); static;
  public
    class function result: TResult;
    class property block: TFunc<TResult> write SetBlock;
  end;

implementation

procedure block(p: TProc);
begin
  p;
end;

class procedure local.SetBlock(const Value: TProc);
begin
  Value;
end;

//----------------------------------------

function block_string(f: TFunc<String>): string;
begin
  Result := f;
end;

//----------------------------------------

class function  local.result<TResult>(f: TFunc<TResult>): TResult;
begin
  Result := f;
end;

//----------------------------------------


class procedure local<TResult>.SetBlock(const Value: TFunc<TResult>);
begin
  FValue := Value;
end;
class function local<TResult>.result: TResult;
begin
  Result := FValue;
end;

(*----------------------------------------
//下記の実装でも同じ動作をするが
//上記実装コードは block プロパティ代入時に関数を実行。
//下記実装コードでは result 呼び出し時に関数が動作するという違いがある
type
  local<TResult> = class
  private
    class var FFunc: TFunc<TResult>;
    class procedure SetBlock(const Value: TFunc<TResult>); static;
  public
    class function result: TResult;
    class property block: TFunc<TResult> write SetBlock;
  end;

class procedure local<TResult>.SetBlock(const Value: TFunc<TResult>);
begin
  FFunc := Value;
end;

class function local<TResult>.result: TResult;
begin
  Result := FFunc;
end;
//----------------------------------------*)

end.