POO à gogo – Les méthodes avec Free Pascal/Lazarus (1/2)

Les méthodes statiques se comportent comme des procédures ou des fonctions ordinaires à ceci près qu’elles ont besoin d’un objet pour être invoquées. Elles sont dites statiques parce que le compilateur crée les liens nécessaires à leur accès dès la compilation : elles sont ainsi particulièrement rapides, mais manquent de souplesse en se refusant à tout polymorphisme. Pour les utiliser, rien de plus simple : vous n'avez qu'à les déclarer et les définir, sans autre précision !

Une méthode statique peut être redéfinie dans les classes qui en héritent. Pour cela, il suffit qu’elle soit accessible à la classe enfant : soit elle est privée, mais présente dans la même unité ; soit elle est d’une visibilité supérieure et accessible partout.

Par exemple, en ce qui concerne la méthode Manger définie dans un parent dénommé TAnimal, vous estimerez qu’elle a besoin d’être adaptée au régime d’un carnivore dans une classe enfant dénommée TChien. Afin de la redéfinir, il vous faudra de nouveau l’inclure dans l’interface puis coder son comportement actualisé.

[Exemple PO-04]

Chargez le programme sur les animaux qui définit les classes TAnimal et TChien dans l'unité animal. Cette application très simple affiche des messages adaptés au comportement d'un animal d'un type donné.

Modifiez le code source de cette unité selon le modèle suivant :

• ajoutez la méthode Manger à l’interface de la classe TChien :

TChien = class(TAnimal)
strict private
  fBatard: Boolean;
  procedure SetBatard(AValue: Boolean);
public
  procedure Manger; // <= la méthode est redéfinie
  procedure Aboyer;
  procedure RemuerLaQueue;
  property Batard: Boolean read fBatard write SetBatard;
end;

• pressez simultanément Ctrl-Maj-C pour demander à Lazarus de générer le squelette de la nouvelle méthode ;
• complétez ce squelette en vous servant du modèle suivant :

procedure TChien.Manger;
begin
  MessageDlg(Nom + ' mange de la viande...', mtInformation, [mbOK], 0);
end;

Déception ! À l’exécution, si vous choisissez « Rantanplan » comme animal et que vous cliquez sur « Manger », vos modifications semblent ne pas avoir été prises en compte !

L’explication de ce comportement non voulu est à chercher dans le gestionnaire OnClick du composant lbAction :

procedure TMainForm.lbActionClick(Sender: TObject);
// *** choix d'une action ***
begin
  case lbAction.ItemIndex of
    0: UnAnimal.Avancer;
    1: UnAnimal.Manger; // <= ligne qui pose problème
    2: UnAnimal.Boire;
    3: UnAnimal.Dormir;
    4: if (UnAnimal is TChien) then // […]

En effet, en écrivant UnAnimal.Manger, vous demandez à un animal de manger et non à un chien ! Vous obtenez logiquement ce que sait faire tout animal, à savoir manger, et non la spécialisation de ce que fait un chien carnivore. Comme noté plus haut, une méthode statique est liée dès la compilation : elle ne s'adapte pas automatiquement à la nature des données fournies en paramètres.

Dès lors que votre classe TChien a redéfini le comportement de son parent, il faut aussi modifier la portion de code qui pose problème :

1 : if (UnAnimal is TChien) then
       (UnAnimal as TChien).Manger
     else
       UnAnimal.Manger;

Par ces lignes, vous forcez l’animal à prendre la forme d’un chien si c’est un chien qui est impliqué dans l’action : en termes plus abstraits, vous testez UnAnimal pour savoir s’il n’est pas du type TChien avant de le forcer à prendre cette forme puis à exécuter la méthode Manger adaptée.

À présent, vous obtenez bien le message qui correspond au régime alimentaire de Rantanplan :

Vous aurez noté que la redéfinition d’une méthode statique provoque le remplacement de la méthode de l’ancêtre. Mais comment modifier cette méthode de telle sorte qu’elle conserve les fonctionnalités de son ancêtre tout en en acquérant d’autres ? Après tout, n'est-ce pas le principe même de l'héritage ?

