Developpez.com

Plus de 14 000 cours et tutoriels en informatique professionnelle à consulter, à télécharger ou à visionner en vidéo.

POO à gogo - Des jeux de dés tout objet avec Free Pascal/Lazarus

Et s'il était temps d'appliquer les principes et techniques de la Programmation Orientée Objet dans des applications plus élaborées que de simples exercices de circonstance ? Révision pour les uns, découverte pour les autres, ce tutoriel devrait vous guider pour concevoir des classes plus sophistiquées et réaliser de véritables applications conçues autour des objets. Au centre de la table de dissection : un dé. Que peut bien vous cacher un objet à première vue si anodin ?

Commentez Donner une note à l'article (5)

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

I. Avant-propos

Pour tirer le meilleur de ce tutoriel, il est indispensable de maîtriser les notions fondamentales abordées dans le tutoriel d'initiation. Il est aussi vivement conseillé de lire les articles sur les méthodes (1 et 2), ainsi que celui sur les propriétés.

Les programmes de test sont présents dans le répertoire exemples accompagnant le présent document.

L'objectif de ce tutoriel est de mettre en œuvre les notions abordées dans la série de tutoriels sur la Programmation Orientée Objet avec Free Pascal et Lazarus déjà publiés sur developpez.com. En dehors de quelques techniques particulières comme les gestionnaires d'événements, les sujets abordés ne seront par conséquent pas nouveaux, mais ils donneront lieu à la réalisation d'applications plus synthétiques et élaborées que les simples exercices proposés jusqu'à présent.

II. Une histoire de dés

La première réalisation concerne un dé. L'idée en est venue grâce à l'excellent jeu de triple Yahztee de Jean-Luc Gofflot : si vous désirez aller plus loin que l'étude qui va suivre, je vous invite fortement à télécharger son code source et à l'étudier !

Plus modestement que ce travail, vous allez dans un premier temps répondre au cahier des charges suivant : réaliser un dé ordinaire à six faces capable de rendre compte de son état à une application qui l'utiliserait.

Partant d'une solution graphique, vous développerez ensuite d'autres classes pour rendre votre travail plus polyvalent et plus puissant jusqu'à la réalisation complète d'un jeu.

II-A. Des dés graphiques

La première idée qui vient à l'esprit pour répondre au problème posé est celle d'un dé tel qu'il est manipulé ordinairement : il faut reproduire sur ordinateur un objet formant un cube dont les faces sont numérotées grâce à des points, la face au sommet du cube fournissant la valeur entière associée au dé.

Si la solution graphique est la première qui vient à l'esprit pour réaliser une simulation de dé, ce n'est pas forcément la seule ni la meilleure. Pour des raisons d'efficacité et de pérennité du travail, il est de plus en plus conseillé en matière informatique de séparer la partie fonctionnelle de celle chargée de l'affichage. Dans le cas présent, la partie fonctionnelle se limite à un tirage qui prend une ligne de code : inutile de se compliquer la vie outre mesure !

Parmi les attributs identifiables, vous relèverez facilement la valeur du dé. L'opération de lancer qui lui est associée vous paraîtra tout aussi indispensable. Vous pourrez aussi penser à ajouter de la couleur pour les points et le fond des faces. Déjà, vous pressentez à juste raison que le graphisme ne sera pas simple à traiter et que prendre pour origine une classe aussi rudimentaire que TObject risque de vous demander beaucoup d'efforts pour peu de résultats !

II-A-1. De l'utilité de l'héritage

Afin de vous sortir d'affaire, vous avez tout intérêt à garder en tête les trois piliers fondamentaux de la POO :

  • l'encapsulation ;
  • l'héritage ;
  • et le polymorphisme.

Ici, il est plus que probable que parmi les centaines de classes que proposent Free Pascal et Lazarus, il doit y en avoir au moins une dont vous hériterez des fonctionnalités avec profit. Votre choix s'orientera vers une classe graphique aussi élaborée que possible, par exemple parmi les composants disponibles sur la palette.

Les composants sont tous des classes descendant d'une classe ancêtre nommée TComponent. À ce titre, ils montrent que nombreux sont ceux qui, à l'instar du bourgeois gentilhomme, font de la POO sans le savoir !

Un excellent postulant sera TPaintBox, car ce composant propose une simple surface à peindre, mais est déjà à même d'interférer avec les autres éléments d'une application.

Votre tâche est à présent plutôt réduite puisque vous devez seulement :

  • manipuler un champ fournissant la valeur prise par le dé ;
  • afficher le dé de telle manière que sa face supérieure corresponde à cette valeur ;
  • éventuellement vous occuper de la gestion des couleurs.

[Exemple PO-28]

En laissant de côté le problème de la couleur abordé plus loin, le squelette de votre classe ressemblera à ceci :

 
Sélectionnez
interface

uses
  Classes, SysUtils, ExtCtrls, Graphics;

type
  TDiceValueRange = 1..6;

  { TDice }

  TDice = class(TPaintBox)
  strict private
    fValue: TDiceValueRange;
    // dessins du 
    fBitmap: array[TDiceValueRange] of Tbitmap;
  protected
     procedure Paint; override; // dessin du 
  public
    procedure Throw; // lancement du 
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    // valeur actuelle du 
    property Value: TDiceValueRange read fValue write fValue default Low(TDiceValueRange);
  end;

Vous reconnaissez la propriété Value qui accède directement au champ fValue. Sa valeur par défaut est fixée à la plus petite valeur de l'intervalle 1...6, à savoir 1 représenté par Low(TDiceValueRange). Comme cette propriété serait éditable si le composant devait être intégré à l'EDI, elle est marquée published.

Pour rappel, une valeur indiquée par défaut doit toujours être effectivement affectée dans le constructeur.

En dehors des sections de constantes, il est préférable de limiter l'emploi des valeurs numériques littérales. En utilisant des expressions de constantes, en cas de changement dans le code, par exemple parce que certains jeux utilisent des dés qui n'ont pas six faces, une unique modification se répercutera sans risque d'erreurs.

Le dé sera dessiné à partir de six images stockées dans le tableau fBitmap de TBitmap. Pour cela, il faut surcharger la méthode Paint héritée de TPaintBox afin de ne pas obtenir un simple carré barré comme celui proposé par défaut.

L'initialisation du tableau d'images passe par la surcharge du constructeur et du destructeur : les images sont en effet elles aussi représentées par des classes à instancier.

Le constructeur d'un composant est particulier : il s'agit de la méthode virtuelle Create à surcharger. Si le composant spécifié en paramètre est différent de nil, il devient le propriétaire du composant instancié et est responsable à ce titre de sa destruction. Autrement dit : si le propriétaire existe, vous n'avez pas à appeler la méthode Free.

Vous vous serez douté que le problème essentiel est lié à l'affichage du dé !

Tout d'abord, les images sont chargées lors de la création du composant à partir d'un fichier de ressources nommé dice.res et fourni avec l'exemple. Le fichier a été obtenu grâce à un utilitaire comme ResourceHacker en compilant six images de type .bmp. Le fichier doit être physiquement présent dans le répertoire du projet à compiler et intégré dans la partie implementation de l'unité des dés sous cette forme :

 
Sélectionnez
implementation

{$R dice.res }

Chaque ressource est alors identifiée par son nom, à savoir un D suivi d'un chiffre de 1 à 6 :

 
Sélectionnez
constructor TDice.Create(AOwner: TComponent);
// *** création d'un  ***
var
  Li: TDiceValueRange;
begin
  inherited; // ou inherited Create(AOwner);
  fValue := Low(TDiceValueRange); // valeur par défaut du 
  for Li := Low(TDiceValueRange) to High(TDiceValueRange) do
  begin
    fBitmap[Li] := TBitmap.Create;
    fBitmap[Li].LoadFromResourceName(HInstance, Format('D%d',[Li]));
  end;
end;

Le destructeur libère les images ainsi créées :

 
Sélectionnez
destructor TDice.Destroy;
// *** destruction du  ***
var
  Li: TDiceValueRange;
begin
  for Li := Low(TDiceValueRange) to High(TDiceValueRange) do
    fBitmap[Li].Free;
  inherited Destroy;
