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

Il peut être intéressant, dans une classe qui servira de moule à d’autres classes plus spécialisées, de déclarer une méthode indispensable, mais sans savoir à ce stade comment l’implémenter. Plutôt que de fournir une méthode vide, ce qui n’imposerait pas de redéfinition et risquerait de déstabiliser l’utilisateur face à un code exécutable, mais qui ne produirait aucun effet, vous préférerez sans doute déclarer cette méthode avec la directive abstract : une méthode abstraite est justement un squelette déclaré dans une classe, mais non implémenté. Ce sont les descendants de la classe où la déclaration a eu lieu qui auront à proposer l'implémentation au moment voulu.

Vous pouvez par exemple définir une classe TEtreVivant, ancêtre de TAnimal, qui sera à l'origine d'une classe sœur de cette dernière, nommée TVegetal.

Cette classe ancêtre sera utilisable pour générer les différentes sous-classes attachées aux méthodes abstraites définies. Ignorant tout du comportement de ses descendants, TEtreVivant déclarera les méthodes Boire et Manger avec abstract que ses enfants TAnimal et TVegetal implémenteront s'ils veulent les invoquer.

La principale difficulté avec les méthodes abstraites est d'éviter leur invocation directe ou indirecte. En cas d'instanciation des classes qui leur servent de support, ce qui est en général à proscrire, il est en effet impossible de faire appel à ces méthodes abstraites sans déclencher une erreur d'exécution, quand bien même la compilation n'aura donné lieu qu'à des messages d'avertissement.

[Exemple PO-12]

Afin de vérifier ces affirmations, vous allez créer un nouveau projet baptisé testabstract.

L'interface de l'unité abstractanimal nécessaire à ce projet rudimentaire pourra ressembler à ceci :

unit abstractanimal;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type

{ TEtreVivant }

  TEtreVivant = class
  public
    procedure Boire; virtual; abstract; // à définir par les descendants
    procedure Manger; virtual; abstract; // à définir par les descendants
  end;

  { TVegetal }

  TVegetal = class(TEtreVivant)
  strict private
    fPeutFleurir: Boolean;
  public
    procedure Boire; override; // OK pour abstract
    procedure Manger; override;  // OK pour abstract
  published
    property PeutFleurir: Boolean read fPeutFleurir write fPeutFleurir;
  end;

  { TAnimal }

  TAnimal = class(TEtreVivant)
  strict  private
    fASoif: Boolean;
    fAFaim: Boolean;
  public
    procedure Avancer;
    procedure Manger; override; // OK pour abstract
    procedure Boire; override;  // OK pour abstract
  published
    property ASoif: Boolean read fASoif write fASoif;
    property AFaim: Boolean read fAFaim write fAFaim;
  end;

Les méthodes abstraites déclarées dans TEtreVivant seront définies par les classes descendantes, à savoir TAnimal et TVegetal. C'est ce que montre la partie implémentation de la même unité :

implementation

uses
  Dialogs;

{ TAnimal }

procedure TAnimal.Avancer;
begin
  MessageDlg('', 'TAnimal.Avancer', mtInformation, [MbOk], 0);
end;

procedure TAnimal.Manger;
begin
  MessageDlg('', 'TAnimal.Manger', mtInformation, [MbOk], 0);
end;

procedure TAnimal.Boire;
begin
  MessageDlg('', 'TAnimal.Boire', mtInformation, [MbOk], 0);
end;

{ TVegetal }

procedure TVegetal.Boire;
begin
  MessageDlg('', 'TVegetal.Boire', mtInformation, [MbOk], 0);
end;

procedure TVegetal.Manger;
begin
  MessageDlg('', 'TVegetal.Manger', mtInformation, [MbOk], 0);
end;

end.

Des méthodes et propriétés sans rapport avec l'abstraction ont été ajoutées afin de montrer que les classes enfants sont libres de définir ce qu'elles souhaitent en addition aux méthodes abstraites.

La fiche principale de l'application ne comprend que huit TButton destinés à vérifier l'exécution des méthodes ou la valeur des propriétés des objets fEtreVivant, fVegetal et fAnimal.

Voici comment se présente l'interface de cette application :

Voici à présent le contenu de l'unité de la fiche principale :

unit main;

{$mode objfpc}{$H+}

interface

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

type

  { TMainForm }

  TMainForm = class(TForm)
    btnAliveDrink: TButton;
    btnAliveEat: TButton;
    btnVegDrink: TButton;
    btnVegEat: TButton;
    btnVegCanFlower: TButton;
    btnAnimalDrink: TButton;
    btnAnimalEat: TButton;
    btnAnimalMove: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure btnAliveDrinkClick(Sender: TObject);
    procedure btnAliveEatClick(Sender: TObject);
    procedure btnAnimalDrinkClick(Sender: TObject);
    procedure btnAnimalEatClick(Sender: TObject);
    procedure btnVegCanFlowerClick(Sender: TObject);
    procedure btnVegDrinkClick(Sender: TObject);
    procedure btnVegEatClick(Sender: TObject);
    procedure btnAnimalMoveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
    fEtreVivant: TEtreVivant;
    fAnimal: TAnimal;
    fVegetal: TVegetal;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