Il suffit pour cela d'utiliser le mot réservé inherited. C'est lui qui permet d’hériter du comportement d'une méthode d’un parent tout en autorisant des compléments.

[Exemple PO-05]

• modifiez Manger pour qu’elle bénéficie de la méthode de son ancêtre :

procedure TChien.Manger;
begin
   inherited Manger; // on hérite de la méthode du parent
   MessageDlg('... mais principalement de la viande...', mtInformation, [mbOK], 0);
end;

Vous venez d'introduire un mot réservé qui fait appel à la méthode du parent : inherited. Si vous lancez l’exécution du programme, vous constatez que choisir « Rantanplan » puis « Manger » provoque l’affichage de deux boîtes de dialogue successives : la première qui provient de TAnimal grâce à inherited indique que Rantanplan mange tandis que la seconde qui provient directement de TChien précise que la viande est son aliment principal.

D’un point de vue syntaxique, inherited est souvent employé seul dans la mesure où il n’y a pas d’ambiguïté quant à la méthode héritée. Les deux formulations suivantes sont dans ce cas équivalentes :

procedure TChien.Manger;
begin
  inherited Manger; // on hérite de la méthode de l’ancêtre
  // ou
  inherited; // équivalent
  // [...]
end;

Par ailleurs, inherited peut être appelé à tout moment dans le code de définition de la classe. Il est parfaitement légal d’avoir une méthode dont le code correspondrait à ceci :

procedure TChien.RemuerLaQueue;
begin
  inherited Manger; // <= Manger vient de TAnimal !
  MessageDlg('C''est pourquoi il remue la queue...', mtInformation, [mbOK], 0);
end;

La méthode héritée est celle qui affiche le nom de l’animal en précisant qu’il mange. La conséquence de cette action est ensuite affichée dans une nouvelle boîte de dialogue : vous exprimez ainsi le fait que le chien mange et qu’il en est très satisfait !

[Exemple PO-06]

Pour obtenir ce résultat, procédez ainsi :

• ajoutez « Remuer de la queue » à la liste des actions possibles de lbAction :

  

• ajoutez les lignes suivantes à l’événement OnClick du même composant :

  else
    MessageDlg(UnAnimal.Nom + ' ne sait pas aboyer...', mtError, [mbOK], 0);
  5: if UnAnimal is TChien then // <= nouvelle portion de code
        (UnAnimal as TChien).RemuerLaQueue
      else
         MessageDlg(UnAnimal.Nom + ' ne sait pas remuer la queue...', mtError, [mbOK], 0);
  end;

• dans animal, remplacez le code de la méthode RemuerLaQueue par le code proposé ci-dessus.

À l’exécution, vous avez bien les messages adaptés qui s’affichent. Vous vérifiez une nouvelle fois que l’héritage permet à un objet de type TChien de prendre la forme d’un TChien ou d’un TAnimal suivant le contexte, mais qu'il est toujours de votre responsabilité de préciser le type de l'objet manipulé lorsque vos méthodes sont statiques.

Très souvent, vous serez ainsi amené à créer une classe générale qui se spécialisera avec ses descendants, sans avoir à tout prévoir avec l’ancêtre le plus générique et tout à redéfinir avec la classe la plus spécialisée. En fait, le mécanisme est si intéressant qu’il suffit de jeter un coup d’œil à la LCL pour voir qu’il y est omniprésent !

Contrairement aux méthodes statiques dont le compilateur détermine directement les adresses au moment de la compilation, les méthodes virtuelles sont accessibles via une table qui porte le nom de VMT (Virtual Method Table, soit table des méthodes virtuelles). C'est elle qui permet de retrouver à l’exécution l'adresse de chacune des méthodes dont la classe a hérité et de celles qu’elle a elle-même définies. Vous verrez qu'elle autorise surtout la mise en œuvre du polymorphisme.

I-B-1. La directive virtual▲

public 
  procedure Avancer;
  procedure Manger; virtual; // <= voici l’ajout
  procedure Boire;

I-B-2. La directive override▲

public
   procedure Manger; override; // <= ligne changée
   procedure Aboyer;
   procedure RemuerLaQueue;