end;

Le dessin fait appel à une image temporaire capable de gérer une pseudo-transparence fondée sur la couleur clFuchsia qui est celle utilisée pour le contour des dés dans le fichier de ressources. Une fois le dessin reproduit, il est transféré sur le canevas du composant :

 
Sélectionnez
procedure TDice.Paint;
// *** dessin du  ***
var
  LBitmap: TBitmap;
begin
  inherited Paint; // on récupère le dessin de l'ancêtre
  // dessin du 
  LBitmap := TBitmap.Create;
  try
    // taille fixée, sinon pas de dessin !
    LBitmap.SetSize(ClientWidth, ClientHeight);
    // préparation de la transparence
    LBitmap.Transparent := True;
    LBitmap.TransparentColor := clFuchsia;
    // dessin à partir des dés enregistrés
    LBitmap.Canvas.StretchDraw(ClientRect, fBitmap[fValue]);
    // dessin sur le canevas
    Canvas.StretchDraw(ClientRect, LBitmap);
  finally
    LBitmap.Free;
  end;
end;

Même s'il ne s'agit pas ici de détailler les procédures de dessin sur le canevas, sujet qui dépasse largement le propos en cours, vous remarquerez que la classe TBitmap sert souvent de zone de travail. Son utilisation est protégée par une section try..finally afin de s'assurer de sa destruction grâce à Free (et non à Destroy !).

La méthode Throw est d'une grande simplicité :

 
Sélectionnez
procedure TDice.Throw;
// *** lancement du  ***
begin
  Value := Random(High(TDiceValueRange)) + 1;
end;

Comme vous le voyez, elle se contente de retourner une valeur entre les deux bornes de l'intervalle défini par TDiceValueRange.

En l'état, le composant fonctionne. Sans l'installer dans la palette, vous pouvez déjà avoir une idée de son comportement en créant une nouvelle application comme suit :

  • créez une application que vous nommerez testdice1 ;
  • renommez la fiche principale en MainForm et enregistrez l'unité sous main ;
  • créez une nouvelle unité grâce à « Fichier » puis « Nouvelle unité » et enregistrez-la sous dice ;
  • incluez cette nouvelle unité dans la clause uses de la partie interface de la fiche principale ;
  • complétez l'unité dice.pas avec la classe et les méthodes définies plus haut ;
  • complétez la fiche principale comme indiqué sur la copie d'écran ci-après (notez que le composant pnlDice de type TPanel a sa propriété Caption à vide) :

  • créez alors les gestionnaires d'événements suivants :
 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Spin, StdCtrls,
  dice; // unité des dés