uses
  strutils;

{ TMainForm }


procedure TMainForm.FormCreate(Sender: TObject);
begin
  fEtreVivant := TEtreVivant.Create; // déconseillé !
  fAnimal := TAnimal.Create;
  fVegetal := TVegetal.Create;
end;

procedure TMainForm.btnAliveDrinkClick(Sender: TObject);
begin
  fEtreVivant.Boire;
end;

procedure TMainForm.btnAliveEatClick(Sender: TObject);
begin
  fEtreVivant.Manger;
end;

procedure TMainForm.btnAnimalDrinkClick(Sender: TObject);
begin
  fAnimal.Boire;
end;

procedure TMainForm.btnAnimalEatClick(Sender: TObject);
begin
  fAnimal.Manger;
end;

procedure TMainForm.btnVegCanFlowerClick(Sender: TObject);
begin
  fVegetal.PeutFleurir := not fVegetal.PeutFleurir;
  MessageDlg('', Format('TVegetal peut fleurir : %s',
    [ifthen(fVegetal.PeutFleurir, 'VRAI', 'FAUX')]), mtInformation, [mbOK], 0);
end;

procedure TMainForm.btnVegDrinkClick(Sender: TObject);
begin
  fVegetal.Boire;
end;

procedure TMainForm.btnVegEatClick(Sender: TObject);
begin
  fVegetal.Manger;
end;

procedure TMainForm.btnAnimalMoveClick(Sender: TObject);
begin
  fAnimal.Avancer;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  fEtreVivant.Free;
  fAnimal.Free;
  fVegetal.Free;
end;

end.

En réalité, derrière l'apparente simplicité du code proposé, vous aurez pressenti dès la compilation que des problèmes sont latents : deux avertissements vous auront en effet signalé que la classe TEtreVivant a été instanciée et qu'elle contient des méthodes abstraites. Ces avertissements sont les signes de probables erreurs !

Pour le reste, les descendants de TEtreVivant remplissent leur mission, non seulement en termes de fonctionnalités, mais aussi en implémentant les méthodes abstraites correctement.

L'intérêt profond de la directive abstract est d'unifier les déclarations et le comportement des classes tout en bénéficiant totalement du polymorphisme si nécessaire. Pour vous en convaincre, vous allez examiner la classe TStrings de la RTL de Free Pascal, chargée de gérer à son niveau fondamental une liste de chaînes. Ce sont en fait ses descendants comme TStringList, une des classes les plus utilisées de la RTL, qui implémenteront les méthodes à même de traiter réellement les chaînes manipulées.

Voici un court extrait de son interface :

protected
  procedure DefineProperties(Filer: TFiler); override;
  procedure Error(const Msg: string; Data: Integer);
  // […]
  function Get(Index: Integer): string; virtual; abstract; // attention : deux qualifiants
  function GetCapacity: Integer; virtual;
  function GetCount: Integer; virtual; abstract; // idem

Vous y reconnaissez une méthode statique (Error), une méthode virtuelle redéfinie (DefineProperties) et une méthode virtuelle simple (GetCapacity). Nouveauté : les méthodes Get et GetCount sont marquées par la directive abstract qui indique que TStrings ne propose pas d’implémentations pour ces méthodes parce qu’elles n’auraient aucun sens à son niveau.

Les descendants de TStrings procéderont à cette implémentation tandis que TStrings, en tant qu’ancêtre, sera d’une grande polyvalence. En effet, bien que vous ne puissiez jamais travailler avec cette seule classe puisqu’un objet de ce type déclencherait des erreurs à chaque tentative (même interne) d’utilisation d’une des méthodes abstraites, l’utiliser comme paramètre permettra à n’importe quel descendant de prendre sa forme.

Comparez :

procedure Afficher(Sts: TStringList);
var
  LItem: string; // variable locale pour récupérer les chaînes une à une
begin
  for LItem in Sts do // on balaie la liste
    writeln(LItem); // et on affiche l’élément en cours
end;

Et :

procedure Afficher(Sts: TStrings); // <= seul changement
var
  LItem: string;
begin
  for LItem in Sts do
    writeln(LItem);
end;

La première procédure affichera n’importe quelle liste de chaînes provenant d’un objet de type TStringList. La seconde acceptera tous les descendants de TStrings, y compris TStringList, se montrant par conséquent bien plus polyvalente. En voulez-vous une preuve ? TMemo publie une propriété Lines de type TStrings qui conviendra très bien pour notre second modèle de procédure alors qu'elle déclenchera une erreur « types incompatibles » avec la première mouture !

