Smart pascal source code


type
  TMyProc = procedure;

type
  TClassA = class
    Field: String;
    procedure StaticProc;
    procedure VirtualProc; virtual;
  end;

type
  TClassB = class(TClassA)
    class procedure ClassProc;
    procedure VirtualProc; override;
  end;

procedure TClassA.StaticProc;
begin
  WriteLn(ClassName + ' StaticProc ' + Field);
end;

procedure TClassA.VirtualProc;
begin
  WriteLn(ClassName + ' VirtualProc ' + Field);
end;

class procedure TClassB.ClassProc;
begin
  WriteLn(ClassName + ' ClassProc');
end;

procedure TClassB.VirtualProc;
begin
  WriteLn(ClassName + ' VirtualProc overriden ' + Field);
end;

var a := TClassA.Create;
var b := TClassB.Create;
var p: TMyProc;

a.Field := 'Alpha';
b.Field := 'Beta';

p := a.StaticProc;
p;
p := a.VirtualProc;
p;
p := b.StaticProc;
p;
b.ClassProc;
p;
p := b.VirtualProc;
p;
p := TClassB.ClassProc;
p;

a := b;
p := a.StaticProc;
p;
p := a.VirtualProc;
p;

{<<< RESULT - CONSOLE LOG >>>
-----------------------------
TClassA StaticProc Alpha
TClassA VirtualProc Alpha
TClassB StaticProc Beta
TClassB ClassProc
TClassB StaticProc Beta
TClassB VirtualProc overriden Beta
TClassB ClassProc
TClassB StaticProc Beta
TClassB VirtualProc overriden Beta
-----------------------------
{<<<<<<<<< THE END >>>>>>>>>}

var TClassA = {
   $ClassName:"TClassA",$Parent:TObject
   ,$Init:function ($) {
      TObject.$Init($);
      $.Field = "";
   }
   ,StaticProc:function(Self) {
      WriteLn((TObject.ClassName($Check(Self,"").ClassType)+" StaticProc "+$Check(Self,"").Field));
   }
   ,VirtualProc:function(Self) {
      WriteLn((TObject.ClassName($Check(Self,"").ClassType)+" VirtualProc "+$Check(Self,"").Field));
   }
   ,Destroy:TObject.Destroy
   ,VirtualProc$:function($){return $.ClassType.VirtualProc($)}
};
var TClassB = {
   $ClassName:"TClassB",$Parent:TClassA
   ,$Init:function ($) {
      TClassA.$Init($);
   }
   ,ClassProc:function(Self) {
      WriteLn((TObject.ClassName($Check(Self,""))+" ClassProc"));
   }
   ,VirtualProc:function(Self) {
      WriteLn((TObject.ClassName($Check(Self,"").ClassType)+" VirtualProc overriden "+$Check(Self,"").Field));
   }
   ,Destroy:TObject.Destroy
   ,VirtualProc$:function($){return $.ClassType.VirtualProc($)}
};
var a = null,
   b = null,
   p = null;

/* <<< main JS >>> */

   a = TObject.Create($New(TClassA));
   b = TObject.Create($New(TClassB));
   $Check(a,"").Field = "Alpha";
   $Check(b,"").Field = "Beta";
   p = $Event0(a,TClassA.StaticProc);
   $CheckFunc(p,"")();
   p = $Event0(a,TClassA.VirtualProc$);
   $CheckFunc(p,"")();
   p = $Event0(b,TClassA.StaticProc);
   $CheckFunc(p,"")();
   TClassB.ClassProc($Check(b,"").ClassType);
   $CheckFunc(p,"")();
   p = $Event0(b,TClassA.VirtualProc$);
   $CheckFunc(p,"")();
   p = $Event0(TClassB,TClassB.ClassProc);
   $CheckFunc(p,"")();
   a = b;
   p = $Event0(a,TClassA.StaticProc);
   $CheckFunc(p,"")();
   p = $Event0(a,TClassA.VirtualProc$);
   $CheckFunc(p,"")();