type

  { TMainForm }

  TMainForm = class(TForm)
    [...]
  public
    { public declarations }
    procedure ATable(AObject: TAnimal); // => ajout
  end;

var
  MainForm: TMainForm;

implementation

 […]

procedure TMainForm.rbMinetteClick(Sender: TObject);
// *** l'animal est Minette ***
begin
  UnAnimal := Minette;
  ATable(UnAnimal); // => ajout
end;

procedure TMainForm.rbNemoClick(Sender: TObject);
// *** l'animal est Némo ***
begin
  UnAnimal := Nemo;
  ATable(UnAnimal); // => ajout
end;

procedure TMainForm.rbRantanplanClick(Sender: TObject);
// *** l'animal est Rantanplan ***
begin
  UnAnimal := Rantanplan;
  ATable(UnAnimal); // => ajout
end;

procedure TMainForm.ATable(AObject: TAnimal);
begin
  AObject.Manger; // => ajout
end;

end.

I-B-3. Le polymorphisme à l’œuvre▲

procedure TChien.Manger;
begin
  MessageDlg('... mange principalement de la viande...', mtInformation, [mbOK], 0);
end;

{ TAnimal }

  TAnimal = class
  private
    fNom: string;
    fASoif: Boolean ;
    fAFaim: Boolean ;
    procedure SetNom(AValue: string);
  public
    procedure Avancer;
    procedure Manger; virtual;
    procedure Aboyer; virtual;
    procedure RemuerLaQueue; virtual;
    procedure Boire;
    procedure Dormir;
  published
    property ASoif: Boolean read fASoif write fASoif;
    property AFaim: Boolean read fAFaim write fAFaim;
    property Nom: string read fNom write SetNom;
  end ;

  { TChien }

  TChien = class(TAnimal)
  strict private
    fBatard : Boolean ;
    procedure SetBatard(AValue: Boolean);
  public
    procedure Manger; override;
    procedure Aboyer; override;
    procedure RemuerLaQueue; override;
    property Batard: Boolean read fBatard write SetBatard;
  end;

procedure TAnimal.Aboyer;
begin
  MessageDlg(Nom + ' ne sait pas aboyer...', mtInformation, [mbOK], 0);
end;

procedure TAnimal.RemuerLaQueue;
begin
  MessageDlg(Nom + ' ne sait pas remuer de la queue...', mtInformation, [mbOK], 0);
end;

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls,
  animal; // unité de la nouvelle classe

type

  { TMainForm }

  TMainForm = class(TForm)
    lbAction: TListBox;
    rbNemo: TRadioButton;
    rbRantanplan: TRadioButton;
    rbMinette: TRadioButton;
    rgAnimal: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lbActionClick(Sender: TObject);
    procedure rbMinetteClick(Sender: TObject);
    procedure rbNemoClick(Sender: TObject);
    procedure rbRantanplanClick(Sender: TObject);
  private
    { private declarations }
    Nemo, Minette, UnAnimal : TAnimal;
    Rantanplan: TChien;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }


procedure TMainForm.FormCreate(Sender: TObject);
// *** création de la fiche ***
begin
  […] // pas de changements
end;

procedure TMainForm.FormDestroy(Sender: TObject);
// *** destruction de la fiche ***
begin
 […] // pas de changements
end;

procedure TMainForm.lbActionClick(Sender: TObject);
// *** choix d'une action ***
begin
  case lbAction.ItemIndex of // finis les tests et les transtypages !!!
    0: UnAnimal.Avancer;
    1 : UnAnimal.Manger;
    2: UnAnimal.Boire;
    3: UnAnimal.Dormir;
    4: UnAnimal.Aboyer;
    5: UnAnimal.RemuerLaQueue;
  end;
end;

procedure TMainForm.rbMinetteClick(Sender: TObject);
// *** l'animal est Minette ***
begin
  UnAnimal := Minette;
end;

procedure TMainForm.rbNemoClick(Sender: TObject);
// *** l'animal est Némo ***
begin
  UnAnimal := Nemo;
end;

