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 :
interface
uses
Classes, SysUtils, ExtCtrls, Graphics;
type
TDiceValueRange = 1..6;
{ TDice }
TDice = class(TPaintBox)
strict private
fValue: TDiceValueRange;
// dessins du dé
fBitmap: array[TDiceValueRange] of Tbitmap;
protected
procedure Paint; override; // dessin du dé
public
procedure Throw; // lancement du dé
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
// valeur actuelle du dé
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 :
implementation
{$R dice.res }Chaque ressource est alors identifiée par son nom, à savoir un D suivi d'un chiffre de 1 à 6 :
constructor TDice.Create(AOwner: TComponent);
// *** création d'un dé ***
var
Li: TDiceValueRange;
begin
inherited; // ou inherited Create(AOwner);
fValue := Low(TDiceValueRange); // valeur par défaut du dé
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 :
destructor TDice.Destroy;
// *** destruction du dé ***
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 :
procedure TDice.Paint;
// *** dessin du dé ***
var
LBitmap: TBitmap;
begin
inherited Paint; // on récupère le dessin de l'ancêtre
// dessin du dé
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é :
procedure TDice.Throw;
// *** lancement du dé ***
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 :
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 dé ***
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 dé doit changer ***
begin
MyDice.Value := seValue.Value;
MyDice.Invalidate;
end;
procedure TMainForm.checkbThrowClick(Sender: TObject);
// *** lancer du dé ***
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 dé ***
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 :
TDice = class(TPaintBox)
[…]
private
procedure SetValue(AValue: TDiceValueRange);
[...]
published
// valeur actuelle du dé
property Value: TDiceValueRange read fValue write SetValue default Low(TDiceValueRange);
end;- Ensuite, vous définirez le nouveau setter de cette manière :
procedure TDice.SetValue(AValue: TDiceValueRange);
// *** changement de la valeur du dé ***
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é :
TDice = class(TPaintBox)
[...]
published
// valeur actuelle du dé
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 :
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é :
procedure TDice.SetValue(AValue: TDiceValueRange);
// *** changement de la valeur du dé ***
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é :
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 dé normal
property DefaultColor: TColor read fDefaultColor write SetDefaultColor default clDefault;
end;
implementation
{$R dice.res }
[...]
procedure TDice.SetKeepColor(AValue: TColor);
// *** couleur si le dé 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 dé ***
var
LBitmap: TBitmap;
begin
inherited Paint; // on récupère le dessin de l'ancêtre
// couleur de fond suivant l'état du dé
if fKeep then
Canvas.Brush.Color := fKeepColor
else
Canvas.Brush.Color := fDefaultColor;
Canvas.FillRect(ClientRect);
// dessin du dé
LBitmap := TBitmap.Create;
[...]
constructor TDice.Create(AOwner: TComponent);
// *** création d'un dé ***
var
Li: Integer;
begin
inherited;
fValue := Low(TDiceValueRange); // valeur par défaut du dé
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 :
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 :
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 :
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 :
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 :
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é :
{ TDice }
procedure TDice.SetKeepColor(AValue: TColor);
// *** couleur si le dé 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 dé ***
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 :
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 :
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 :
procedure TMainForm.Changed(Sender: TObject);
// *** état du dé ***
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 :
procedure TMainForm.FormCreate(Sender: TObject);
// *** création de la fiche et du dé ***
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 :
{ 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 :
{ 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 dé 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 dé ***
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 :
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 :
{ TDice }
TDice = class(TCustomRandomStuff)
strict private
fBitmap: array[TDiceValueRange] of TBitmap;
protected
procedure Paint; override; // dessin du dé
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 :
implementation
[…]
{$R dice.res }
resourcestring
[…]
rsDD = 'D%d';
[…]
{ TDice }
procedure TDice.Paint;
// *** dessin du dé ***
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 dé ***
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 dé ***
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 :
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 :
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 :
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é : %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 dé ***
begin
MyDice.NewValue;
end;
procedure TMainForm.btnDiceKeepClick(Sender: TObject);
// *** valeur du dé 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 :
{ 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 dé
property BackgroundColor: TColor read fBackgroundColor write SetBackgroundColor default clCream;
// couleur des points du dé
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 :
{ TDice2D }
procedure TDice2D.SetBackgroundColor(AValue: TColor);
// *** couleur de fond du dé 2D ***
begin
if fBackgroundColor = AValue then
Exit;
fBackgroundColor := AValue;
Change;
end;
procedure TDice2D.SetDotColor(AValue: TColor);
// *** couleur d'un point du dé 2D ***
begin
if fDotColor = AValue then
Exit;
fDotColor := AValue;
Change;
end;
constructor TDice2D.Create(AOwner: TComponent);
// *** création du dé 2D ***
begin
inherited;
SetRangeValue(Low(TDiceValueRange), High(TDiceValueRange));
fBackgroundColor := clCream;
fDotColor := clGray;
end;
procedure TDice2D.Paint;
// *** dessin d'un dé en 2D ***
const
COffset = 4; // décalage
var
LDelta: Integer; // proportion
LR: TRect;
// les six (6) points possibles du dé
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 :
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 :
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 :
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é :
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 :
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à  :
{ 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 :
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 :
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.