testgenericdelegates.out

格式化源码的最新板

program testgenericdelegates;{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  tmammifere = class
    procedure getnom; virtual;
  end;

  tchien = class(TMammifere)
    procedure getnom; override;
  end;
  thandlermethod<t:tmammifere> = function: t of object;
  tmondelegue  = thandlermethod<tmammifere>;
  tmondelegue2 = thandlermethod<tchien>;

  tclasse1 = class
    function firsthandler: tmammifere;
    function secondhandler: tchien;
  end;

  function tclasse1.firsthandler: tmammifere;
  begin
    Result := tmammifere.Create;
  end;

  function tclasse1.secondhandler: tchien;
  begin
    Result := tchien.Create;
  end;

  procedure tmammifere.getnom;
  begin
    writeln('TMammifere');
  end;

  procedure tchien.getnom;
  begin
    inherited;
    writeln('TChien');
  end;

var
  classe:   tclasse1;
  handler1: tmondelegue;
  handler2: tmondelegue2;
  hdl:      system.delegate;
  resultat: tmammifere;
begin
  classe := nil;
  try
    classe   := tclasse1.Create;
    handler1 := @classe.firsthandler;
    resultat := handler1;
    resultat.getnom;
    handler1 := @classe.secondhandler as tmethod;
    resultat := handler1;
    resultat.getnom;
    hdl      := @classe.firsthandler;
    resultat := (hdl as tmondelegue);
    resultat.getnom;
    hdl := @classe.secondhandler;
  except
    on e: Exception do
      writeln(e.ClassName, ': ', e.message);
  end;
  readln;
end.