procedure TMainForm.rbRantanplanClick(Sender: TObject);
// *** l'animal est Rantanplan ***
begin
  UnAnimal := Rantanplan;
end;

end.

I-B-4. La directive reintroduce▲

// méthode du parent
TAnimal = class
// [...]
procedure Manger; virtual; // la méthode est virtuelle
// [...]
// méthode du descendant
TAutreAnimal = class(TAnimal)
procedure Manger; reintroduce; // la méthode virtuelle est écrasée

I-B-5. Bilan sur la virtualité▲

Pour toute classe, il faut au moins un constructeur, mais plusieurs sont possibles. Bien que l'identifiant en général adopté pour un constructeur soit Create, il ne s'agit que d'une convention bien utile pour la relecture du code : ce qui importe est l'emploi du mot réservé constructor. L'instanciation d'une classe consiste à créer un pointeur sur la pile pour la variable du type de la classe à instancier, allouer de la mémoire sur le tas pour le stockage de l'objet, définir les valeurs par défaut des champs (ordinaux à 0, booléens à False, chaînes vides et pointeurs à nil…) et exécuter le code éventuel contenu dans l'implémentation du constructeur. C'est le pointeur qui fait référence à l'objet qui est renvoyé implicitement par le constructeur utilisé.

L'instanciation d'une classe s'opère sur un type classe et non sur un type objet. Ainsi, la ligne de code suivante crée l'objet MyAnimal de type TAnimal :

MyAnimal:= TAnimal.Create;

En revanche, quoique tout à fait envisageable à propos d'une instance valide, la ligne suivante ne fait qu'exécuter le code implémenté dans le constructeur :

MyAnimal.Create;

Si la classe n'a pas été instanciée, une exception sera déclenchée.

Les instances de classe exigent un destructeur pour être libérées, que ce destructeur soit géré ou non par l'utilisateur : le mot réservé destructor est prévu à cet effet. L'emploi de Destroy sans paramètres est obligatoire lui aussi, tout comme l'emploi de la directive override en cas de surcharge et d'inherited à l'intérieur de la nouvelle implémentation. En revanche, il est plus rare d'avoir à surcharger le destructeur que le constructeur, sauf dans le cas où ce dernier aura créé des objets à libérer.

La place d’inherited au sein d’une méthode a son importance : si vous voulez modifier le comportement du parent, il est généralement nécessaire d’appeler en premier lieu inherited puis d’apporter les modifications. Lors d’un travail de nettoyage du code, il est au contraire souvent indiqué de nettoyer ce qui est local à la classe enfant avant de laisser le parent faire le reste du travail.

Lorsque vous redéfinirez Create, il est fort probable que vous ayez à procéder ainsi :

constructor Create;
begin
  inherited Create; // on hérite
// ensuite votre travail d’initialisation
// [...]
end;

Certes, le constructeur le plus ancien (celui de TObject), lorsqu'il est appliqué à une instance d'objet, ne fait rien puisque le corps de cette méthode spéciale est vide, mais il faut vous dire que vous ne connaissez pas toujours exactement les actions exécutées par tous les ancêtres de votre classe : êtes-vous sûr qu’aucun d’eux n'a modifié pour ses propres besoins une propriété que vous voulez initialiser à votre manière ? Dans ce cas, les Create hérités annuleraient votre travail ! Êtes-vous par ailleurs certain que le Create que vous manipulez n'a jamais été redéfini ?

