INFORMATIQUE
TP 6
Gestion des résultats d'un championnat (suite)
1. Modification des procédures
btEnregistrerClick et btOuvrirClick
Dans les procédures de lecture/écriture des
fichiers " championnat " nous avons oublié d'enregistrer
certaines informations capitales. Il s'agit des informations concernant la
façon de compter les points pour le classement et la manière
de départager les ex æquo. Notre programme doit pouvoir gérer
plusieurs championnats et donc permettre d'enregistrer, dans la partie en-tête
des fichiers, les données liées au calcul du classement qui
peut varier d'un championnat à un autre.
Par ailleurs, lorsqu'on ouvre un fichier " championnat
", il faut que le titre de la fenêtre principale corresponde au
nom du fichier.
Voici la nouvelle procédure (les modifications sont
en gras) pour l'enregistrement des fichiers :
procedure
TfmChampionnat.btEnregistrerClick(Sender: TObject);
var i,j : integer;
ch : string;
Fichier : TextFile;
begin
SaveDialog1.InitialDir:=ExtractFileDir(ParamStr(0));
if SaveDialog1.Execute then
begin
AssignFile(Fichier,SaveDialog1.FileName);
Rewrite(Fichier);
ch:=IntToStr(nbEquipes)
+chr(9)+IntToStr(fmNouveau.udMatchGagne.position)
+chr(9)+IntToStr(fmNouveau.udMatchPerdu.Position)
+chr(9)+IntToStr(fmNouveau.udMatchNul.Position)
+chr(9)+IntToStr(fmNouveau.rgClassementExAequo.ItemIndex);
writeln(Fichier,ch);
//La 1ère ligne contient les informations
qui permettent le calcul du
//classement. Ces informations sont stockées
dans les composants de
//la fenêtre fmNouveau.
for i:=0 to NbEquipes do
begin
ch:='';
for j:=0 to NbEquipes
do ch:=ch+grResultats.Cells[j,i]+chr(9);
delete(ch,length(ch),1);
writeln(Fichier,ch);
end;
CloseFile(Fichier);
btEnregistrer.enabled:=false;
end;
end;
Voici maintenant la nouvelle procédure pour l'ouverture/fermeture
des fichiers championnats (les modifications sont toujours en gras
) :
procedure
TfmChampionnat.btOuvrirClick(Sender: TObject);
{ Attention le bouton btOuvir sert à la fois à fermer et
à ouvrir une grille de résultats}
var reponse : word;
i,j : integer;
ch : string;
Fichier : TextFile;
begin
if btOuvrir.Caption='&Fermer' then //dans ce cas,
le bouton sert à fermer
begin
if btEnregistrer.Enabled then //dans
ce cas, la grille n'a pas été enregistrée
begin
reponse:=MessageDlg('Voulez-vous
enregistrer avant de fermer ?',mtWarning,
[mbYes,mbNo,mbCancel],0);
if reponse=mrYes then
btEnregistrerClick(sender);
if (reponse=mrNo)or(reponse=mrYes)
then
begin //dans les
2 cas on confirme la fermeture de la grille actuelle
For
i:=0 to grResultats.RowCount-1 do grResultats.rows[i].clear;
grResultats.Visible:=false;
btOuvrir.Caption:='&Ouvrir';
btNouveau.Caption:='&Nouveau
...';
btImprimer.Enabled:=false;
btClassement.Enabled:=false;
btEnregistrer.Enabled:=false;
caption:='Championnat';
//Titre de la fenêtre principale
end;
if reponse=mrCancel
then exit; //dans ce cas on renonce à fermer la grille
end
else //dans ce cas, la grille a été
enregistrée et on la ferme
begin
For i:=0 to grResultats.RowCount-1
do grResultats.rows[i].clear;
grResultats.Visible:=false;
btOuvrir.Caption:='&Ouvrir';
btNouveau.Caption:='&Nouveau
...';
btImprimer.Enabled:=false;
btClassement.Enabled:=false;
btEnregistrer.Enabled:=false;
caption:='Championnat';
//Titre de la fenêtre principale
end;
end
else //dans ce cas, le bouton sert bien à ouvrir
une grille enregistrée
begin
OpenDialog1.InitialDir:=ExtractFileDir(ParamStr(0));
if OpenDialog1.Execute then
begin
AssignFile(Fichier,OpenDialog1.FileName);
Reset(Fichier);
Readln(Fichier,ch);
j:=Pos(chr(9),ch);NbEquipes:=StrToInt(Copy(ch,1,j-1));delete(ch,1,j);
j:=Pos(chr(9),ch);fmNouveau.udMatchGagne.Position:=StrToInt(Copy(ch,1,j-1));
delete(ch,1,j);
j:=Pos(chr(9),ch);fmNouveau.udMatchPerdu.Position:=StrToInt(Copy(ch,1,j-1));
delete(ch,1,j);
j:=Pos(chr(9),ch);fmNouveau.udMatchNul.Position:=StrToInt(Copy(ch,1,j-1));
delete(ch,1,j);
fmNouveau.rgClassementExAequo.ItemIndex:=StrToInt(ch);
grResultats.RowCount:=NbEquipes+1;
grResultats.ColCount:=NbEquipes+1;
for i:=0 to NbEquipes
do
begin
readln(Fichier,ch);
j:=0;
while(Pos(chr(9),ch))>0
do
begin
grResultats.cells[j,i]:=Copy(ch,1,Pos(chr(9),ch)-1);
delete(ch,1,pos(chr(9),ch));
inc(j);
end;
grResultats.cells[j,i]:=ch;
end;
CloseFile(Fichier);
btEnregistrer.enabled:=false;
grResultats.Visible:=true;
grResultats.col:=1;
grResultats.row:=2;
grResultats.SetFocus;
btOuvrir.Caption:='&Fermer';
btClassement.Enabled:=true;
btNouveau.Caption:='&Modifier
...';
//attention : il
faut supprimer la ligne : btNouveau.Enabled :=false ;
btImprimer.Enabled:=true;
ch:=ExtractFileName(OpenDialog1.FileName);
{On ne garde que le nom du fichier}
ch:=Copy(ch,1,Pos('.',ch)-1);
//on supprime l'extension .txt
caption:=ch; //on
met ch comme titre de la fenêtre principale
end;
end;
end;
Comme on peut le voir ci-dessus, la propriété caption du
bouton btNouveau est changée en '&Modifier ...'. Nous
pourrons ainsi, lorsqu'une grille de résultats sera ouverte, utiliser
ce bouton pour modifier les données du championnat en cours (modification
du nom d'une équipe ou même changement du mode de calcul des
points ...)
2. Modification du comportement du bouton
btNouveau
À l'usage, il apparaît qu'on a souvent besoin de modifier
certains paramètres définis au moment de la création
d'un nouveau championnat. Le bouton btNouveau doit pouvoir changer d'affectation
et servir à modifier ces paramètres. (on aurait pu créer
un nouveau bouton, nommé btModifier mais, comme il y en a déjà
beaucoup, il vaut mieux réutiliser ceux qui sont normalement inactifs
pour leur donner dans ce cas une nouvelle affectation).
Voici donc la nouvelle procédure btNouveauClick (les modifications
sont en gras) :
procedure TfmChampionnat.btNouveauClick(Sender:
TObject);
//Le bouton Nouveau sert, soit à créer un nouveau
championnat, soit à modifier
//les paramètres du championnat en cours
var n : integer;
begin
with fmNouveau.grNomsDesEquipes do
begin
cols[1].clear;
Cells[0,0]:='numéro';
Cells[1,0]:='nom de l''équipe';
ColWidths[0]:=60;
ColWidths[1]:=width-85;
for n:=1 to 20 do cells[0,n]:=inttostr(n);
end;
if grResultats.visible then
//il s'agit dans ce cas de modifier les paramètres
du championnat en cours
begin
fmNouveau.Caption:='Modification des
données';
for n:=1 to nbEquipes do
fmNouveau.grNomsDesEquipes.cells[1,n]:=grResultats.cells[0,n];
end
else
begin //dans ce cas, il s'agit de créer un
nouveau championnat
fmNouveau.Caption:='Création
d''un nouveau championnat'
end;
if fmNouveau.showmodal = mrOK then
begin
n:=0; //on commence par calculer
le nombre d'équipes dans le championnat
while fmNouveau.grNomsDesEquipes.Cells[1,n+1]<>''
do inc(n);
nbEquipes:=n;
grResultats.RowCount:=nbEquipes+1;
grResultats.ColCount:=nbEquipes+1;
for n:=1 to nbEquipes do
begin
grResultats.Cells[0,n]:=fmNouveau.grNomsDesEquipes.cells[1,n];
grResultats.cells[n,0]:=fmNouveau.grNomsDesEquipes.cells[1,n];
end;
grResultats.Visible:=true;
grResultats.col:=1;
grResultats.row:=2;
grResultats.SetFocus;
btOuvrir.Caption:='&Fermer';
btClassement.Enabled:=true;
btEnregistrer.Enabled:=true;
btImprimer.Enabled:=true;
//supprimer la ligne btNouveau.enabled:=false;
end;
end;
Il faut aussi effacer, dans l'unité uNouveau, le texte de la procédure
FormActivate et ne garder que le titre de la procédure et le bloc
" begin...end
":
Procedure TflNouveau.FormActivate(Sender
: Tobject) ;
Begin
End ;
Lorsqu'on lancera l'application, Delphi se chargera lui-même (au
moment de la compilation) de supprimer complètement cette procédure.
3. Possibilité de déplacer les colonnes (et
les lignes) du tableau des résultats.
Nous allons voir qu'il est relativement facile de déplacer une colonne
d'un composant StringGrid en la faisant glisser à la souris. Cependant,
si l'utilisateur modifie l'ordre des colonnes, il faut que, en même
temps, l'ordre des lignes soit modifié de la même façon
: il est impératif que la liste des équipes qui figure en tête
des colonnes soit exactment dans le même orde que la liste des équipes
qui figure à gauche des lignes. Cette procédure est assez délicate
à comprendre et à mettre au point mais elle est très
efficace.
Il faut commencer
par modifier, dans la propriété Options du composant
grResultats, l'option goColMoving pour la mettre à
true comme le montre la liste ci-contre.
(pour obtenir cette liste, il faut cliquer sur le signe + situé à
gauche du mot Options)
Toutes ces options ont le même préfixe go parce qu'elles sont
des " Grid Options ".
Il faut ensuite, dans la colonne Evénements du composant grResultats,
faire un double-clic dans la zone de saisie de l'événement OnColumnMoved
puis saisir le texte ci-dessous :
procedure TfmChampionnat.grResultatsColumnMoved(Sender:
TObject; FromIndex,ToIndex: Integer);
var i,j : integer;
ch : string;
begin
if ToIndex<FromIndex then //déplacement de
la colonne vers la gauche
for i:=0 to NbEquipes do with grResultats do
begin
ch:=cells[i,FromIndex];
for j:=fromIndex Downto ToIndex+1 do cells[i,j]:=cells[i,j-1];
cells[i,ToIndex]:=ch;
end
else //déplacement vers la droite
for i:=0 to NbEquipes do with grResultats do
begin
ch:=cells[i,FromIndex];
for j:=fromIndex to ToIndex-1 do cells[i,j]:=cells[i,j+1];
cells[i,ToIndex]:=ch;
end;
end;
4. Mise en place d'une nouvelle fiche pour afficher le classement
Cliquer sur le bouton " nouvelle fiche " 
pour
ajouter une fiche (" form ") supplémentaire à notre
projet.
Propriété Caption : &Classement
Propriété Name : fmClassement
Ajouter dans
cette fiche 2 boutons et un composant StringGrid comme ceci :
Composant StringGrid :
Name : grClassement
ColCount : 8
Composant Button1 :
Name : btImprimer
Caption : &Imprimer
Composant Button2 :
Name : btFermer
Caption : &Fermer
- Cliquer sur le bouton " enregistrer tout " et enregistrer l'unité
Unit1 sous le nom uClassement.
5. Préparation de la grille contenant le classement
Il y a essentiellement 2 actions à prévoir :
- Régler les largeurs des colonnes
- Préciser la façon dont sera dessinée chaque cellule
de la grille
Commençons par le plus simple : le réglage des largeurs des
colonnes. Ce reglage se fera sur l'événement OnCreate
de la fiche fmClassement. Les titres des colonnes devront être affichés
sur 2 lignes et il sera nécessaire d'augmenter la hauteur de la 1ère
ligne (ligne 0). De même la largeur de la 1ère colonne (colonne
0) devra être augmentée afin de recevoir les noms des équipes.
Voici le code :
procedure TfmClassement.FormCreate(Sender:
TObject);
var i : integer;
begin
with grClassement do
begin
RowHeights[0]:=40; //Hauteur de la
ligne 0
ColWidths[0]:=100; //Largeur de la
colonne 0
for i:=1 to 7 do ColWidths[i]:=(width-110)
div 7;
end;
end;
Par contre, pour l'affichage des cellules, c'est beaucoup plus compliqué
(si on veut un affichage bien centré avec certaines colonnes en gras).
La procédure est déclenchée par l'événement
OnDrawCell du composant grClassement. Voici le code :
procedure TfmClassement.grClassementDrawCell(Sender:
TObject; ACol,
ARow:
Integer; Rect: TRect; State: TGridDrawState);
var ch : string;
begin
with grClassement.canvas do
begin
if ARow=0 then case ACol of //si ARow=0
c'est la ligne des titres
0 : begin
font.style:=[fsBold];
ch:='Noms
des';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,rect.top+2,ch);
ch:='équipes';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,rect.top+20,ch);
end;
1 : begin
font.style:=[fsBold];
ch:='Matches';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,rect.top+2,ch);
ch:='joués';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,rect.top+20,ch);
end;
2 : begin
font.style:=[fsBold];
ch:='Matches';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,rect.top+2,ch);
ch:='gagnés';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,rect.top+20,ch);
end;
3 : begin
font.style:=[fsBold];
ch:='Matches';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,rect.top+2,ch);
ch:='perdus';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,rect.top+20,ch);
end;
4 : begin
font.style:=[fsBold];
ch:='Matches';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,rect.top+2,ch);
ch:='nuls';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,rect.top+20,ch);
end;
5 : begin
font.style:=[fsBold];
ch:='Points';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,
(rect.top+rect.bottom-textHeight(ch))div
2,ch);
end;
6 : begin
font.style:=[fsBold];
ch:='+
/ -';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,
(rect.top+rect.bottom-textHeight(ch))div
2,ch);
end;
7 : begin
font.style:=[fsBold];
ch:='Rang';
TextOut((Rect.left+rect.right-TextWidth(ch))div
2,
(rect.top+rect.bottom-textHeight(ch))div
2,ch);
end;
end;
if ARow>0 then
begin
if (ACol=0)or(ACol=5)
then Font.style:=[fsBold]
else
Font.Style:=[];
ch:=grClassement.cells[ACol,ARow];
brush.Style:=bsSolid;
if ACol=0 then brush.Color:=clBtnFace
else
brush.Color:=clWhite;
if ACol=0 then Rectangle(Rect.left,Rect.top,Rect.right,Rect.bottom)
else
Rectangle(Rect.left-1,Rect.top-1,
Rect.right+1,Rect.bottom+1);
brush.Style:=bsClear;Font.Color:=clBlack;
Textout((Rect.left+Rect.right-TextWidth(ch))div
2,
(rect.top+rect.bottom-textHeight(ch))div
2,ch);
end;
end;
end;
Avant d'essayer le programme, il convient d'enregistrer un cas concret de
championnat. Voici un exemple réel de championnat : il s'agit du championnat
de billard, division 2, groupe E :
Il faut commencer par saisir les noms des 9 équipes engagées
dans ce championnat ainsi que le mode de calcul des points et du classement.
On trouvera ci-dessous l'écran de saisie :
Voici maintenant l'état des résultats au 1/12/2001 des différentes
rencontres :
- Saisir tous les résultats et enregistrer ce championnat dans votre
dossier sous le nom " billard d2 groupe E " (par exemple).
6. Affichage des noms des équipes
Commençons par le plus simple : afficher les noms des équipes
dans la colonne 0 de la grille grClassement. Cet affichage se fera
sur l'événement OnShow de la fiche fmClassement
:
procedure TfmClassement.FormShow(Sender:
TObject);
var i : integer;
begin
with grClassement do
begin
RowCount:=nbEquipes+1;
for i:=1 to nbEquipes do
begin
Rows[i].clear;
cells[0,i]:=fmChampionnat.grResultats.cells[0,i];
end;
end;
end;
- Enregistrer tout et lancer l'exécution pour essayer.
7. Affichage du nombre de matches joués
Çà encore, ça va : pour connaître le nombre de
matches joués par l'équipe n° i, il suffit de compter, dans
la ligne n° i, le nombre de cellules non vides (matches à domicile)
et d'ajouter, dans la colonne n° i, le nombre de cellules non vides (matches
à l'extérieur).
Voici la fonction qu'il faut écrire. Ce code est à mettre entre
les procédures TfmClassement.grClassementDrawCell
et TfmClassement.FormShow
:
function NbMatchesJoues(i:integer):integer;
//Calcule le nombre de matches joués par l'équipe i
var j : integer;
begin
result:=0;//result est une variable qui n'a pas besoin
d'être déclarée
for j:=1 to nbEquipes do
begin
if fmChampionnat.grResultats.Cells[j,i]<>''
then inc(result); //à domicile
if fmChampionnat.grResultats.Cells[i,j]<>''
then inc(result); //à l'extérieur
end;
NbMatchesJoues:=result;
end;
La procédure TfmClassement.FormShow doit alors être modifiée
en conséquence (la modification est en caractères gras
ci-dessous) :
procedure TfmClassement.FormShow(Sender:
TObject);
var i : integer;
begin
with grClassement do
begin
RowCount:=nbEquipes+1;
for i:=1 to nbEquipes do
begin
Rows[i].clear;
cells[0,i]:=fmChampionnat.grResultats.cells[0,i];
cells[1,i]:=IntToStr(NbMatchesJoues(i));
end;
end;
end;
8. Affichage du nombre de matches gagnés
C'est un peu plus compliqué car il faut analyser les scores et les
décomposer en 2 nombres afin de savoir si l'équipe a gagné
ou a perdu.
On peut commencer par définir ce qu'est un score. Il s'agit d'un couple
de 2 entiers : un entier a qui correspond au nombre de buts marqués
par l'équipe qui reçoit et un entier b qui correspond
au nombre de buts marqués par l'équipe visiteuse. Cette définition
doit être écrite de la façon suivante :
type TScore = Record
a,b
: integer;
end;
Ces 3 lignes doivent être écrites juste avant le mot Implementation.
Il faut ensuite écrire la fonction qui calculera le score réalisée
par l'équipe i recevant l'équipe j . Cette
fonction peut être placée juste après la fonction NbMatchesJoues
:
Function CalculeScore(i,j:integer):TScore;
//décompose la chaîne contenant le score de l'équipe
i recevant l'équipe j
var ch,cha,chb : string;
erreur : integer;
begin
ch:=fmChampionnat.grResultats.cells[j,i];
if ch='' then
begin
Result.a:=-1;//-1 indique que le match
n'a pas encore eu lieu
Result.b:=-1;
end
else
begin
cha:=Copy(ch,1,pos('-',ch)-1);//1ère
partie du score
val(cha,Result.a,erreur);if erreur>0
then Result.a:=-1;
delete(ch,1,pos('-',ch));
chb:=ch; //2ème partie du score
val(chb,Result.b,erreur);if erreur>0
then Result.b:=-1;
end;
CalculeScore:=Result;
end;
On peut alors écrire, juste en dessous, la fonction qui calcule le
nombre de matches gagnés par l'équipe i :
function NbMatchesGagnes(i:integer):integer;
//Calcule le nombre de matches gagnés par l'équipe i
var j : integer;
Score : TScore;
begin
result:=0;
for j:=1 to nbEquipes do
begin
Score:=CalculeScore(i,j); //score
du match à domicile de l'équipe i
if (Score.a>-1)and(Score.a>Score.b)
then inc(result);
end;
for j:=1 to nbEquipes do
begin
Score:=CalculeScore(j,i); //score
du match à l'extérieur de l'équipe i
if (Score.a>-1)and(Score.b>Score.a)
then inc(result);
end;
NbMatchesGagnes:=result;
end;
Il ne reste plus qu'à compléter la procédure FormShow
(modifications en gras) :
procedure TfmClassement.FormShow(Sender:
TObject);
var i : integer;
begin
with grClassement do
begin
RowCount:=nbEquipes+1;
for i:=1 to nbEquipes do
begin
Rows[i].clear;
cells[0,i]:=fmChampionnat.grResultats.cells[0,i];
cells[1,i]:=IntToStr(NbMatchesJoues(i));
cells[2,i]:=IntToStr(NbMatchesGagnes(i));
end;
end;
end;
9. Affichage du nombre de matches perdus et nuls
Le principe est le même que pour le calcul du nombre de matches gagnés.
Il faut écrire les 2 fonctions NbMatchesPerdus et nbMatchesNuls
juste après la fonction nbMatchesGagnés :
function NbMatchesPerdus(i:integer):integer;
//Calcule le nombre de matches perdus par l'équipe i
var j : integer;
Score : TScore;
begin
result:=0;
for j:=1 to nbEquipes do
begin
Score:=CalculeScore(i,j); //score
du match à domicile de l'équipe i
if (Score.a>-1)and(Score.a<Score.b)
then inc(result);
end;
for j:=1 to nbEquipes do
begin
Score:=CalculeScore(j,i); //score
du match à l'extérieur de l'équipe i
if (Score.a>-1)and(Score.b<Score.a)
then inc(result);
end;
NbMatchesPerdus:=result;
end;
function NbMatchesNuls(i:integer):integer;
//Calcule le nombre de matches nuls de l'équipe i
begin
NbMatchesNuls:=NbMatchesJoues(i)-NbMatchesGagnes(i)-NbMatchesPerdus(i);
end;
Il ne reste plus plus qu'à modifier la procédure FormShow
en y ajoutant 2 lignes :
procedure TfmClassement.FormShow(Sender:
TObject);
var i : integer;
begin
with grClassement do
begin
RowCount:=nbEquipes+1;
for i:=1 to nbEquipes do
begin
Rows[i].clear;
cells[0,i]:=fmChampionnat.grResultats.cells[0,i];
cells[1,i]:=IntToStr(NbMatchesJoues(i));
cells[2,i]:=IntToStr(NbMatchesGagnes(i));
cells[3,i]:=IntToStr(NbMatchesPerdus(i));
cells[4,i]:=IntToStr(NbMatchesNuls(i));
end;
end;
end;
10. Calcul et affichage du nombre de points
Ce calcul dépend des paramètres du championnat. Ces paramètres
sont conservés dans la fenêtre fmNouveau.
Voici le code de la fonction qui calcule le nombre de points obtenus par
l'équipe i. Ce code est à mettre juste après
le code de la fonction NbMatchesNuls :
function NbPoints(i:integer):integer;
//calcule le nombre de points de l'équipe i
var PointsParMatchGagne,PointsParMatchPerdu,PointsParMatchNul : integer;
begin
PointsParMatchGagne:=fmNouveau.udMatchGagne.Position;
PointsParMatchPerdu:=fmNouveau.udMatchPerdu.Position;
PointsParMatchNul:=fmNouveau.udMatchNul.Position;
NbPoints:=NbMatchesGagnes(i)*PointsParMatchGagne
+
NbMatchesPerdus(i)*PointsParMatchPerdu
+
NbMatchesNuls(i)*PointsParMatchNul;
end;
Il ne faut pas oublier de rajouter dans la procédure FormShow
la ligne :
cells[5,i]:=IntToStr(NbPoints(i));
11. Calcul du bonus (pour départager les ex æquo)
La technique est un peu plus compliqué. Cependant, avec un peu d'attention,
chacun pourra comprendre comment ça marche :
function Bonus(i:integer):integer;
//calcule le bonus de l'équipe i en fonction du type de calcul
var j : integer;
score : TScore;
begin
result:=0;
case fmNouveau.rgClassementExAequo.ItemIndex of
0 : begin //Nombre de buts marqués
(meilleure attaque)
for
j:=1 to NbEquipes do
begin
score:=CalculeScore(i,j);
if
score.a>-1 then result:=result+score.a;
end;
for
j:=1 to NbEquipes do
begin
score:=CalculeScore(j,i);
if
score.b>-1 then result:=result+score.b;
end;
end;
1 : begin //Nombre de buts concédés
(meilleure défense)
for
j:=1 to NbEquipes do
begin
score:=CalculeScore(i,j);
if
score.b>-1 then result:=result-score.b;
end;
for
j:=1 to NbEquipes do
begin
score:=CalculeScore(j,i);
if
score.a>-1 then result:=result-score.a;
end;
end;
2 : begin //Différence entre le
nombre de buts marqués et celui concédés
for
j:=1 to NbEquipes do
begin
score:=CalculeScore(i,j);
if
(score.a>-1)and(score.b>-1) then result:=result+score.a-score.b;
end;
for
j:=1 to NbEquipes do
begin
score:=CalculeScore(j,i);
if
(score.a>-1)and(score.b>-1) then result:=result-score.a+score.b;
end;
end;
end;
Bonus:=result;
end;
On ajoute alors dans la procédure FormShow la ligne suivante
:
cells[6,i]:=IntToStr(Bonus(i));
- Ne pas oublier d'enregistrer de temps en temps ...
12. Calcul du rang de chaque équipe
Pour calculer le rang de l' équipe i, on commence par dire
que son rang est au moins égal à 1 (la meilleure équipe
est classée avec le rang 1 et non pas le rang 0). Ensuite, on regarde
le score de chacune des équipes : dès que l'une d'elle a un
score supérieur au score de l'équipe i alors le rang
de l'équipe i augmente de 1.
Pour départager les ex æquo on utilise les points de la colonne
+/-. Voici cette fonction :
function Rang(i:integer):integer;
//calcule le rang (classement) de l'équipe i
var j : integer;
points : integer;
begin
Result:=1;
Points:=1000*NbPoints(i)+Bonus(i);
for j:=1 to NbEquipes do
if 1000*NbPoints(j)+Bonus(j)>Points
then inc(result);
Rang:=Result;
end;
Voici de que l'on doit obtenir lorsqu'on demande le classement :
13. Affichage des équipes dans l'ordre de leur
classement
Il faut maintenant permettre l'affichage des équipes dans l'ordre
du classement. Cette procédure sera nommée ClasserTout. Voici
le code basée sur la méthode du tri à bulles dont nous
avons déjà parlé (on placera ce texte juste avant le
texte de la procédure FormShow):
Procedure ClasserTout;
//Permet d'afficher les équipes dans l'ordre du classement
var i,j : integer;
procedure Permuter(a,b:integer);
//échange les lignes a et b de la grille grClassement
var ch : string;
i : integer;
begin
with fmClassement.grClassement do
for i:=0 to 7 do
begin
ch:=cells[i,a];
cells[i,a]:=cells[i,b];
cells[i,b]:=ch;
end;
end;
begin
with fmClassement.grClassement do
for i:=1 to NbEquipes-1 do
for j:=1 to NbEquipes-i do
if cells[7,j]>cells[7,j+1] then Permuter(j,j+1);
end;
La procédure FormShow est maintenant complète :
procedure TfmClassement.FormShow(Sender:
TObject);
var i : integer;
begin
with grClassement do
begin
RowCount:=nbEquipes+1;
for i:=1 to nbEquipes do
begin
Rows[i].clear;
cells[0,i]:=fmChampionnat.grResultats.cells[0,i];
cells[1,i]:=IntToStr(NbMatchesJoues(i));
cells[2,i]:=IntToStr(NbMatchesGagnes(i));
cells[3,i]:=IntToStr(NbMatchesPerdus(i));
cells[4,i]:=IntToStr(NbMatchesNuls(i));
cells[5,i]:=IntToStr(NbPoints(i));
cells[6,i]:=IntToStr(Bonus(i));
cells[7,i]:=IntToStr(Rang(i));
end;
ClasserTout;
end;
end;
14. Imprimer le tableau des résultats et celui
du classement
Pour simplifier, nous allons imprimer ces tableaux sans prêter attention
à la présentation. Voici tout d'abord le code correspondant
à un clic de souris sur le bouton btImprimer de la fiche fmChampionnat
(événement OnClick du composant btImprimer)
:
procedure TfmChampionnat.btImprimerClick(Sender:
TObject);
var LargeurColonne, HauteurLigne : integer;
ch : string;
i,j,x1,y1,x2,y2 : integer;
begin
Printer.Orientation:=poLandScape; //Orientation paysage
Printer.BeginDoc;
with Printer.canvas do
begin
Font.Name:='Arial';
Font.Size:=10;
LargeurColonne:=Printer.PageWidth
div (nbEquipes+1);
HauteurLigne:=TextHeight('M');
ch:=caption;
Font.style:=[fsBold];
TextOut((Printer.PageWidth-TextWidth(ch))div
2,0,ch);
ch:='Tableau des résultats';
TextOut((Printer.PageWidth-TextWidth(ch))div
2,2*HauteurLigne,ch);
Font.style:=[];
for i:=0 to NbEquipes
do //écriture de la ligne i
begin
y1:=(4+2*i)*HauteurLigne;
y2:=(6+2*i)*HauteurLigne;
for
j:=0 to NbEquipes do //cellule de la colonne j
begin
ch:=grResultats.cells[j,i];
x1:=j*LargeurColonne;
x2:=(j+1)*LargeurColonne;
if
(i*j=0) then Font.Style:=[fsBold]
else
Font.Style:=[];
Rectangle(x1,y1,x2,y2);
if
i=j then
begin
MoveTo(x1,y1);LineTo(x2,y2);
MoveTo(x2,y1);LineTo(x1,y2);
end
else
TextOut((x1+x2-TextWidth(ch))div 2,(y1+y2-TextHeight(ch))div 2,ch);
end;
end;
end;
Printer.EndDoc;
end;
Voici maintenant le code de la procédure qui répond à
un clic de souris sur le bouton btImprimer de la fiche fmClassement
(on peut recopier le texte précédent et le modifier) :
procedure TfmClassement.btImprimerClick(Sender:
TObject);
var LargeurColonne, HauteurLigne : integer;
ch : string;
i,j,x1,y1,x2,y2 : integer;
begin
Printer.Orientation:=poLandScape;
Printer.BeginDoc;
with Printer.canvas do
begin
Font.Name:='Arial';
Font.Size:=10;
LargeurColonne:=Printer.PageWidth
div 8;
HauteurLigne:=TextHeight('M');
ch:=fmChampionnat.caption;
Font.style:=[fsBold];
TextOut((Printer.PageWidth-TextWidth(ch))div
2,0,ch);
ch:='Tableau du Classement';
TextOut((Printer.PageWidth-TextWidth(ch))div
2,2*HauteurLigne,ch);
Font.style:=[];
for i:=0 to NbEquipes
do //écriture de la ligne i
begin
y1:=(4+2*i)*HauteurLigne;
y2:=(6+2*i)*HauteurLigne;
for
j:=0 to 8 do //cellule de la colonne j
begin
if
i=0 then case j of
0
: ch:='Noms des équipes';
1
: ch:='Matches joués';
2
: ch:='Matches gagnés';
3
: ch:='Matches perdus';
4
: ch:='Matches nuls';
5
: ch:='Points';
6
: ch:='Bonus';
7
: ch:='Classement';
end
else
ch:=grClassement.cells[j,i];
x1:=j*LargeurColonne;
x2:=(j+1)*LargeurColonne;
Rectangle(x1,y1,x2,y2);
if
(i=0)or(j=0)or(j=5) then Font.Style:=[fsBold]
else
Font.Style:=[];
TextOut((x1+x2-TextWidth(ch))div
2,(y1+y2-TextHeight(ch))div 2,ch);
end;
end;
end;
Printer.EndDoc;
end;
<< TP
précédent TP
suivant >>
Retour à la liste des
TP