Au passage, vous aurez une nouvelle fois constaté la puissance du polymorphisme : bien qu’en partie abstraite, TStrings sera indispensable en certaines circonstances puisqu’une classe qui descendra d’elle prendra sa forme en comblant ses lacunes !

Free Pascal offre aussi la possibilité de définir des méthodes de classe. Avec elles, vous ne vous intéresserez plus à la préparation de l’instanciation, mais à la manipulation directe de la classe. Dans d’autres domaines, on parlerait de métadonnées. Il est par conséquent inutile d’instancier une classe pour accéder à ces méthodes particulières, même si cela reste possible.

[Exemple PO-13]

La déclaration d’une méthode de classe se fait en plaçant le mot-clé class avant de préciser s’il s’agit d’une procédure ou d’une fonction. Par exemple, vous pourriez décider de déclarer une fonction qui renverrait le copyright associé à votre programme inoubliable sur les animaux :

• rouvrez l’unité animal à partir du dossier PO_08 (première partie du tutoriel) et modifiez ainsi la déclaration de la classe TAnimal :

{ TAnimal }

  TAnimal = class
  private
    fNom: string;
    fASoif: Boolean;
    fAFaim: Boolean;
    procedure SetNom(const AValue: string);
  public
    procedure Avancer;
    procedure Manger; virtual;
    procedure Aboyer; virtual;
    procedure RemuerLaQueue; virtual;
    procedure Boire;
    procedure Dormir;
    class function Copyright: string; // <= modification !

• pressez Ctrl-Maj-C pour créer le squelette de la nouvelle fonction que vous compléterez ainsi :

class function TAnimal.Copyright: string;
begin
  Result := 'www.developpez.com 2016';
end;

• dans l’unité main, complétez le gestionnaire de création de la fiche OnCreate :

procedure TMainForm.FormCreate(Sender: TObject);
// *** création de la fiche ***
begin
  // on crée les instances et on donne un nom à l'animal créé
  Nemo := TAnimal.Create;
  Nemo.Nom := 'Némo';
  Rantanplan := TChien.Create;
  Rantanplan.Nom := 'Rantanplan';
  Minette := TAnimal.Create;
  Minette.Nom := 'Minette';
  MainForm.Caption := MainForm.Caption + ' - ' + TAnimal.Copyright; // <= nouveau !
  // objet par défaut
  UnAnimal := Nemo;
end;

En exécutant le programme, vous obtiendrez un nouveau titre pour votre fiche principale, agrégeant l’ancienne dénomination et le résultat de la fonction Copyright.

Bien sûr, vous auriez pu vous servir d’un descendant de TAnimal : TChien ferait aussi bien l’affaire puisque cette classe aura hérité de Copyright grâce à son ancêtre. De même, vous auriez tout aussi bien pu vous servir d’une instance d’une de ces classes : Rantaplan, Nemo ou Minette. Les méthodes de classe obéissent en effet aux mêmes règles de portée et d’héritage que les méthodes ordinaires. En particulier, elles peuvent être virtuelles.

Leurs limites découlent de leur définition même : comme elles sont indépendantes de l’instanciation, elles ne peuvent pas avoir accès aux champs, propriétés et méthodes ordinaires de la classe à laquelle elles appartiennent. De plus, depuis une méthode de classe, Self pointe non pas vers l’instance de la classe, mais vers la table des méthodes virtuelles (VMT) qu’il est alors possible d’examiner.

En revanche, les méthodes de classe ont accès aux champs de classe, propriétés de classe et autres méthodes de classe. Comme les autres membres d’une classe indépendants de l’instanciation, la déclaration de ces membres d'une classe commence toujours par le mot class. Par exemple, une variable de classe sera déclarée ainsi :

class var MyVar: Integer;

[Exemple PO-14]

Afin de tester des applications possibles des méthodes de classe, reprenez le projet en cours :

• ajoutez un bouton à la fiche principale, renommez-le btnInfosTAnimal et changez sa légende en « TAnimal » ;

  

• créez un gestionnaire OnClick pour ce bouton et complétez-le ainsi :

procedure TMainForm.btnInfosTAnimalClick(Sender: TObject);
begin
  MessageDlg('Nom de la classe : ' + TAnimal.ClassName +
    #13#10'Taille d''un objet de cette classe : ' + IntToStr(TAnimal.InstanceSize) +
    #13#10'Copyright : ' + TAnimal.Copyright
     , mtInformation, [mbOK], 0);
end;

En cliquant à l’exécution sur le bouton, vous afficherez ainsi le nom de la classe, la taille en octets d’un objet de cette classe et le copyright que vous avez défini précédemment :

Mais où les méthodes de classe ClassName et IntanceSize ont-elles été déclarées ? Aucun miracle : elles proviennent de l’ancêtre TObject qui les définit par conséquent pour toutes les classes. Vous pourrez donc vous amuser à remplacer TAnimal par n’importe quelle autre classe accessible depuis votre code : TChien, bien sûr, mais aussi TForm, TButton, TListBox… C’est ainsi que vous verrez qu’un objet de type TChien occupe 16 octets en mémoire alors qu’un objet de type TForm en occupe 1124 !