Pour Destroy, le schéma contraire s’applique : procédez en premier lieu à votre travail local de nettoyage (en général, la libération d'objets créés par votre classe pour ses besoins propres). Sinon, vous risquez par exemple de vouloir libérer des ressources qui auront déjà été libérées par un ancêtre de votre classe et par conséquent de provoquer une erreur. La forme habituelle du destructeur Destroy hérité sera donc :

destructor Destroy;
begin
  // votre travail local de nettoyage
  // [...]
  inherited Destroy; // on hérite ensuite !
end;

En cas d'erreur lors de l'instanciation, le destructeur Destroy correspondant est automatiquement appelé. Ce mécanisme a plusieurs conséquences dont il faut avoir conscience.

La première conséquence est qu'il ne faut pas protéger le code de l'instanciation au risque d'essayer de libérer plusieurs fois des ressources :

// code fautif

try
  MyAnimal:= TAnimal.Create;
  MyAnimal.Manger;
finally
  MyAnimal.Free;
end;

// code correct

MyAnimal:= TAnimal.Create;
try
  MyAnimal.Manger;
finally
  MyAnimal.Free;
end;

La seconde portion de code est la seule correcte, même si le compilateur acceptera sans réagir la première version. En effet, si une exception est levée lors de l'instanciation de TAnimal, faute de mémoire par exemple, le code de libération sera appelé deux fois : une fois automatiquement et une seconde fois par la section du finally. Suivant ce que comprend cette section, les résultats peuvent engendrer des exceptions en cascade, voire rendre le système instable.

La seconde conséquence est qu'il faut veiller à ce que Destroy gère correctement des objets inachevés. En particulier, les pointeurs des objets étant initialisés à nil avant les autres actions prévues dans l'implémentation du constructeur, il faut faire appel à Free et non à Destroy pour les libérer :

type

  { TMyClass }

  TMyClass = class
  strict private
    fMyAnimal: TAnimal;
  public
    constructor Create;
    destructor Destroy; override;
  end;

 implementation

{$R *.lfm}

{ TMyClass }

constructor TMyClass.Create;
begin
  inherited;
  fMyAnimal := TAnimal.Create;
end;

destructor TMyClass.Destroy;
begin
  fMyAnimal.Free;
  //fMyAnimal.Destroy; <= problèmes en vue !
  inherited Destroy;
end;

L'avantage de Free sur Destroy est que la première méthode teste les valeurs avant de détruire les objets : si Self (qui pointe sur l'objet lui-même) est différent de nil, elle appelle Destroy, sinon elle ne fait rien. Destroy procéderait à la destruction sans aucune vérification de l'existence même des objets à détruire !

En dehors du cas qui vient d'être vu, la destruction d'une instance de classe peut poser un autre problème : vous pourriez être tenté de tester sans précautions particulières l'existence d'une instance en utilisant la fonction Assigned définie dans l'unité system. Cette fonction prend un pointeur en paramètre et renvoie une valeur booléenne suivant que le pointeur est différent de nil (True) ou égal à nil (False). Or la destruction d'un objet (au sens d'instance de classe) ne réinitialise pas la référence à cette instance !

Si vous pensez réutiliser une variable référençant une instance de classe libérée, en lieu et place de Free, utilisez la procédure FreeAndNil définie dans SysUtils qui à la fois libère l'instance comme Free, mais aussi place la valeur nil dans le pointeur sur cette instance.

[Exemple PO-09]

La petite application suivante rend manifeste la différence entre les deux approches :

• créez une nouvelle application que vous baptiserez freeandnil ;
• sur la fiche principale renommée MainForm, déposez un TButton renommé btnGo et un TMemo renommé mmoMain ;
• renseignez comme indiqué ci-après le gestionnaire d'événement OnClick de btnGo :

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  animal;

type

  { TMainForm }

  TMainForm = class(TForm)
    btnGo: TButton;
    mmoMain: TMemo;
    procedure btnGoClick(Sender: TObject);
  private
    { private declarations }
    MyAnimal: TAnimal;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses
  strutils;

{$R *.lfm}

{ TMainForm }

procedure TMainForm.btnGoClick(Sender: TObject);
begin
  MyAnimal := TAnimal.Create;
  MyAnimal.Free;
  mmoMain.Lines.Add('MyAnimal est assigné : ' + ifthen(Assigned(MyAnimal), 'VRAI', 'FAUX'));
  MyAnimal := TAnimal.Create;
  FreeAndNil(MyAnimal);
  mmoMain.Lines.Add('MyAnimal est assigné : '  + ifthen(Assigned(MyAnimal), 'VRAI', 'FAUX'));;
end;

end.

Lors de l'exécution, après un clic sur le bouton, les résultats des deux tests effectués avec Assigned sont sans équivoque : comme annoncé, la destruction d'une instance de classe ne libère pas la référence à cette instance ! Seule la procédure FreeAndNil garantit que cette référence sera bien mise à nil.

Un dernier problème assez délicat à propos des constructeurs et des destructeurs concerne leur éventuelle surcharge. Dans le cas de Create, les cas à étudier sont relativement nombreux et demandent un brin de rigueur ; pour Destroy, les choses sont heureusement plus simples.

II-E-1. Constructeur Create descendant de TObject▲

 TObject = class
 public
   [...]
   constructor Create;
   [...]
   destructor Destroy;virtual; 
   [...]
 end ;

 […]

  constructor TObject.Create;
  begin
  end;

  destructor TObject.Destroy;
  begin
  end;
[…]

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TMySuperClass }

  TMySuperClass = class
  strict private
    fMyProp: string;
    procedure SetMyProp(const AValue: string);
  public
    constructor Create; virtual;
    property MyProp: string read fMyProp write SetMyProp;
  end;

  { TMyChildClass }

  TMyChildClass = class(TMySuperClass)
    constructor Create(const ASt: string); reintroduce;
  end;

  { TMainForm }

  TMainForm = class(TForm)
    btnGo: TButton;
    mmoMain: TMemo;
    procedure btnGoClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.btnGoClick(Sender: TObject);
