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

5. Préparation de la grille contenant le classement

Il y a essentiellement 2 actions à prévoir :

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 :

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;

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));

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