Une application immédiate de ces méthodes de classe résidera dans l’observation de la généalogie des classes. Pour cela, vous utiliserez une méthode de classe nommée ClassParent qui fournit un pointeur vers la classe parente de la classe actuelle. Cette méthode de classe est elle aussi définie par TObject. Vous remonterez dans les générations jusqu’à ce que ce pointeur soit à nil, c’est-à-dire jusqu’à ce qu’il ne pointe sur rien.

[Exemple PO-15]

En utilisant pour l’affichage un composant TMemo nommé mmoDisplay, la méthode d’exploration ressemblera à ceci :

procedure TMainForm.Display(AClass: TClass);
begin
  repeat
    mmoDisplay.Lines.Add(AClass.ClassName);
    AClass := AClass.ClassParent;
  until AClass = nil;
  mmoDisplay.Lines.Add('');
end;

Le mécanisme de cette méthode est simple : on affiche le nom de la classe en cours avant d'affecter la classe parent au paramètre et de boucler tant que cette classe existe, c’est-à-dire n’est pas égale à nil.

Voici un affichage obtenu par ce programme :

Vous constaterez que la classe TForm est à une profondeur de neuf héritages de TObject alors que la classe TChien est au second niveau (ce qui correspond aux définitions utilisées dans l’unité animal). Comme affirmé plus haut, toutes ces classes proviennent ab initio de TObject.

Voici le listing complet de cet exemple :

unit main;

{$mode objfpc}{$H+}

interface

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

type

  { TMainForm }

  TMainForm = class(TForm)
    btnForm: TButton; // boutons pour les tests
    btnClear: TButton;
    btnMemo: TButton;
    btnButton: TButton;
    btnFontDialog: TButton;
    btnChien: TButton;
    mmoDisplay: TMemo; // mémo pour l’affichage
    procedure btnButtonClick(Sender: TObject);
    procedure btnChienClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnFontDialogClick(Sender: TObject);
    procedure btnFormClick(Sender: TObject);
    procedure btnMemoClick(Sender: TObject);
  private
    { private declarations }
    procedure Display(AClass: TClass); // affichage
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

uses
  animal; // unité pour le traitement des animaux

{ TMainForm }

procedure TMainForm.btnFormClick(Sender: TObject);
// *** généalogie de TForm ***
begin
  Display(TForm);
end;

procedure TMainForm.btnMemoClick(Sender: TObject);
// *** généalogie de TMemo ***
begin
  Display(TMemo);
end;

procedure TMainForm.btnClearClick(Sender: TObject);
// *** effacement du mémo ***
begin
  mmoDisplay.Lines.Clear;
end;

procedure TMainForm.btnFontDialogClick(Sender: TObject);
// *** généalogie de TFontDialog ***
begin
  Display(TFontDialog);
end;

procedure TMainForm.btnButtonClick(Sender: TObject);
// *** généalogie de TButton ***
begin
  Display(TButton);
end;

procedure TMainForm.btnChienClick(Sender: TObject);
// *** généalogie de TChien ***
begin
  Display(TChien);
end;

procedure TMainForm.Display(AClass: TClass);
// *** reconstitution de la généalogie ***
begin
  repeat
    mmoDisplay.Lines.Add(AClass.ClassName); // classe en cours
    AClass := AClass.ClassParent; // on change de classe pour la classe parent
  until AClass = nil; // on boucle tant que la classe existe
  mmoDisplay.Lines.Add(''); // ligne vide pour séparation
end;

end.

En ajoutant la directive static à la fin de la déclaration d’une méthode de classe, vous obtenez une méthode statique de classe. Si le mot réservé class doit être présent à la fois lors de sa déclaration et au moment de sa définition, contrairement à sa consœur, la méthode statique de classe ne connaît ni le paramètre Self ni la virtualité. En fait, une méthode de ce type se comporte en tout point comme procédure ou fonction ordinaires.

Les méthodes statiques de classe n’ont pas d’accès aux membres d’une instance : par exemple, si vous tentez à partir d’elles de faire appel à une méthode ordinaire ou d’accéder à un champ ordinaire, le compilateur déclenchera une erreur. En revanche, comme pour les méthodes de classe ordinaires, vous pouvez déclarer des variables de classe, des propriétés de classe et des méthodes statiques de classe qui seront manipulables à volonté entre elles.

L'utilisation d'une méthode statique de classe au lieu d'une routine globale permet de la nommer avec le préfixe de la classe et non celui de l’unité où elle a été définie : c'est là son principal usage. Grâce à ce changement d'espace de nommage, la lisibilité du code en est meilleure et les conflits de noms en sont d'autant limités.