var
  LMySuperObject: TMySuperClass;
  LMyChildObject: TMyChildClass;
begin
  LMySuperObject := TMySuperClass.Create;
  try
    mmoMain.Lines.Add(LMySuperObject.MyProp);
  finally
    LMySuperObject.Free;
  end;
  // LMyChildObject := TMyChildClass.Create; // ne compile pas !
  LMyChildObject := TMyChildClass.Create('ChildClass');
  try
    mmoMain.Lines.Add(LMyChildObject.MyProp);
  finally
    LMyChildObject.Free;
  end;
end;

{ TMyChildClass }

constructor TMyChildClass.Create(const ASt: string);
begin
  MyProp := ASt;
end;

{ TMySuperClass }

procedure TMySuperClass.SetMyProp(const AValue: string);
begin
  if fMyProp = AValue then
    Exit;
  fMyProp := AValue;
end;

constructor TMySuperClass.Create;
begin
  MyProp := 'SuperClass';
end;

end.

II-E-2. Constructeur statique créé de toutes pièces▲

II-E-3. Constructeur d'emblée virtuel▲

II-E-4. Destructeur Destroy▲

Avec Destroy, static ou reintroduce ne sont pas autorisés. Bien sûr, comme votre destructeur est toujours virtuel, vous ne pouvez le déclarer virtual une nouvelle fois. En revanche, override sera bien accepté et même indispensable si vous avez du ménage à faire avant la libération de votre objet. Enfin, l'appel à l'ancêtre par inherited est essentiel, sauf si votre classe descend directement de TObject puisque l'implémentation de son destructeur est aussi vide que celle de son constructeur.

[Exemple PO-11]

L'exemple proposé met en œuvre des techniques très courantes dans les applications qui manipulent des classes et des objets. Il s'appuie sur l'exemple précédent en éliminant dans la classe TMySuperClass la propriété MyProp qui manipulait un simple champ interne pour la remplacer par une propriété MyLazyProp un peu plus complexe, car elle exige l'emploi d'une instance d'une classe TMyDummyClass. Il faut par conséquent l'instancier dans Create et la libérer dans Destroy. De même, TMyChildClass a gagné une propriété MySpeedyProp qui renvoie à l'instance d'une autre classe nommée TMySpeedyClass. L'instanciation de cette dernière et la libération de l'objet créé sont encore de la responsabilité du programme à travers Create et Destroy.

L'important ici est de bien comprendre que le destructeur Destroy doit faire appel à inherited, un oubli conduisant à des fuites de mémoire : en particulier, l'instance de TMyDummyClass ne serait jamais libérée.

Voici le listing du code employé :

 

