Здравствуйте, Serginio1, Вы писали:

Наконец то попало это чудо мне в руки. Интересно было посмотреть не только на хэлперы но и на реализацию виртуальных конструктороа и статических виртуальных методов. Чудо не произошло решаетс через метаклассы. Может кому интересно.

unit Class1;

interface

type
 TVclass= class of TVirtClass;
  TVirtClass = class
  strict private
  class var        // Introduce a block of class static fields.
          Red: Integer;

   class constructor Create;


  private
    { Private Declarations }
    FName:String;
  public
    constructor Create; overload;  virtual;
    constructor Create(Const St:String); overload; virtual;
    Function ToString:String; override;
    class Function StaticVirt:String; virtual;
  end;

  TVirtClassHerlper= class helper for TVirtClass
  public
  Function MyFunc:String;
  end;

   TVirtClass1 = class(TVirtClass)
   constructor Create;  overload; override;
   constructor Create(Const St:String); overload; override;
   class Function StaticVirt:String; override;
   end;
   TVirtClass2 = class(TVirtClass)
   constructor Create; overload; override;
   constructor Create(Const St:String);  overload; override;
   class Function StaticVirt:String; override;
   end;

   function GetClassName(AClass:TVclass):String;
implementation

constructor TVirtClass.Create;
begin
  inherited Create;
  // TODO: Add any constructor code here
end;

constructor TVirtClass.Create(const St: &String);
begin
inherited Create;
self.FName:=st;
end;

class constructor TVirtClass.Create;
begin
     red:=666;
end;

class function TVirtClass.StaticVirt: String;
begin
result:= red.ToString;
end;

function TVirtClass.ToString: String;
begin
result:=Fname;
end;

{ TVirtClassHerlper }

function TVirtClassHerlper.MyFunc: String;
begin
 result:=toString+' TVirtClassHerlper'
end;

{ TVirtClass1 }

constructor TVirtClass1.Create;
begin
  inherited;
  FName:='TVirtClass31'

end;

constructor TVirtClass1.Create(const St: &String);
begin
  inherited;
 self.FName:=st;
end;

class function TVirtClass1.StaticVirt: String;
begin
result:='TVirtClass1.StaticVirt'
end;

{ TVirtClass2 }

constructor TVirtClass2.Create;
begin
  inherited;
  FName:='TVirtClass32'
end;
function GetClassName(AClass:TVclass):String;
begin
 result:= Aclass.Create.ToString;
end;
constructor TVirtClass2.Create(const St: &String);
begin
  inherited;
self.FName:=st;
end;

class function TVirtClass2.StaticVirt: String;
begin
result:='TVirtClass2.StaticVirt'
end;

end.

К аждому лассу создается внутренний класс '@Meta'+ClassName

Например

public @MetaTVirtClass = class(@TClass)
public 
constructor Create;
function @Create: TObject; virtual;
function @Create([in] St: String): TObject; virtual;
function StaticVirt: String; virtual;
static @Instance: @MetaTVirtClass;
strict private 
constructor Create;

end;

Конструктор типа

strict private constructor Create;

.maxstack 1
L_0000: newobj @MetaTVirtClass..ctor
L_0005: stsfld @MetaTVirtClass.@Instance
L_000a: ldtoken TVirtClass
L_000f: call RuntimeHelpers.RunClassConstructor
L_0014: ret

Создает экземпляр класса @MetaTVirtClass и записывет ее в статическую переменную
@MetaTVirtClass.@Instance

А вызов

procedure TWinForm.Button1_Click(sender: System.Object; e: System.EventArgs);
begin
  TextBox1.AppendText('TVirtClass1='+Class1.GetClassName(TVirtClass1)+Environment.NewLine
);
    TextBox1.AppendText('TVirtClass2='+Class1.GetClassName(TVirtClass2)+Environment.NewLine
);

    TextBox1.AppendText(TVirtClass2.Create.MyFunc+Environment.NewLine
);
 TextBox1.AppendText(TVirtClass2.StaticVirt+Environment.NewLine
);
TextBox1.AppendText(TVirtClass1.StaticVirt+Environment.NewLine
);
end;

Трансформируется (выдран через Reflector For Net)

procedure TWinForm.Button1_Click(sender: TObject; e: EventArgs);
begin
Self.TextBox1.AppendText(String.Concat('TVirtClass1=', Unit.GetClassName(@MetaTVirtClass1.@Instance), Environment.NewLine));
Self.TextBox1.AppendText(String.Concat('TVirtClass2=', Unit.GetClassName(@MetaTVirtClass2.@Instance), Environment.NewLine));
Self.TextBox1.AppendText(String.Concat(TVirtClass2.Create.MyFunc, Environment.NewLine));
Self.TextBox1.AppendText(String.Concat(@MetaTVirtClass2.@Instance.StaticVirt, Environment.NewLine));
Self.TextBox1.AppendText(String.Concat(@MetaTVirtClass1.@Instance.StaticVirt, Environment.NewLine)) 
end;

Вызовы статических виртуальных методов в вызовы виртуальных методов метакласса.

class function Unit.GetClassName(AClass: @MetaTVirtClass): String;
var text1: String;
 
begin text1:= (AClass.@Create as TVirtClass).ToString;
result:= text1 
end;

По поводу хэлперов то в рефлекторе они ведут себя как методы экземпляра класса
TVirtClass2.Create.MyFunc
хотя описание функции класса хэлпера следующее

class function TVirtClassHerlper.MyFunc(Self: TVirtClass): String;
var text1: String;
 
begin text1:= String.Concat(Self.ToString, ' TVirtClassHerlper');
result:= text1 
end;

В общем достаточно интересно и возмоможности использования статических виртуальных методов
и расширение функциональности за счет хэлперов.