III-A. Méthodes statiques de classe et propriétés de classe▲

unit main;

{$mode objfpc}{$H+}

interface

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

type

 { TMyClass }

  TMyClass = class
    private
      class var fMyValue: string;
    protected
      class procedure SetMyValue(const AValue: string); static;
      class function GetMyValue: string; static;
    public
      class property MyValue: string read GetMyValue write SetMyValue;
  end;

  { TMainForm }

  TMainForm = class(TForm)
    btnClear: TButton;
    btnOK: TButton;
    edtSetVar: TEdit; // entrée de la valeur
    mmoDisplay: TMemo; // affichage de la valeur
    procedure btnClearClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure edtSetVarExit(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.btnClearClick(Sender: TObject);
// *** nettoyage de la zone d'affichage ***
begin
  mmoDisplay.Lines.Clear;
end;

procedure TMainForm.btnOKClick(Sender: TObject);
// *** affichage de la valeur ***
begin
  mmoDisplay.Lines.Add(TMyClass.MyValue); // affichage de la nouvelle valeur

end;

procedure TMainForm.edtSetVarExit(Sender: TObject);
// *** nouvelle valeur ***
begin
  TMyClass.MyValue := edtSetVar.Text; // on affecte à la variable de classe
end;


{ TMyClass }

class procedure TMyClass.SetMyValue(const AValue: string);
// *** la valeur est mise à jour ***
begin
  fMyValue := Upcase(AValue); // en majuscules
end;

class function TMyClass.GetMyValue: string;
// *** récupération de la valeur ***
begin
  Result := fMyValue;
end;

end.

III-B. Méthodes statiques de classe et types procéduraux▲

type
  TMyFunct = function(const St: string): string;
  TMyProc = procedure(X, Y: Integer);

var
  MyFunct: TMyFunct;
  MyProc: TMyProc;

 function MySpecialFunct(F: TMyFunct): Integer;

TMyFunct = function(): string; // déclaration du type procédural

private
    { private declarations }
    procedure ProcGetMyValue(AFunct: TMyFunct); // méthode utilisant le type procédural

procedure TMainForm.ProcGetMyValue(AFunct: TMyFunct);
// *** avec variable procédurale ***
begin
  mmoDisplay.Lines.Add(AFunct()); // notez les () pour le paramètre absent - non obligatoires
end;

procedure TMainForm.btnOKClick(Sender: TObject);
// *** affichage de la valeur ***
begin
  ProcGetMyValue(TMyClass.GetMyValue); // affichage de la nouvelle valeur
end;

Vous pouvez encore créer des constructeurs et des destructeurs de classe. Cette possibilité est utile si vous avez besoin d’initialiser des variables de classe avant même d’utiliser votre classe, donc sans l'avoir instanciée.

Des restrictions s’appliquent à l'utilisation des constructeurs et destructeurs de classe : ils doivent impérativement s’appeler Create et Destroy, ne pas être déclarés virtuels et ne pas comporter de paramètres.

Leur comportement est aussi atypique :

• le constructeur est appelé automatiquement au lancement de l’application avant même l’exécution de la section initialization de l’unité dans laquelle il a été déclaré ;
• le destructeur est lui aussi appelé automatiquement, mais après l’exécution de la section finalization de la même unité ;
• une conséquence importante de ces particularités est que les deux vont être appelés même si la classe n’est jamais utilisée dans l’application ;
• une autre conséquence est que vous ne les invoquerez jamais explicitement.

[Exemple PO-18]

En guise d’exemple, une petite application permet de récupérer et d’afficher le résultat d’une méthode ordinaire d’une classe sans avoir apparemment à instancier cette dernière. En fait, c’est le constructeur de classe qui se charge de l’instanciation avant même que le code d’initialisation de l’unité n’ait été exécuté :

unit main;

{$mode objfpc}{$H+}

interface

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

type

  { TMyClass }

  TMyClass = class // classe de test
  private
    class var fClass: TMyClass;
    class constructor Create;
    class destructor Destroy;
  public
    function MyFunct: string; // méthode ordinaire
    class property Access: TMyClass read fClass; // accès au champ de classe
  end;

  { TMainForm }

  TMainForm = class(TForm)
    btnGO: TButton;
    procedure btnGOClick(Sender: TObject); // test en cours d’exécution
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMyClass }

class constructor TMyClass.Create;
// *** constructeur de classe ***
begin
  fClass := TMyClass.Create; // on crée la classe
  MessageDlg('Class constructor', mtInformation, [mbOK], 0);
end;

class destructor TMyClass.Destroy;
// *** destructeur de classe ***
begin
  fClass.Free; // on libère la classe
  MessageDlg('Class destructor', mtInformation, [mbOK], 0);
end;

function TMyClass.MyFunct: string;
// *** fonction de test ***
begin
  Result := 'C''est fait !';
end;

{ TMainForm }