Sélectionnez

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TMyDummyClass }

  TMyDummyClass = class
  public
    constructor Create;
    destructor Destroy; override;
    function LazyFunc: string;
  end;

  { TMySecondDummyClass }

  TMySecondDummyClass = class
  public
    constructor Create;
    destructor Destroy; override;
    function SpeedyFunc: string;
  end;

  { TMySuperClass }

  TMySuperClass = class
  strict private
    fMyDummyObject: TMyDummyClass;
    function GetMyLazyProp: string;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    property MyLazyProp: string read GetMyLazyProp;
  end;

  { TMyChildClass }

  TMyChildClass = class(TMySuperClass)
  strict private
    fMySecondDummyObject: TMySecondDummyClass;
    function GetMySpeedyProp: string;
  public
    constructor Create; override;
    destructor Destroy; override;
    property MySpeedyProp: string read GetMySpeedyProp;
  end;

  { TMainForm }

  TMainForm = class(TForm)
    btnGo: TButton;
    mmoMain: TMemo;
    procedure btnGoClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMySecondDummyClass }

constructor TMySecondDummyClass.Create;
begin
  inherited Create;
  MainForm.mmoMain.Lines.Add('TMySecondDummyClass => Create');
end;

destructor TMySecondDummyClass.Destroy;
begin
  MainForm.mmoMain.Lines.Add('TMySecondDummyClass => Destroy');
  inherited Destroy;
end;

function TMySecondDummyClass.SpeedyFunc: string;
begin
  Result := 'Je suis très pressé !';
end;


{ TMyDummyClass }

constructor TMyDummyClass.Create;
begin
  inherited Create;
  MainForm.mmoMain.Lines.Add('TMyDummyClass => Create');
end;

destructor TMyDummyClass.Destroy;
begin
  MainForm.mmoMain.Lines.Add('TMyDummyClass => Destroy');
  inherited Destroy;
end;

function TMyDummyClass.LazyFunc: string;
begin
  Result := 'Je ne fais rien !';
end;

{ TMainForm }

procedure TMainForm.btnGoClick(Sender: TObject);
var
  LMySuperObject: TMySuperClass;
  LMyChildObject: TMyChildClass;
begin
  mmoMain.Lines.Add('Utilisation de TMySuperClass');
  LMySuperObject := TMySuperClass.Create;
  try
    mmoMain.Lines.Add(LMySuperObject.MyLazyProp);
  finally
    LMySuperObject.Free;
  end;
  mmoMain.Lines.Add('');
  mmoMain.Lines.Add('Utilisation de TMyChildClass');
  LMyChildObject := TMyChildClass.Create;
  try
    mmoMain.Lines.Add(LMyChildObject.MySpeedyProp);
  finally
    LMyChildObject.Free;
  end;
end;

{ TMyChildClass }

function TMyChildClass.GetMySpeedyProp: string;
begin
  Result := fMySecondDummyObject.SpeedyFunc;
end;

constructor TMyChildClass.Create;
begin
  inherited Create;
  MainForm.mmoMain.Lines.Add('TMyChildClass => Create');
  fMySecondDummyObject := TMySecondDummyClass.Create;
end;

destructor TMyChildClass.Destroy;
begin
  fMySecondDummyObject.Free;
  MainForm.mmoMain.Lines.Add('TMyChildClass => Destroy');
  inherited Destroy;
end;

{ TMySuperClass }

function TMySuperClass.GetMyLazyProp: string;
begin
  Result := fMyDummyObject.LazyFunc;
end;

constructor TMySuperClass.Create;
begin
  inherited Create;
  MainForm.mmoMain.Lines.Add('TMySuperClass => Create');
  fMyDummyObject := TMyDummyClass.Create;
end;

destructor TMySuperClass.Destroy;
begin
  fMyDummyObject.Free;
  MainForm.mmoMain.Lines.Add('TMySuperClass => Destroy');
  inherited Destroy;
end;

end.

L'exécution de ce programme permet de suivre les appels à Create et à Destroy des classes mises en œuvre.

Voici ce que donne une capture d'écran de cette exécution :

Chaque instanciation est bien accompagnée d'une libération : négliger ces correspondances binaires conduira nécessairement à des erreurs de compilation, d'éventuelles violations d'accès à la mémoire ou des fuites de cette même mémoire !