type

  { TMainForm }

  TMainForm = class(TForm)
    checkbThrow: TCheckBox;
    pnlDice: TPanel;
    seValue: TSpinEdit;
    Timer: TTimer;
    procedure checkbThrowClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure seValueChange(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
  private
    { private declarations }
    MyDice: TDice;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
// *** création de la fiche et du  ***
begin
  MyDice := TDice.Create(pnlDice);
  MyDice.Parent := pnlDice;
  MyDice.SetBounds(0, 0, pnlDice.Width, pnlDice.Height);
end;

procedure TMainForm.seValueChange(Sender: TObject);
// *** la valeur du  doit changer ***
begin
  MyDice.Value := seValue.Value;
  MyDice.Invalidate;
end;

procedure TMainForm.checkbThrowClick(Sender: TObject);
// *** lancer du  ***
begin
  Timer.Enabled := checkbThrow.Checked;
  // spinedit à jour
  if not Timer.Enabled then
    seValue.Value := MyDice.Value;
end;

procedure TMainForm.TimerTimer(Sender: TObject);
// *** jets en boucle du  ***
begin
  MyDice.Throw;
  MyDice.Invalidate;
end;

end.

En dehors de la création du dé à l'intérieur d'un panneau qui exige que la taille du dé soit ajustée avec la méthode SetBounds et que le parent du dé soit défini à ce panneau sans quoi il ne serait pas dessiné, la seule difficulté réside dans le fait que le dé ne sait pas se redessiner quand nécessaire : si sa valeur a changé, il faut impérativement exécuter sa méthode Invalidate.

L'intervalle du TTimer étant par exemple défini à 50, cocher la case marquée « Lancer ? » modifie la valeur du dé en boucle. Si la case est décochée, l'usage du TSpinEdit permet de visualiser une valeur quelconque du dé.

II-A-2. De l'utilité des setters

[Exemple PO-29]

Une première amélioration de votre application consisterait à intégrer le rafraîchissement de l'affichage dans le composant, mais comment faire lorsque la valeur du dé change puisque la propriété Value accède directement au champ fValue ? Eh bien justement, sachant que des opérations sont le plus souvent nécessaires lors de l'affectation d'une valeur à un champ, un tel accès direct est généralement à proscrire ! L'utilisation d'un setter aurait évité d'avoir à présent à reprendre la classe de manière radicale.

  • Vous allez par conséquent modifier votre classe ainsi :
 
Sélectionnez
TDice = class(TPaintBox)
[…]
 private
    procedure SetValue(AValue: TDiceValueRange);
[...]
published
  // valeur actuelle du 
  property Value: TDiceValueRange read fValue write SetValue default Low(TDiceValueRange);
end;
  • Ensuite, vous définirez le nouveau setter de cette manière :
 
Sélectionnez
procedure TDice.SetValue(AValue: TDiceValueRange);
// *** changement de la valeur du  ***
begin
  if fValue = AValue then
    Exit;
  fValue := AValue;
  Invalidate;
end;

En pressant sur Ctrl-Alt-C dans la classe incomplète, Lazarus crée automatiquement un squelette qui déroute parfois certains : pourquoi faire un test sur la valeur entrée avant l'affectation proprement dite ? En fait, il s'agit de répondre à la configuration la plus fréquente : il est le plus souvent inutile, voire dangereux, de lancer l'exécution d'une suite d'opérations alors que la valeur d'une propriété n'a pas varié.

Dans le cas présent, si le champ fValue est inchangé, il n'y a aucune raison de lui réaffecter une valeur ! De plus, compléter le traitement par le setter avec un rafraîchissement de l'affichage du dé ne sera pas une perte de temps puisque l'opération sera toujours nécessaire. Enfin, un test sur une valeur booléenne est extrêmement rapide : la plupart du temps, vous n'aurez même pas l'excuse d'une accélération du traitement des données par votre application !

À présent que votre application gère mieux la propriété Value, il serait opportun d'ajouter d'autres propriétés utiles. Par exemple, vous aurez parfois besoin de bloquer la valeur d'un dé parce qu'il faudra la conserver d'un jet à l'autre. Alors, pourquoi ne pas prévoir une propriété Keep qui gérerait ce cas ?

  • Commencez par ajouter la nouvelle propriété et son setter à la classe du dé :
 
Sélectionnez
TDice = class(TPaintBox)
[...]
  published
    // valeur actuelle du 
    property Value: TDiceValueRange read fValue write SetValue default Low(TDiceValueRange);
    // faut-il garder sa valeur ?
    property Keep: Boolean read fKeep write SetKeep default False;
  end;
  • Définissez alors la nouvelle méthode nécessaire :
 
Sélectionnez
procedure TDice.SetKeep(AValue: Boolean);
// ** valeur conservée ? ***
begin
  if fKeep = AValue then
    Exit;
  fKeep := Avalue;
  Invalidate;
end;
  • Modifiez aussi le setter de Value afin de tenir compte de ce nouveau comportement qui bloque la mise à jour de la propriété :
 
Sélectionnez
procedure TDice.SetValue(AValue: TDiceValueRange);
// *** changement de la valeur du  ***
begin
  if (fValue = AValue) or fKeep then // <= nouveau !
    Exit;
  fValue := AValue;
  Invalidate;
end;
  • Toujours dans le même esprit, ajoutez un peu de couleur avec cette nouvelle propriété qui rendra plus visible un dé figé :
 
Sélectionnez
unit dice;

[...]

  TDice = class(TPaintBox)
  strict private
   [...]
    fDefaultColor: TColor;
    fKeepColor: TColor;
  private
    procedure SetDefaultColor(AValue: TColor);
    procedure SetKeepColor(AValue: TColor);
   [...] 
  published
   [...]
    // couleur si valeur gardée
    property KeepColor: TColor read fKeepColor write SetKeepColor default clMoneyGreen;
    // couleur si  normal
    property DefaultColor: TColor read fDefaultColor write SetDefaultColor default clDefault;
  end;

implementation

{$R dice.res }

[...]

procedure TDice.SetKeepColor(AValue: TColor);
// *** couleur si le  est conservé ***
begin
  if fKeepColor = AValue then
    Exit;
  fKeepColor := AValue;
  Invalidate;
end;

procedure TDice.SetDefaultColor(AValue: TColor);
// *** couleur de fond par défaut ***
begin
  if fDefaultColor = AValue then
    Exit;
  fDefaultColor := AValue;
  Invalidate;
end;

[...]

procedure TDice.Paint;
// *** dessin du  ***
var
  LBitmap: TBitmap;
begin
  inherited Paint; // on récupère le dessin de l'ancêtre
  // couleur de fond suivant l'état du 
  if fKeep then
    Canvas.Brush.Color := fKeepColor
  else
    Canvas.Brush.Color := fDefaultColor;
  Canvas.FillRect(ClientRect);
  // dessin du 
  LBitmap := TBitmap.Create;
[...]

constructor TDice.Create(AOwner: TComponent);
// *** création d'un  ***
var
  Li: Integer;
begin
  inherited;
  fValue := Low(TDiceValueRange); // valeur par défaut du 
  fKeep := False; // garder ?
  fKeepColor := clMoneyGreen; // couleur si gardé
  fDefaultColor := clDefault; // couleur par défaut
[...]
  • Sur la fiche principale, ajoutez une TCheckBox pour activer ou désactiver la conservation de la valeur du dé et donnez-lui le nom de cbKeep.
  • Fixez sa légende à « Garder ? » .
  • Ajoutez une TColorBox pour le choix de la couleur du dé bloqué, nommez-la colboxKeep et fixez sa propriété Selected à clMoneyGreen.

La fiche en cours s'affichera ainsi :

Il ne vous reste qu'à compléter les gestionnaires d'événements pour que le tout fonctionne :

 
Sélectionnez
procedure TMainForm.colboxKeepChange(Sender: TObject);
// *** la couleur de conservation change ***
begin
  MyDice.KeepColor := colboxKeep.Selected;
end;

procedure TMainForm.cbKeepChange(Sender: TObject);
// *** faut-il garder la valeur du dé ? ***
begin
  MyDice.Keep := cbKeep.Checked;
end;

Comme le mécanisme de rafraîchissement est pris en charge par la classe du dé à travers des setters pour les propriétés, l'intervention au niveau de l'application se résume à une simple affectation à une propriété ! Vous pouvez d'ailleurs supprimer sans souci les appels à Invalidate dans la fiche principale.

II-A-3. Un gestionnaire d'événement personnalisé

Il est encore possible d'améliorer votre classe du dé afin qu'elle devienne plus polyvalente. En effet, imaginez que vous deviez rendre compte en temps réel de l'état du dé sur une barre de statut. Une première solution pour résoudre ce problème consisterait à modifier votre fiche principale et à inspecter l'objet dé partout où il est susceptible d'être modifié. Inutile de s'étendre sur le côté fastidieux et risqué de cette solution ! Heureusement, il y a mieux et ce mieux porte un nom : le gestionnaire d'événements.

Tous les systèmes d'exploitation modernes fonctionnent sur la base d'événements. Un événement peut prendre de multiples formes : clic sur un bouton de la souris, touche du clavier pressée ou relâchée, intervalle de temps atteint d'une horloge, mais aussi modification d'une image ou d'une liste… Le principe général d'implémentation des événements repose sur une boucle capable de détecter ces événements et de les gérer.

Avec Free Pascal et Lazarus, vous utilisez sans doute déjà les événements à travers la page « Événements » de l'inspecteur d'objets. Vous savez qu'en cliquant sur un des événements proposés par un composant, vous générez le squelette d'une méthode qui sera appelée à chaque fois que l'événement en question sera déclenché par votre application. Ainsi, des événements couramment employés portent les noms de OnCreate, OnClick, OnClose, OnMouseDown, OnMouseUp… Vous savez aussi sans doute que les méthodes attachées à ces gestionnaires prennent des paramètres divers qui permettent de renseigner la méthode sur certains aspects de l'état du composant manipulé.

En revanche, vous ne savez peut-être pas qu'il est non seulement possible de lier un événement à une méthode à l'exécution, mais aussi de créer vos propres gestionnaires d'événements. C'est précisément ce que vous allez faire à présent.

La procédure de création et de gestion des gestionnaires d'événements suit le schéma décrit ci-après :

  • on crée un type d'événement ou l'on utilise un type d'événement existant ;
  • on s'occupe de la procédure de création dans la classe qui va déclencher l'événement :

    • on ajoute une propriété renvoyant à un champ privé du type retenu,
    • on ajoute une méthode généralement sans paramètre dans sa partie protégée (c'est elle qui centralisera les appels au gestionnaire),
    • on appelle cette méthode aux endroits stratégiques qui doivent déclencher l'événement traité ;
  • enfin, pour l'utilisation de cet événement, donc à l'extérieur de la classe enrichie :

    • on crée une méthode qui est du type de l'événement créé précédemment,
    • on lie cette méthode à la propriété événement de l'instance de la classe enrichie.

Dorénavant, le déclenchement de l'événement traité se répercutera grâce à la méthode qui vient d'être liée.

Pour que tout cela devienne clair, vous allez créer un gestionnaire d'événement propre à votre classe dé qui signalera tout changement de sa part concernant sa valeur ou la conservation de cette valeur.

Pour le type d'événement, vous en choisirez un prédéfini, très souvent utilisé et nommé TNotifyEvent. Il est déclaré dans l'unité classes sous cette forme :

 
Sélectionnez
TNotifyEvent = procedure(Sender: TObject) of object;

Vous voyez qu'il s'agit d'un squelette de procédure, appelé type procédural, comprenant pour seul paramètre le fameux Sender de type TObject qui fournira un pointeur vers l'objet appelant. Par transtypage, vous accéderez facilement à d'autres informations, dont la valeur du dé ou sa conservation. Aussi est-il inutile dans ce cas de créer un squelette plus complexe ?

[Exemple PO-30]

Dans la classe de votre dé, vous devez ajouter une propriété qui correspondra au gestionnaire voulu. Cette propriété sera un point d'accès aux instances de votre classe et, une fois n'est pas coutume, vous n'aurez besoin ni de setter ni de getter, mais de la définition d'un simple champ :

 
Sélectionnez
TDice = class(TPaintBox)
  strict private
[...]
    fOnDiceChange: TNotifyEvent;
[...]
  published
[...]
    // gestion des changements
    property OnDiceChange: TNotifyEvent read fOnDiceChange write fOnDiceChange;
  end;
  • Ajoutez à présent une méthode virtuelle sans paramètre dans la section protégée en l'appelant Sender :
 
Sélectionnez
TDice = class(TPaintBox)
[...]
  protected
    procedure Change; virtual;
[...]

Le caractère virtuel de la procédure ainsi que son placement dans une section protégée s'expliquent par le fait qu'elle a de fortes chances d'être modifiée dans des classes enfants.

Voici son implémentation :

 
Sélectionnez
procedure TDice.Change;
// *** changement notifié ***
begin
  if Assigned(fOnDiceChange) then
    fOnDiceChange(Self);
end;

La méthode vérifie si la propriété OnDiceChange est assignée à une procédure réelle et exécute cette dernière si c'est le cas avec le paramètre Self qui renvoie à l'adresse de l'instance, donc à l'appelant.

Il ne reste qu'à identifier les endroits où l'appel à Change doit être effectué, en fait, à chaque modification du dé :

 
Sélectionnez
{ TDice }

procedure TDice.SetKeepColor(AValue: TColor);
// *** couleur si le  est conservé ***
begin
  if fKeepColor = AValue then
    Exit;
  fKeepColor := AValue;
  Invalidate;
  Change;
end;

procedure TDice.SetDefaultColor(AValue: TColor);
// *** couleur de fond par défaut ***
begin
  if fDefaultColor = AValue then
    Exit;
  fDefaultColor := Avalue;
  Invalidate;
  Change;
end;

procedure TDice.SetValue(AValue: TDiceValueRange);
// *** changement de la valeur du  ***
begin
  if (fValue = AValue) or fKeep then
    Exit;
  fValue := Avalue;
  Invalidate;
  Change;
end;

procedure TDice.SetKeep(AValue: Boolean);
// ** valeur conservée ? ***
begin
  if fKeep = AValue then
    Exit;
  fKeep := Avalue;
  Invalidate;
  Change;
end;

Comme les modifications du dé exigent le rafraîchissement de son affichage, il est indiqué de supprimer toutes les occurrences de Invalidate et de compléter Change ainsi :

 
Sélectionnez
procedure TDice.Change;
// *** changement notifié ***
begin
  Invalidate; // changement !
  if Assigned(fOnDiceChange) then
    fOnDiceChange(Self);
end;

Désormais, la classe TDice est prête à communiquer avec les applications qui l'utiliseront !

Pour preuve, vous allez modifier l'unité de la fiche principale de l'exemple précédent :

  • ajoutez une barre TStatusBar (panneau « Common controls » de la palette) que vous nommerez stbarMain ;
  • passez sa propriété SimplePanel à True pour la laisser gérer une ligne d'affichage simple ;
  • dans la classe TMainForm de la fiche principale, ajoutez une méthode Changed dont la signature sera exactement celle d'un gestionnaire d'événement de type TNotifyEvent :
 
Sélectionnez
TMainForm = class(TForm)
[...]
  public
    { public declarations }
    procedure Changed(Sender: TObject);
  end;
  • avec Ctrl-Alt-C, créez le corps de cette nouvelle méthode que vous compléterez comme suit :
 
Sélectionnez
procedure TMainForm.Changed(Sender: TObject);
// *** état du  ***
var
  LSt: string;
begin
  if MyDice.Keep then
    LSt := 'bloqué'
  else
    LSt := 'débloqué';
  stbarMain.SimpleText := Format('Valeur : %d - Etat : %s', [MyDice.Value, LSt]);
end;

Cette méthode ne fait qu'afficher un état et elle aurait pu être identique sans le système de gestionnaires d'événements.

L'ultime étape va consister à lier cette méthode à celle attendue par la classe TDice via sa propriété OnDiceChange.

  • Pour ce faire, modifiez légèrement la méthode de création de la fiche principale, à savoir FormCreate :
 
Sélectionnez
procedure TMainForm.FormCreate(Sender: TObject);
// *** création de la fiche et du  ***
begin
  MyDice := TDice.Create(pnlDice);
  MyDice.Parent := pnlDice;
  MyDice.SetBounds(0, 0, pnlDice.Width, pnlDice.Height);
  MyDice.OnDiceChange := @Changed; // <= changement !
end;

Vous voilà au bout de vos peines : votre application met à jour la barre de statut sans aucune intervention de votre part !

Finalement, vous aurez essentiellement transféré une grande partie du travail concernant les changements du dé de la fiche principale vers sa classe : par là même vous aurez rendu votre classe plus intelligente, car capable de prendre en charge son propre affichage. De plus, une application quelconque utilisant votre dé n'aura plus que deux tâches simples à accomplir : créer une méthode avec une signature donnée et lier cette méthode à la propriété adéquate du dé. Autrement dit, le plus difficile n'aura été écrit qu'une fois et sans risque d'oubli !

Retenez bien ce mécanisme concernant les gestionnaires d'événements : c'est celui qui est appliqué par toutes les classes qui proposent des interactions événementielles avec les autres éléments de vos applications.

II-B. Un effort de généralisation

La classe TDice souffre de limitations dans la gestion des couleurs et de la transparence qui peuvent devenir rédhibitoires. Ainsi, utiliser une bibliothèque graphique ou imaginer une autre façon de représenter un dé exigerait pour le moment de récrire la classe complète. Pourquoi ne pas partir d'une classe plus abstraite d'où descendront des classes plus spécialisées ? C'est l'approche que vous allez à présent mettre en œuvre.

II-B-1. Une classe ancêtre pour le graphisme

Pour les classes graphiques, il est souvent utile de définir une classe ancêtre qui réglera certains aspects de l'affichage, mais aussi de l'initialisation.

[Exemple PO-31]

Voici la déclaration d'une telle classe :

 
Sélectionnez
{ TCustomRandomStuff }

  TCustomRandomStuff = class(TPaintBox)
  strict private
    fValue: Integer;
    fKeep: Boolean;
    fDefaultColor: TColor;
    fKeepColor: TColor;
    fRangeValueHigh: Integer;
    fRangeValueLow: Integer;
    fOnChange: TNotifyEvent;
  private
    procedure SetDefaultColor(AValue: TColor);
    procedure SetKeep(AValue: Boolean);
    procedure SetKeepColor(AValue: TColor);
    procedure SetValue(AValue: Integer);
  protected
    procedure Change; virtual;
    procedure Paint; override;
    procedure SetRangeValue(Low, High: Integer);
    property KeepColor: TColor read fKeepColor write SetKeepColor default clMoneyGreen;
    property DefaultColor: TColor read fDefaultColor write SetDefaultColor default clDefault;
    property Keep: Boolean read fKeep write SetKeep;
    property RangeValueHigh: Integer read fRangeValueHigh;
    property RangeValueLow: Integer read fRangeValueLow;
    property Value: Integer read fValue write SetValue;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  public
    constructor Create(AOwner: TComponent); override;
    procedure NewValue;
  end;

Si elle descend toujours de TPaintBox, elle se limite à la gestion du tirage, de la propriété Keep, de l'événement OnChange et des couleurs communes, à savoir celle pour un état normal et celle pour une valeur conservée. Le dessin est limité à une surcharge de Paint afin de préparer le fond lors de la conservation de la valeur associée à l'objet.

La définition dans une section protégée de certaines propriétés ou méthodes permettra aux classes descendantes de choisir celles qu'elles voudront rendre publiques et seulement celles-là.

Voici à présent une implémentation possible de cette classe :

 
Sélectionnez
{ TRandomStuff }

procedure TCustomRandomStuff.SetDefaultColor(AValue: TColor);
// *** couleur de fond par défaut ***
begin
  if fDefaultColor = AValue then
    Exit;
  fDefaultColor := AValue;
  Change;
end;

procedure TCustomRandomStuff.SetKeep(AValue: Boolean);
// *** fixe la conservation de la valeur ***
begin
  if (fKeep = AValue) then
    Exit;
  fKeep := AValue;
  Change;
end;

procedure TCustomRandomStuff.SetKeepColor(AValue: TColor);
// *** couleur si le  est conservé ***
begin
  if fKeepColor = AValue then
    Exit;
  fKeepColor := AValue;
  Change;
end;

procedure TCustomRandomStuff.SetValue(AValue: Integer);
// *** fixe la valeur ***
begin
  if (fValue = AValue) or fKeep then
    Exit;
  fValue := AValue;
  Change;
end;

procedure TCustomRandomStuff.Change;
// *** changement notifié ***
begin
  Invalidate;
  if Assigned(fOnChange) then
    fOnChange(Self);
end;

constructor TCustomRandomStuff.Create(AOwner: TComponent);
// création d'un  ***
begin
  inherited Create(AOwner);
  fKeepColor := clMoneyGreen;
  fDefaultColor := clDefault;
end;

procedure TCustomRandomStuff.NewValue;
// *** nouvelle valeur ***
begin
  Value := Random(fRangeValueHigh - fRangeValueLow + 1) + fRangeValueLow;
end;

procedure TCustomRandomStuff.Paint;
// *** dessin du composant ***
begin
  inherited Paint;
  if fKeep then
    Canvas.Brush.Color := fKeepColor
  else
    Canvas.Brush.Color := fDefaultColor;
  Canvas.FillRect(ClientRect);
end;

procedure TCustomRandomStuff.SetRangeValue(Low, High: Integer);
// *** nouvelles bornes pour la valeur ***
begin
  // mauvaises bornes ?
  if (Low >= High) then
    raise ERangeError.CreateFmt(rsLimit, [Low, High]);
  // contrôle de la borne inférieure
  if (fRangeValueLow <> Low) then
  begin
    if (Low > fValue) then
    begin
      fKeep := False;
      fValue := Low;
    end;
    fRangeValueLow := Low;
  end;
  // contrôle de la borne supérieure
  if (fRangeValueHigh <> High) then
  begin
    if (fRangeValueHigh < fValue) then
    begin
      fKeep := False;
      fValue := High;
    end;
    fRangeValueHigh := High;
  end;
  Change;
end;

La seule véritable difficulté réside dans l'implémentation de la méthode SetRangeValue en charge des bornes de l'intervalle pour le choix de la propriété Value : il faut en effet prévoir une mauvaise définition de ces bornes et déclencher l'exception adéquate avec le message :

 
Sélectionnez
implementation

resourcestring
  rsLimit = 'La limite inférieure %d est supérieure ou égale à la '
    + 'limite supérieure %d.';

C'est à l'intérieur de ces classes de bas niveau que peuvent facilement se déclencher les exceptions : ici, des bornes mal définies lèveront une exception de type ERangeError. Les classes dérivées devront définir des bornes convenables pour éviter que cette erreur ne survienne.

II-B-2. Une classe de dé améliorée

Dorénavant, les classes descendant de TCustomRandomStuff n'auront pour tâches qu'une initialisation et un affichage corrects.

Par exemple, une réécriture du dé déjà étudié donnera :

 
Sélectionnez
{ TDice }

  TDice = class(TCustomRandomStuff)
  strict private
    fBitmap: array[TDiceValueRange] of TBitmap;
  protected
    procedure Paint; override; // dessin du 
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property KeepColor;
    property DefaultColor;
    property Keep ;
    property Value;
    property OnChange;
  end;

Toutes les propriétés qui étaient protégées dans la classe ancêtre sont à présent publiées et apparaîtraient dans l'inspecteur d'objets si la classe devait être installée. Un choix aurait pu être fait au cas où certaines de ces propriétés n'auraient pas été utiles.

En dehors de la publication des propriétés cachées par la classe ancêtre dans la section protected, il ne reste que trois méthodes à renseigner. On peut affirmer que le dé a subi une cure d'amaigrissement remarquable !

  • Implémentez ainsi ces trois méthodes :
 
Sélectionnez
implementation

[…]

{$R dice.res }

resourcestring
  […] 
  rsDD = 'D%d';

[…] 
{ TDice }

procedure TDice.Paint;
// *** dessin du  ***
var
  LBitmap: TBitmap;
begin
  inherited Paint;
  LBitmap := TBitmap.Create;
  try
    LBitmap.SetSize(ClientWidth, ClientHeight);
    LBitmap.Transparent := True;
    LBitmap.TransparentColor := clFuchsia;
    LBitmap.Canvas.StretchDraw(ClientRect, fBitmap[Value]);
    Canvas.StretchDraw(ClientRect, LBitmap);
  finally
    LBitmap.Free;
  end;
end;

constructor TDice.Create(AOwner: TComponent);
// *** création d'un  ***
var
  Li: Integer;
begin
  inherited Create(AOwner);
  SetRangeValue(Low(TDiceValueRange), High(TDiceValueRange));
  for Li := RangeValueLow to RangeValueHigh do
  begin
    fBitmap[Li] := TBitmap.Create;
    fBitmap[Li].LoadFromResourceName(HInstance, Format(rsDD, [Li]));
  end;
end;

destructor TDice.Destroy;
// *** destruction du  ***
var
  Li: TDiceValueRange;
begin
  for Li := RangeValueLow to RangeValueHigh do
    fBitmap[Li].Free;
  inherited Destroy;
end;

Vous voyez comme cette classe a fondu, même du point de vue de son implémentation !

II-B-3. Une classe pour le pile ou face

Plus intéressante encore est la possibilité de générer facilement d'autres classes spécialisées. Par exemple, créer une classe pour un jet de pièce au jeu de pile ou face devient très simple :

 
Sélectionnez
interface

const
  CHeads = 1;
  CTails = 0;
[…]

{ TFlipCoin }

  TFlipCoin = class(TCustomRandomStuff)
  strict private
    fHeadsColor: TColor;
    fTailsColor: TColor;
  private
    procedure SetHeadsColor(AValue: TColor);
    procedure SetTailsColor(AValue: TColor);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property KeepColor;
    property DefaultColor;
    property Keep;
    property Value;
    property OnChange;
    // couleur côté face
    property HeadsColor: TColor read fHeadsColor write SetHeadsColor default clBlue;
    // couleur côté pile
    property TailsColor: TColor read fTailsColor write SetTailsColor default clRed;
  end;

Vous aurez remarqué les deux propriétés ajoutées pour la gestion de la couleur de chaque face. L'implémentation de l'ensemble pourrait être comme suit :

 
Sélectionnez
implementation

uses
  Types; // pour InflateRect

[…] 

{ TFlipCoin }

procedure TFlipCoin.SetHeadsColor(AValue: TColor);
// *** la couleur face change ***
begin
  if fHeadsColor = AValue then
    Exit;
  fHeadsColor := AValue;
  Change;
end;

procedure TFlipCoin.SetTailsColor(AValue: TColor);
// *** la couleur pile change ***
begin
  if fTailsColor = AValue then
    Exit;
  fTailsColor := AValue;
  Change;
end;

constructor TFlipCoin.Create(AOwner: TComponent);
// *** création de la pièce ***
begin
  inherited Create(AOwner);
  SetRangeValue(CTails, CHeads);
  fHeadsColor := clBlue;
  fTailsColor := clRed;
end;

procedure TFlipCoin.Paint;
// *** dessin de la pièce suivant sa valeur ***
var
  LBitmap: TBitmap;
  LR: TRect;
begin
  inherited Paint;
  LR := ClientRect;
  LBitmap := TBitmap.Create;
  try
    LBitmap.SetSize(ClientWidth, ClientHeight);
    LBitmap.Transparent := True;
    LBitmap.TransparentColor := clFuchsia;
    LBitmap.Canvas.Brush.Color := clFuchsia;
    LBitmap.Canvas.FillRect(LR);
    // couleurs adaptées
    if Value = CHeads then
      LBitmap.Canvas.Brush.Color := fHeadsColor
    else
      LBitmap.Canvas.Brush.Color := fTailsColor;
    // ajustement de la taille de l'ellipse
    InflateRect(LR, -1, -1);
    LBitmap.Canvas.Ellipse(LR);
    Canvas.StretchDraw(LR, LBitmap);
  finally
    LBitmap.Free;
  end;
end;

Encore une fois, il ne s'agit que de s'occuper des aspects graphiques : ici, cela consiste à tracer une ellipse en transparence sur un fond dessiné d'avance. Mais n'est-ce pas précisément là que réside le véritable problème ?

Enfin, l'application elle-même sera l'occasion de tester le dé et sa consœur la pièce.

  • Pour cela, créez une nouvelle application et construisez une interface selon le modèle suivant :

N'oubliez pas de cocher la propriété SimplePanel afin d'activer l'affichage d'une simple ligne sur la barre de statut.

Il y a peu à écrire pour obtenir une fiche opérationnelle :

 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ComCtrls, ExtCtrls, dice;

type

  { TMainForm }

  TMainForm = class(TForm)
    btnRollDice: TButton;
    btnDiceKeep: TButton;
    btnFlipCoin: TButton;
    btnFlipCoinKeep: TButton;
    pnlFlipCoin: TPanel;
    pnlDice: TPanel;
    StatusBar: TStatusBar;
    procedure btnFlipCoinClick(Sender: TObject);
    procedure btnDiceKeepClick(Sender: TObject);
    procedure btnFlipCoinKeepClick(Sender: TObject);
    procedure btnRollDiceClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
    MyDice: TDice;
    MyFlipCoin: TFlipCoin;
  public
    { public declarations }
    procedure Changed(Sender: TObject);
  end;

var
  MainForm: TMainForm;

implementation

uses
  strutils;

{$R *.lfm}

resourcestring
  rsValues = 'Valeur du  : %d - Garder : %s || Valeur de la pièce : '
    +'%s - Garder : %s';
  rsYes = 'OUI';
  rsNo = 'NON';
  rsTails = 'PILE';
  rsHeads = 'FACE';

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
// *** création de la fiche ***
begin
  Randomize;
  MyDice := TDice.Create(pnlDice);
  MyDice.Parent := pnlDice;
  MyDice.OnChange := @Changed;
  MyFlipCoin := TFlipCoin.Create(pnlFlipCoin);
  MyFlipCoin.Parent := pnlFlipCoin;
  MyFlipCoin.OnChange := @Changed;
end;

procedure TMainForm.btnRollDiceClick(Sender: TObject);
// *** nouvelle valeur du  ***
begin
  MyDice.NewValue;
end;

procedure TMainForm.btnDiceKeepClick(Sender: TObject);
// *** valeur du  conservée ? ***
begin
  MyDice.Keep := not MyDice.Keep;
end;

procedure TMainForm.btnFlipCoinKeepClick(Sender: TObject);
// *** valeur de la pièce conservée ?
begin
  MyFlipCoin.Keep := not MyFlipCoin.Keep;
end;

procedure TMainForm.btnFlipCoinClick(Sender: TObject);
// *** jet de la pièce ***
begin
  MyFlipCoin.NewValue;
end;

procedure TMainForm.Changed(Sender: TObject);
// *** changement d'un élément ***
begin
  StatusBar.SimpleText := Format(rsValues, [MyDice.Value,
    ifthen(MyDice.Keep, rsYes, rsNO),
    ifthen(MyFlipCoin.Value = 0, rsTails, rsHeads),
    ifthen(MyFlipCoin.Keep, rsYes, rsNO)]);
end;

end.

Chaque objet est créé en prenant un TPanel pour propriétaire et parent, ce qui lui permet d'être libéré automatiquement et de s'afficher. Son gestionnaire d'événement OnChange est lié à la procédure de mise à jour de la barre de statut. Par ailleurs, vous aurez reconnu les actions sur les objets concernant leur valeur, la conservation de cette dernière et leurs couleurs.

Les tâches de bas niveau sont prises en charge par la classe ancêtre qui sert d'outil tandis que les classes plus élaborées, ici les classes spécialisées du dé ou de la pièce, simplifient le travail de la fiche principale. Cette logique est à l'origine d'un code plus facile à corriger et à étendre.

II-B-4. Un nouveau dé en 2D

[Exemple PO-32]

Supposez à présent que vous vouliez une autre représentation d'un dé : seule sa face supérieure sera figurée, mais les couleurs de la face et des points seront contrôlables. Avec la classe TCustomRandomStuff, la seule difficulté sera vraiment le dessin et non tout un ensemble de considérations annexes.

La déclaration de la nouvelle classe serait alors :

 
Sélectionnez
{ TDice2D }

  TDice2D = class(TCustomRandomStuff)
  strict private
    fBackgroundColor: TColor;
    fDotColor: TColor;
  private
    procedure SetBackgroundColor(AValue: TColor);
    procedure SetDotColor(AValue: TColor);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  published
    property KeepColor;
    property DefaultColor;
    property Keep ;
    property Value;
    property OnChange;
    // couleur de fond de 
    property BackgroundColor: TColor read fBackgroundColor write SetBackgroundColor default clCream;
    // couleur des points du 
    property DotColor: TColor read fDotColor write SetDotColor default clGray;
  end;

Comme vous le constatez par vous-même, cette classe ne comporte aucune surprise. L'implémentation confirme que les problèmes ne naissent qu'avec le dessin du dé, suivant son état :

 
Sélectionnez
  { TDice2D }

  procedure TDice2D.SetBackgroundColor(AValue: TColor);
  // *** couleur de fond du  2D ***
  begin
    if fBackgroundColor = AValue then
      Exit;
    fBackgroundColor := AValue;
    Change;
  end;

  procedure TDice2D.SetDotColor(AValue: TColor);
  // *** couleur d'un point du  2D ***
  begin
    if fDotColor = AValue then
      Exit;
    fDotColor := AValue;
    Change;
  end;

  constructor TDice2D.Create(AOwner: TComponent);
  // *** création du  2D ***
  begin
    inherited;
    SetRangeValue(Low(TDiceValueRange), High(TDiceValueRange));
    fBackgroundColor := clCream;
    fDotColor := clGray;
  end;

  procedure TDice2D.Paint;
  // *** dessin d'un  en 2D ***
  const
    COffset = 4; // décalage
  var
    LDelta: Integer; // proportion
    LR: TRect;

    // les six (6) points possibles du 
    procedure Point_UpL;
    begin
      Canvas.Ellipse(COffset, COffset, (LDelta shl 1) + COffset, (LDelta shl 1)
        + COffset);
    end;

    procedure Point_MiL;
    begin
      Canvas.Ellipse(COffset, Height div 2 - LDelta, (LDelta shl 1) + COffset,
        Height div 2 + LDelta);
    end;

    procedure Point_DnL;
    begin
      Canvas.Ellipse(COffset, Height - (LDelta shl 1) - COffset, (LDelta shl 1) +
        COffset, Height - COffset);
    end;

    procedure Point_Mid;
    begin
      Canvas.Ellipse(Width div 2 - LDelta, Height div 2 - LDelta, Width div 2
        + LDelta, Height div 2 + LDelta);
    end;

    procedure Point_UpR;
    begin
      Canvas.Ellipse(Width - (LDelta shl 1) - COffset, COffset, Width - COffset,
        (LDelta shl 1) + COffset);
    end;

    procedure Point_MiR;
    begin
      Canvas.Ellipse(Width - (LDelta shl 1) - COffset, Height div 2 - LDelta,
        Width - COffset, Height div 2 + LDelta);
    end;

    procedure Point_DnR;
    begin
      Canvas.Ellipse(Width - (LDelta shl 1) - COffset, Height - (LDelta shl 1)
        - COffset, Width - COffset, Height - COffset);
    end;

  begin
    inherited Paint; // on récupère le dessin de l'ancêtre
    LDelta := Width div 10;
    if Keep then
      Canvas.Brush.Color := KeepColor
    else
      Canvas.Brush.Color := fBackgroundColor;
    Canvas.Pen.Color := clBlack;
    LR := ClientRect;
    InflateRect(LR, -1, -1);
    Canvas.RoundRect(0, 0, LR.Right, LR.Bottom, LDelta, LDelta);
    Canvas.Brush.Color := fDotColor;
    case Value of
      1: Point_Mid;
      2: begin
           Point_UpL;
           Point_DnR;
      end;
      3: begin
          Point_UpL;
          Point_Mid;
          Point_DnR;
      end;
      4: begin
           Point_UpL;
           Point_UpR;
           Point_DnL;
           Point_DnR;
      end;
      5: begin
           Point_UpL;
           Point_UpR;
           Point_DnL;
           Point_DnR;
           Point_Mid;
      end;
      6: begin
           Point_UpL;
           Point_UpR;
           Point_DnL;
           Point_DnR;
           Point_MiL;
           Point_MiR;
      end;
   end;
end;

Retenez que les efforts consentis lors de l'élaboration de vos classes ancêtres seront très souvent payants. Il vous sera d'autant plus aisé de les corriger et de les étendre. Vous n'aurez plus qu'à vous concentrer sur les questions que vous vous posez, sans vous égarer à cause d'autres soucis !

Afin d'illustrer l'utilisation du nouveau dé, vous modifierez légèrement l'application précédente en ajoutant un panneau et deux boutons supplémentaires pour le nouvel invité. Faites cet exercice par vous-même et vérifiez ensuite la proposition dans les exemples joints !

II-C. Le jeu du 36

Votre classe de gestion des dés est dorénavant suffisamment élaborée pour espérer répondre à la plupart des besoins. Vous allez par conséquent entreprendre l'écriture d'un jeu de dé complet, à savoir le « jeu du 36 ».

La règle de ce jeu est la suivante : deux joueurs s'affrontent avec un dé qu'ils lanceront à tour de rôle. Un joueur peut renoncer à lancer le dé, mais ce refus est définitif pour la partie en cours. Les points indiqués par le dé s'ajoutent au total individuel des points. L'objectif est d'atteindre un total de 36 points, sans jamais le dépasser. Au cas où un joueur dépasse ce total, il est déclaré perdant. Hormis ce cas, le vainqueur est celui qui est le plus proche de 36 après renoncement des deux joueurs.

L'application proposée simplifie légèrement les problèmes en ajoutant deux éléments à la règle : l'utilisateur humain commence toujours à jouer et, en cas d'égalité, il est toujours vainqueur.

II-C-1. La classe du jeu

[Exemple PO-33]

Tout d'abord, vous allez définir une nouvelle classe correspondant au jeu proprement dit :

  • créez une nouvelle application et ajoutez une nouvelle unité baptisée game à la fiche principale renommée comme d'habitude MainForm ;
  • dans cette nouvelle unité, déclarez la nouvelle classe TDice36 :
 
Sélectionnez
uses
  Classes, SysUtils,
  dice;

const
  CMax = 36;

type

  TUser = (tuNone, tuUser, tuComputer);
  TDiceAction = (daPlay, daStop);

  TUserEvent = procedure(Sender: TObject; ComputerStop, UserStop: Boolean;
      User: TUser) of object;

  { TDice36 }

  TDice36 = class
  strict private
    fComputerTotal: Integer;
    fDice: TDice;
    fOnChange: TNotifyEvent;
    fOnUserChange: TUserEvent;
    fUser: TUser;
    fUserTotal: Integer;
    fWinner: TUser;
    fUserStop: Boolean;
    fComputerStop: Boolean;
    procedure SetComputerTotal(AValue: Integer);
    procedure SetUser(AValue: TUser);
    procedure SetUserTotal(AValue: Integer);
    function ComputerThinking: TDiceAction;
  protected
    procedure Change; virtual;
    procedure UserChange; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure Next(Action: TDiceAction);
    property Dice: TDice read fDice;
    property User: TUser read fUser write SetUser default tuNone;
    property UserTotal: Integer read fUserTotal write SetUserTotal;
    property ComputerTotal: Integer read fComputerTotal write SetComputerTotal;
    property Winner: TUser read fWinner default tuNone;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
    property OnUserChange: TUserEvent read fOnUserChange write fOnUserChange;
  end;

Le plus important est de remarquer le nouveau gestionnaire d'événement OnUserChange qui s'appuie sur le type procédural personnalisé suivant :

 
Sélectionnez
TUserEvent = procedure(Sender: TObject; ComputerStop, UserStop: Boolean;
      User: TUser) of object;

Ce type procédural permettra d'envoyer des informations qu'il est alors inutile de rendre publiques via des propriétés : ComputerStop et OnUserStop seront fournies en interne par l'objet. User a été ajouté afin de simplifier les écritures, mais ce paramètre aurait pu être omis sans problème puisqu'il renvoie à une propriété publique de la classe.

Parallèlement au nouveau type, une procédure protégée a été ajoutée : UserChange. C'est elle qui vérifiera qu'un gestionnaire est bien lié avant de l'exécuter.

Le code des deux procédures chargées de centraliser les changements pour notification sera alors :

 
Sélectionnez
procedure TDice36.Change;
// *** changement notifié ***
begin
  if Assigned(fOnChange) then
    fOnChange(Self);
end;

procedure TDice36.UserChange;
// *** changement d'utilisateur notifié ***
begin
  if Assigned(fOnUserChange) then
    fOnUserChange(Self, fComputerStop, fUserStop, fUser);
end;

Elles sont encore une fois sans surprise : chacune d'elles doit respecter le squelette fourni par le type procédural de référence.

Une autre méthode mérite votre attention : ComputerThinking. Cette fonction concentre « l'intelligence » de votre classe et renvoie l'action retenue comme la meilleure, soit l'arrêt de la surenchère, soit un nouveau jet du dé :

 
Sélectionnez
function TDice36.ComputerThinking: TDiceAction;
// *** décision de l'ordinateur ***
begin
  if (fUserTotal = CMax) or
   ((fComputerTotal > fUserTotal) and fUserStop) then
     Result := daStop // on s'arrête si la partie est finie
  else
  case (CMax - fComputerTotal) of
    0: Result := daStop; // on a atteint le maximum !
    1..3: if ((CMax - fUserTotal) < 3) then
            Result := daPlay // on tente le tout pour le tout...
          else
            Result := daStop;
  else
    Result := daPlay; // on peut jouer tranquillement (ou presque...)
  end;
end;

Enfin, la méthode plus complexe est celle qui gère les coups joués. Next doit en effet à la fois tenir compte de celui qui joue et de l'état en cours du jeu :

 
Sélectionnez
procedure TDice36.Next(Action: TDiceAction);
// *** action suivante ***
begin
  // l'ordinateur réfléchit si c'est son tour
  if (fUser = tuComputer) then
    Action := ComputerThinking;
  case Action of
    // on joue
    daPlay:
      begin
        fDice.NewValue;
        // cas du joueur
        if fUser = tuUser then
        begin
          UserTotal := fUserTotal + fDice.Value;
          if not fComputerStop then
            User := tuComputer;
        end
        else
        // cas de l'ordinateur
        begin
          ComputerTotal := fComputerTotal + fDice.Value;
          if not fUserStop then
            User := tuUser;
        end;
      end;
    // on s'arrête
    daStop:
      begin
        // cas du joueur
        if fUser = tuUser then
        begin
          fUserStop := True;
          User := tuComputer;
        end
        else
        // cas de l'ordinateur
        begin
          fComputerStop := True;
          User := tuUser;
        end;
        // deux arrêts ?
        if (fUserStop and fComputerStop) then
        begin
          if fComputerTotal > fUserTotal then
            fWinner := tuComputer
          else
            fWinner := tuUser;
        end;
      end;
  end;
  Change;
end;

Lorsqu'une propriété dispose d'un setter, certains préfèrent passer par celui-ci et non par la propriété. Ce n'est pas tant une question de convention, mais de distraction.On a en effet vite fait d'écrire fValue:= 10 au lieu de Value:= 10. En utilisant le setter, l'écriture peut sembler plus claire : SetValue(10).

Pour le reste, il n'est rien que vous ne connaissiez déjà :

 
Sélectionnez
{ TDice36 }

procedure TDice36.SetUser(AValue: TUser);
// *** à qui le tour ? ***
begin
  if (fUser = AValue) or (fWinner <> tuNone) then
    Exit;
  fUser := AValue;
  UserChange;
end;

procedure TDice36.SetComputerTotal(AValue: Integer);
// *** total de l'ordinateur ***
begin
  if fComputerTotal = AValue then
    Exit;
  fComputerTotal := AValue;
  if fComputerTotal > CMax then
    fWinner := tuUser;
  Change;
end;

procedure TDice36.SetUserTotal(AValue: Integer);
// *** total de l'utilisateur ***
begin
  if fUserTotal = AValue then
    Exit;
  fUserTotal := AValue;
  if fUserTotal > CMax then
    fWinner := tuComputer;
  Change;
end;

[...]

constructor TDice36.Create;
// *** création ***
begin
  fDice := TDice.Create(nil);
  fUser := tuNone;
  fWinner := tuNone;
end;

destructor TDice36.Destroy;
// *** destruction ***
begin
  fDice.Free;
end;

procedure TDice36.Clear;
// *** remise à zéro ***
begin
  fUser := tuNone;
  fUserStop := False;
  fUserTotal := 0;
  fComputerStop := False;
  fComputerTotal := 0;
  fWinner := tuNone;
  UserChange;
  Change;
end;

La seule difficulté technique est de placer convenablement les appels aux méthodes en lien avec les gestionnaires d'événements, à savoir Change et UserChange. Vous aurez compris que le véritable défi, mine de rien, est de rendre la méthode ComputerThinking aussi efficace que possible : l'intérêt de votre jeu dépend essentiellement d'elle !

II-C-2. L'application de jeu

Seule la fiche principale reste à traiter. L'interface graphique pourra ressembler à ceci :

  • Rendez les étiquettes lblMe, lblMeStop et lblYouStop invisibles en décochant la propriété voulue dans l'inspecteur d'objets, ces étiquettes ne devant être affichées qu'en cas de besoin.
  • Dans la clause uses de l'interface de la fiche principale, incluez l'unité game.
  • Enfin, complétez cette fiche ainsi :
 
Sélectionnez
unit main;

{$mode objfpc}{$H+}

interface

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

type

  { TMainForm }

  TMainForm = class(TForm)
    btnPlay: TButton;
    btnStop: TButton;
    btnClear: TButton;
    lblMeStop: TLabel;
    lblYouStop: TLabel;
    lblMeCount: TLabel;
    lblYouCount: TLabel;
    lblYou: TLabel;
    lblMe: TLabel;
    pnlDice: TPanel;
    procedure btnClearClick(Sender: TObject);
    procedure btnPlayClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
    fMyDice36: TDice36;
    procedure Changed(Sender: TObject);
    procedure UserChanged(Sender: TObject; AComputerStop, AUserStop: Boolean;
      AUser: TUser);
    procedure Clear;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

resourcestring
  rsIWin = 'Je gagne !';
  rsYouWin = 'Vous gagnez !';

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
// *** création de la fiche ***
begin
  Randomize;
  fMyDice36 := TDice36.Create;
  fMyDice36.Dice.SetBounds(0, 0, pnlDice.Width, pnlDice.Height);
  fMyDice36.Dice.Parent := pnlDice;
  // deux gestionnaires d'événements
  fMyDice36.OnChange := @Changed;
  fMyDice36.OnUserChange := @UserChanged;
  // premier utilisateur : l'homme
  fMyDice36.User := tuUser;
end;

procedure TMainForm.btnPlayClick(Sender: TObject);
// *** tour suivant ***
begin
  fMyDice36.Next(daPlay);
end;

procedure TMainForm.btnClearClick(Sender: TObject);
// *** nettoyage ***
begin
  Clear;
end;

procedure TMainForm.btnStopClick(Sender: TObject);
// *** arrêt demandé ***
begin
  fMyDice36.Next(daStop);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
// *** destruction de la fiche ***
begin
  fMyDice36.Free;
end;

procedure TMainForm.Changed(Sender: TObject);
// *** notification de changement ***
begin
  // étiquettes des comptes à jour
  lblMeCount.Caption := IntToStr(fMyDice36.ComputerTotal);
  lblYouCount.Caption := IntToStr(fMyDice36.UserTotal);
  // quelqu'un a-t-il gagné ?
  if fMyDice36.Winner <> tuNone then
  begin
    // désactivation des boutons
    btnPlay.Enabled := False;
    btnStop.Enabled := False;
    // affichage du message adapté
    if fMyDice36.Winner = tuComputer then
      ShowMessage(rsIWin)
    else
      ShowMessage(rsYouWin);
    Clear;
  end;
end;

procedure TMainForm.UserChanged(Sender: TObject; AComputerStop,
  AUserStop: Boolean; AUser: TUser);
// *** notification de changement d'utilisateur ***
begin
  // affichage des étiquettes du tour
  lblMe.Visible := (not AComputerStop) and (AUser = tuComputer);
  lblYou.Visible := (not AUserStop) and (AUser = tuUser);
  // affichage des étiquettes stop
  lblMeStop.Visible := AComputerStop;
  lblYouStop.Visible := AUserStop;
  // bouton stop seulement pour l'utilisateur
  btnStop.Enabled := (AUser = tuUser);
end;

procedure TMainForm.Clear;
// *** nettoyage ***
begin
  fMyDice36.Clear;
  fMyDice36.User := tuUser;
  // boutons activés
  btnPlay.Enabled := True;
  btnStop.Enabled := True;
end;

La structure de l'application ne varie guère de celle déjà étudiée : vous retrouvez les méthodes qui initialisent et détruisent la fiche, de même que quelques gestionnaires de clic sur des boutons.

Comme vous avez défini deux gestionnaires d'événements, vous ne serez pas surpris d'avoir deux méthodes liées à eux dans votre code. Ces deux méthodes de la fiche principale ont évidemment une signature, c'est-à-dire une ligne de paramètres, conforme à celle exigée par le type procédural correspondant.

À titre d'exercices complémentaires, vous pourrez modifier ce programme en lui ajoutant les fonctionnalités que vous jugerez utiles. Autoriser le choix de qui commence le premier est un bon point de départ à ce propos, sachant qu'il s'agira surtout de manipuler la propriété User de l'objet fMyDice36.

[Exemple PO-34]

Une autre possibilité sera d'afficher le dé en deux dimensions au lieu de celui en cours. Vous risquez cependant d'être déçu, car vous ne devrez modifier que trois lignes du code pour arriver à vos fins ! C'est là encore une illustration de la puissance de la Programmation Orientée Objet, mais cherchez donc un peu par vous-même avant de lire la solution fournie ci-après, car elle est évidente !

Vous aurez compris qu'il suffit de substituer la classe TDice2D à la classe TDice, ce qui donne :

 
Sélectionnez
unit game;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  dice;

const
  CMax = 36;

type

  TUser = (tuNone, tuUser, tuComputer);
  TDiceAction = (daPlay, daStop);

  TUserEvent = procedure(Sender: TObject; ComputerStop, UserStop: Boolean;
      User: TUser) of object;

  { TDice36 }

  TDice36 = class
  strict private
    fComputerTotal: Integer;
    fDice: TDice2D; // ### 1
[...]
    property Dice: TDice2D read fDice;  // ### 2
[...]
  end;

implementation

{ TDice36 }

constructor TDice36.Create;
// *** création ***
begin
  fDice := TDice2D.Create(nil);  // ### 3
  fUser := tuNone;
  fWinner := tuNone;
end;

[...]
end.

III. Bilan

Avec ce tutoriel, vous aurez approfondi vos connaissances relatives à la Programmation Orientée Objet. En particulier, vous savez à présent :

  • mieux utiliser l'héritage et les setters ;
  • faire communiquer vos classes avec votre application grâce aux gestionnaires d'événements ;
  • définir et utiliser vos propres types procéduraux ;
  • concevoir une classe ancêtre extensible.

C'est ainsi que s'achève la première série de tutoriels sur la Programmation Orientée Objet avec Free Pascal et Lazarus. Vous pourrez la compléter utilement grâce à mon blog qui comprend déjà deux articles inédits sur le sujet et à la documentation très riche des rubriques Pascal, Lazarus et Delphi de developpez.com. Je vous invite aussi à examiner les logiciels de la section codes sources de Pascal. Enfin, une F.A.Q regroupant à ce jour plus d'une cinquantaine de questions est en cours d'élaboration : elle reprend à sa manière les éléments les plus importants abordés dans les tutoriels et ne demande qu'à être complétée et corrigée par tout membre du club de bonne volonté !

Parmi les prolongements possibles, vous pourriez envisager :

  • l'ajout d'une nouvelle propriété de notification OnKeepChange qui permettrait un traitement spécifique du changement de conservation de la valeur du dé (attention cependant : l'appel à un gestionnaire d'événement a une incidence non négligeable sur la rapidité de traitement de l'application) ;
  • la création d'une classe de collection de TBitmap au lieu des six bitmaps dans leur tableau ;
  • l'ajout d'une propriété ImageList dans TDice (avec option d'affichage en 2D ou 3D simplement en utilisant un autre TImageList) ;
  • la réalisation d'une classe gérant plusieurs dés (tableau ou liste)…

Ces idées comme bien d'autres remarques dans ce tutoriel proviennent de ThWilliam : qu'il soit ici remercié vivement. Je remercie aussi tout particulièrement Alcaltîz pour ses tests rigoureux et pour m'avoir laissé m'inspirer de son excellent travail. Ma reconnaissance va enfin à Roland Chastain pour sa relecture technique, ainsi qu'à milkoseck pour sa correction orthographique.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2016 gvasseur58. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.