procedure TMainForm.btnGOClick(Sender: TObject);
// *** appel direct de la classe ***
begin
  btnGO.Caption := TMyClass.Access.MyFunct;
end;

initialization
  MessageDlg('Initialization : ' + TMyClass.Access.MyFunct, mtInformation, [mbOK], 0);
finalization
  MessageDlg('Finalization', mtInformation, [mbOK], 0);
end.

Afin de bien montrer l’ordre d’appel, des fonctions MessageDlg ont été incorporées aux méthodes. Vous constaterez que les appels du constructeur et du destructeur de classe encadrent bien ceux des sections initialization et finalization.

Le mécanisme de l’ensemble est celui-ci :

• le constructeur de classe Create est appelé automatiquement : il est chargé de créer une instance de la classe qui est assignée à la variable de classe fClass et d’afficher le message spécifiant qu’il a été exécuté ;
• le code de la section initialization est appelé : un message adapté est affiché ;
• un éventuel clic sur le bouton btnGo affecte le résultat de la méthode MyFunct à sa propriété Caption : ce résultat est récupéré par la propriété de classe Access via la classe TMyClass (et non une instance de cette classe) ;
• le code de la section finalization est appelé : un message adapté est affiché ;
• le destructeur de classe Destroy est appelé : il libère l’instance de classe et affiche son propre message.

Un autre type de méthode mérite d’être signalé pour son importance dans le traitement au plus près des systèmes d’exploitation (routines callback en particulier) avec une économie de moyens remarquable : les méthodes de messages.

Comme leur nom l'indique, leur mission est de s'occuper des messages dont la génération et la distribution s’organisent selon le schéma général suivant :

• un événement survient dans le système : un clic de la souris, une touche du clavier pressée, un élément de l’interface modifié, etc. ;
• le système d’exploitation génère le message correspondant qui est placé dans la file d’attente de l’application concernée ;
• l’application récupère le message depuis la file à partir d’une boucle pour le transmettre à l’élément concerné ;
• l’élément concerné réagit en fonction du message.

S’il est possible de gérer les messages du système d'exploitation (c’est ce que fait sans cesse Free Pascal avec ses bibliothèques), vous serez ci-après invité à générer vos propres messages.

Sans que vous ayez à le préciser, les méthodes de messages sont toujours virtuelles. Leur déclaration se clôt par la directive message, elle-même suivie d’un entier ou d’une chaîne courte de caractères :

procedure Changed(var Msg: TLMessage); message M_CHANGEDMESSAGE;
procedure AClick(var Msg); message 'nClick';

Dans l’extrait de code précédent, Msg est soit une variable sans type soit du type TLMessage de l’unité LMessages. De son côté, M_CHANGEDMESSAGE est une constante définie par l’utilisateur à partir de la constante LM_User de la même unité LMessages :

const
  M_CHANGEDMESSAGE = LM_User + 1; // message de changement

L’implémentation d’une méthode de message ne diffère en rien d’une méthode ordinaire si ce n’est qu’elle ne sera jamais appelée directement, mais via une méthode de répartition : Dispatch pour un message de type entier et DispatchStr pour un message de type chaîne. C’est cette méthode de répartition qui émet le message et attend son traitement. Si le message n’est pas traité, il parvient en bout de course à la méthode DefaultHandler (ou DefaultHandlerStr pour une chaîne) de TObject : cette méthode ne fait rien, mais elle peut être redéfinie puisque déclarée avec virtual.

[Exemple PO-19]

Afin que tout cela s’éclaircisse, vous allez créer une nouvelle application dont les objectifs vont être de récupérer les messages émis par des changements intervenus dans un éditeur TEdit et de signaler l’absence de méthode traitant le message M_LOSTMESSAGE généré par un clic sur le TButton :

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  LMessages; // unité pour les messages

const
  M_CHANGEDMESSAGE = LM_User + 1; // message de changement
  M_LOSTMESSAGE = LM_User + 2; // message perdu

