POO : problème d'héritage

Réponse acceptée !
Il n'y a pas de "fonction magique" et, à mon humble avis, la seule solution consiste à utiliser une référence de classe (également appelée métaclasse).
Soit l'unité Unit2 modifiée :
unit Unit2;

interface

uses
  Classes;

type
//Déclaration forward
  TClassB = class;

  //Déclaration d'une métaclasse
  TClassAClass = classof TClassA;

  TClassA = class(TObject)
  private
    FClassB: TClassB;
  public
constructor Create;overload;
    //Constructeur de copie
constructor Create(A: TClassA; AClass: TClassAClass);overload;
    destructor Destroy;override;
    procedure Display(Lines: TStrings);virtual;
  end;

 

  TClassB = class(TObject)
  private
    FClassA: TClassA;
    FClassAA: TClassA;
  public
constructor Create(Aref: TClassA; AClass: TClassAClass);
    procedure Display(Lines: TStrings);
  end;

  TClassA2 = class(TClassA)
  public
procedure Display(Lines: TStrings);override;
  end;

implementation

{ TClassA }

constructor TClassA.Create;
begin
inherited;
  FClassB := TClassB.Create(Self, TClassAClass(Self.ClassType));
end;

constructor TClassA.Create(A: TClassA; AClass: TClassAClass);
begin
inherited Create;
  FClassB := A.FClassB;
end;

destructor TClassA.Destroy;
begin
  FClassB.Free;
  inherited;
end;

procedure TClassA.Display(Lines: TStrings);
begin
  Lines.Append('');
  Lines.Append('A => ' + Self.ClassName);
  Lines.Append('FClassB => ' + FClassB.ClassName);
end;

{ TClassB }

constructor TClassB.Create(Aref: TClassA; AClass: TClassAClass);
begin
inherited Create;
  FClassA := ARef;
  //Utilisation du constructeur de copie
  FClassAA := AClass.Create(Aref, AClass);
end;

procedure TClassB.Display(Lines: TStrings);
begin
  Lines.Append('');
  Lines.Append('B => ' + Self.ClassName);
  Lines.Append('FClassA => ' + FClassA.ClassName);
  Lines.Append('FClassAA => ' + FClassAA.ClassName);
  //FClassA.Display(Lines);
end;

{ TClassA2 }

procedure TClassA2.Display(Lines: TStrings);
begin
  Lines.Append('');
  Lines.Append('A2 => ' + Self.ClassName);
  Lines.Append('FClassB => ' + FClassB.ClassName);
end;

end.

NB : j'ai mis en rouge sombre les lignes ajoutées ou modifiées.

Dans la fiche de démo, le code doit aussi être modifié :
procedure TForm1.Button1Click(Sender: TObject);
var
  ClassA : TClassA;
  ClassB : TClassB;
  ClassA2 :  TClassA2;
begin
  Memo1.Clear;

  ClassA := TClassA.Create;
  ClassA.Display(Memo1.Lines);

  ClassA2 := TClassA2.Create;
  ClassA2.Display(Memo1.Lines);

  //Les 2 membres seront du type TClassA2
  ClassB := TClassB.Create(ClassA2, TClassA2);
  ClassB.Display(Memo1.Lines);
  ClassB.Free;

  //Les 2 membres seront du type TClassA
  ClassB := TClassB.Create(ClassA, TClassA);
  ClassB.Display(Memo1.Lines);
  ClassB.Free;

  ClassA.Free;
  ClassA2.Free;
end;

A dire vrai, le deuxième argument dans l'appel du constructeur de la classe B peut être de type TClassA ou d'une des classes descendant de cette dernière.

---

Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.