type

  { TMainForm }

  TMainForm = class(TForm)
    btnLost: TButton;
    edtDummy: TEdit;
    mmoDisplay: TMemo;
    procedure btnLostClick(Sender: TObject);
    procedure edtDummyChange(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    procedure Changed(var Msg: TLMessage); message M_CHANGEDMESSAGE;
    procedure DefaultHandler(var AMessage); override;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.edtDummyChange(Sender: TObject);
// *** l'éditeur signale un changement ***
var
  Msg: TLMessage;
begin
  Msg.msg := M_CHANGEDMESSAGE; // assignation du message
  Dispatch(Msg); // répartition
  //Perform(M_CHANGEDMESSAGE, 0, 0); // ou envoi sans queue d'attente
end;

procedure TMainForm.btnLostClick(Sender: TObject);
// *** le bouton envoie un message perdu ***
var
  Msg: TLMessage;
begin
  Msg.msg := M_LOSTMESSAGE; // assignation du message
  Dispatch(Msg); // répartition
  //Perform(M_LOSTMESSAGE, 0, 0); // ou envoi sans queue d'attente
end;

procedure TMainForm.Changed(var Msg: TLMessage);
// *** changement récupéré avec numéro du message ***
begin
  mmoDisplay.Lines.Add('Changement ! Message : ' + IntToStr(Msg.msg));
end;

procedure TMainForm.DefaultHandler(var AMessage);
// *** message perdu ? ***
begin
  // transtypage de la variable sans type en TLMessage
  if TLMessage(AMessage).msg = M_LOSTMESSAGE then // perdu ?
    mmoDisplay.Lines.Add('Non Traité ! Message : ' +
       IntToStr(TLMessage(AMessage).msg));
  inherited DefaultHandler(AMessage); // on hérite
end;

end.

Vous aurez remarqué qu'il existe deux manières de notifier le changement :

• soit on affecte le numéro du message à une variable de type Lmessage avant de la fournir en paramètre à Dispatch ;
• soit on utilise directement Perform qui court-circuite la queue d’attente.

Vous avez vu qu’une méthode peut être déclarée de nouveau dans une classe enfant : une méthode statique sera écrasée alors qu’une méthode virtuelle pourra hériter de manière très souple de son ancêtre. Ce qui précède s’applique à des méthodes dont les signatures, c’est-à-dire tous les paramètres et l’éventuelle valeur de retour, sont identiques. Mais que se passe-t-il si l'un au moins de ces éléments est différent ?

Si sa valeur de retour et/ou ses paramètres sont différents de ceux de son ancêtre, la nouvelle méthode coexistera avec la méthode héritée. Vous pourrez par conséquent faire appel aux deux : l’implémentation activée sera celle qui correspondra aux paramètres invoqués.

Pour permettre la surcharge d’une méthode, il suffit d’ajouter la directive overload après sa déclaration. Lors de la surcharge d’une méthode virtuelle, si vous souhaitez une compatibilité avec Delphi, il faut ajouter reintroduce à la fin de la nouvelle déclaration de la méthode, juste avant overload.

[Exemple PO-20]

Afin de tester cette possibilité, vous allez créer un nouveau projet qui effectuera des additions sous différentes formes à partir d’une classe et de son enfant :

type

  { TAddition }

  TAddition = class
    function AddEnChiffres(Nombre1, Nombre2: Integer): string;
    function AddVirtEnChiffres(Nombre1, Nombre2: Integer): string; virtual;
  end;

  { TAdditionPlus }

  TAdditionPlus = class(TAddition)
    function AddEnChiffres(const St1, St2: string): string; overload;
    function AddVirtEnChiffres(const St1, St2: string): string; reintroduce; overload; 
 end;

La classe TAddition permet d’additionner deux entiers à partir de deux méthodes dont l’une est statique et la seconde virtuelle. TAdditionPlus est une classe dérivée de la première qui surcharge les méthodes héritées pour leur faire accepter des chaînes en guise de paramètres.

Leur définition comprend un système de trace grâce à des boîtes de dialogue qui vont s’afficher lorsqu’elles seront invoquées :

{ TAddition }

function TAddition.AddEnChiffres(Nombre1, Nombre2: Integer): string;
// *** addition avec méthode statique ***
begin
  Result := IntToStr(Nombre1 + Nombre2);
  MessageDlg('Entiers...', 'Addition d''entiers effectuée', mtInformation,
    [mbOK], 0);
end;

function TAddition.AddVirtEnChiffres(Nombre1, Nombre2: Integer): string;
// *** addition avec méthode virtuelle ***
begin
  Result := IntToStr(Nombre1 + Nombre2);
  MessageDlg('Entiers (méthode virtuelle)...', 'Addition d''entiers effectuée',
    mtInformation, [mbOK], 0);
end;

{ TAdditionPlus }

function TAdditionPlus.AddEnChiffres(const St1, St2: string): string;
// *** méthode statique surchargée ***
begin
  Result := IntToStr(StrToInt(St1) + StrToInt(St2));
  MessageDlg('Chaînes...', 'Addition à partir de chaînes effectuée',
    mtInformation, [mbOK], 0);
end;

function TadditionPlus.AddVirtEnChiffres(const St1, St2: string): string;
// *** méthode virtuelle surchargée ***
begin
  Result := inherited AddVirtEnChiffres(StrToInt(St1), StrToInt(St2));
  MessageDlg('Chaînes... (méthode virtuelle)',
    'Addition à partir de chaînes effectuée', mtInformation,[mbOK], 0);
end;

Le programme d’exploitation de ces deux classes est évident puisqu’il se contente de proposer deux éditeurs TEdit qui contiendront les nombres à additionner, une étiquette TLabel pour le résultat de l’addition et quatre boutons TButton pour invoquer les quatre méthodes proposées :

Le code source qui l’accompagne ne devrait pas présenter de difficultés particulières :

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
// *** création de la fiche principale ***
begin
  Ad := TAdditionPlus.Create; // additionneur créé
end;

procedure TMainForm.btnComputeStClick(Sender: TObject);
// *** addition simple de chaînes ***
begin
  lblResult.Caption := Ad.AddEnChiffres(edtNum1.Text, edtNum2.Text);
end;

procedure TMainForm.btnComputeStVClick(Sender: TObject);
// *** addition de chaînes par méthode virtuelle ***
begin
  lblResult.Caption := Ad.AddVirtEnChiffres(edtNum1.Text, edtNum2.Text);
end;

procedure TMainForm.btnComputeIntClick(Sender: TObject);
// *** addition simple d'entiers ***
begin
  lblResult.Caption := Ad.AddEnChiffres(StrToInt(edtNum1.Text),
    StrToInt(edtNum2.Text));
end;

procedure TMainForm.btnComputeIntVClick(Sender: TObject);
// *** addition d'entiers par méthode virtuelle ***
begin
  lblResult.Caption := Ad.AddVirtEnChiffres(StrToInt(edtNum1.Text),
    StrToInt(edtNum2.Text));
end;

procedure TMainForm.FormDestroy(Sender: TObject);
// *** destruction de la fiche principale ***
begin
  Ad.Free; // additionneur libéré
end;

[Exemple PO-21]

En fait, rien n'interdit de surcharger les méthodes au sein de la même classe. Pour l'exemple en cours, cela donnerait quelque chose comme :

  { TAddition }

  TAddition = class
    function AddEnChiffres(Nombre1, Nombre2: Integer): string;
    function AddVirtEnChiffres(Nombre1, Nombre2: Integer): string; virtual;
    function AddEnChiffres(const St1, St2: string): string; overload;
    // la méthode est surchargée, mais reste virtuelle
    function AddVirtEnChiffres(const St1, St2: string): string; virtual; overload;
  end;

  { TMainForm }

  TMainForm = class(TForm)
   [...]
  private
    { private declarations }
    Ad: Taddition; // seule classe disponible
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
// *** création de la fiche principale ***
begin
  Ad := TAddition.Create; // additionneur créé
end;

[...]

{ TAddition }

function TAddition.AddEnChiffres(Nombre1, Nombre2: Integer): string;
// *** addition avec méthode statique ***
begin
  Result := IntToStr(Nombre1 + Nombre2);
  MessageDlg('Entiers...', 'Addition d''entiers effectuée', mtInformation,
    [mbOK], 0);
end;

function TAddition.AddVirtEnChiffres(Nombre1, Nombre2: Integer): string;
// *** addition avec méthode virtuelle ***
begin
  Result := IntToStr(Nombre1 + Nombre2);
  MessageDlg('Entiers (méthode virtuelle)...', 'Addition d''entiers effectuée',
    mtInformation, [mbOK], 0);
end;

function TAddition.AddEnChiffres(const St1, St2: string): string;
// *** méthode statique surchargée ***
begin
  Result := IntToStr(StrToInt(St1) + StrToInt(St2));
  MessageDlg('Chaînes...', 'Addition à partir de chaînes effectuée',
    mtInformation, [mbOK], 0);
end;

function TAddition.AddVirtEnChiffres(const St1, St2: string): string;
// *** méthode virtuelle surchargée ***
begin
  Result := AddVirtEnChiffres(StrToInt(St1), StrToInt(St2)); // pas d'héritage ici !
  MessageDlg('Chaînes... (méthode virtuelle)',
    'Addition à partir de chaînes effectuée', mtInformation,[mbOK], 0);
end;

end.

Il est clair que les différences sont minimes et tiennent essentiellement à l'absence d'héritage puisque toutes les méthodes sont définies au sein de la même classe. La véritable difficulté tient aux ambiguïtés possibles des signatures des méthodes que le compilateur ne laissera pas passer.

Par exemple, les méthodes surchargées suivantes provoqueront une erreur :

TAddition = class
    function AddEnChiffres(Nombre1, Nombre2: Integer): string;
    function AddEnChiffres(const Number1, Number2: Integer): string; overload;
end;

Les deux fonctions ont en fait le même en-tête : les noms différents des paramètres ne suffisent pas pour distinguer les méthodes à appeler !

Dans ce tutoriel, vous avez appris à :

• reconnaître et manipuler les méthodes d’une classe sous des formes moins courantes que les méthodes statiques et virtuelles : méthodes abstraites, de classe, statiques de classe et de messages ;
• maîtriser la surcharge des méthodes.

Il ne vous reste guère qu'à étudier les propriétés pour devenir un véritable champion de la POO ! Un peu de pratique sera peut-être nécessaire aussi, n'est-ce pas ?

Je remercie Alcaltîz, Milkoseck, ThWilliam et Roland Chastain pour leur relecture technique, ainsi que Claude Leloup pour les corrections.