Exercices corrigés du Guide Pascal et Delphi

Date de publication : 01/01/2000

Corrigés des exercices du guide de programmation de F.Beaulieu.

I. Chapitre V. Pascal Objet : première partie
I-A. Exercice 1
I-B. Exercice 2
I-C. Exercice 3
I-D. Exercice 4
II. Chapitre VI. Procédures et fonctions
II-A. Exercice 1
III. Chapitre VII. Types de données avancés de Pascal Objet
III-A. Exercice 1
III-B. Exercice 2
III-C. Exercice 3
III-D. Exercice 4
IV. Chapitre VIII. Structures de programmation en Pascal
IV-A. Exercice 1
IV-B. Exercice 2
V. Chapitre XIII. Fichiers
V-A. Exercice 1
V-B. Exercice 2
VI. Chapitre XV. Manipulation de types abstraits de données
VI-A. Exercice 1
VII. Chapitre XVI. Programmation à l'aide d'objets
VII-A. Exercice 1

I. Chapitre V. Pascal Objet : première partie

I-A. Exercice 1

Aller au sujet de l'exercice

(2 + 4.1) / (-2 - 4)
un type entier ne convient pas du fait de la division. Le type de résultat est donc à virgule flottante, et probablement 'single'.

I-B. Exercice 2

Aller au sujet de l'exercice

Le résultat est 1. C'est un effet du type de donnée 'word' qui autorise les valeurs entières entre 0 et 65535. Si on avait aditionné 65535 et 1, on aurait trouvé 0.

L'amplitude du type étant de 65536 (65535 - 0 + 1), on effectue un modulo (le reste de la division entière) sur le vrai résultat pour avoir le résultat informatique. Ainsi 65535 + 2 = 65537 et 65537 modulo 65536 vaut 1.

Pour ceux qui connaissent la numérotation binaire (et seulement pour eux), la vraie raison de ce modulo est la suivante : une donnée de type 'word' est stockée dans l'ordinateur par 16 chiffres binaires. Ainsi, 65535 vaut 1111111111111111. Si on ajoute 2, on obtient 10000000000000001, mais qui est tronqué à 16 chiffres, soit 0000000000000001 qui vaut 1.

I-C. Exercice 3

Aller au sujet de l'exercice

'Cursor' est de type énuméré, les valeurs possibles représentent les différents pointeurs standards de Windows. Il est à noter que cette propriété n'est pas à changer sans une bonne raison.
Height est de type 'integer', bien que les valeurs négatives soient interceptées et rejetées par Delphi.
Hint est de type 'string'. Vous pouvez taper n'importe quel texte qui sera affiché dans une bulle d'aide lorsque la souris passera sur le composant.
ShowHint est de type 'boolean'. Il permet d'activer ou de désactiver la bulle d'aide pour le composant.

I-D. Exercice 4

Aller au sujet de l'exercice

«: test1 » est valide.
«: 1_test » n'est pas valide, à cause du premier caractère qui ne peut pas être un chiffre.
«: test 1 » n'est pas valide, les espaces sont interdits.
«: test-1 » n'est pas valide, les tirets (-) sont interdits.
«: test_1 » est valide.
«: TEST_2 » est valide.

II. Chapitre VI. Procédures et fonctions

II-A. Exercice 1

Aller au sujet de l'exercice

1 - La fonction VolumeCyl doit effectuer directement tous les calculs, donc on substitue intelligemment son contenu dans VolumeCylindre. On obtient :


function VolumeCyl(RayonBase, Hauteur: Single): Single;
begin
  Result := PI * RayonBase * RayonBase * Hauteur;
end;

Et c'est tout : il a suffi de recopier la formule en utilisant le paramètre RayonBase.

2 - Pour calculer le périmètre d'un cercle, nous n'avons besoin que d'un seul renseignement : le rayon ou le diamètre. Pour rester dans l'esprit de ce qui a déjà été fait, nous prendrons le rayon. Le seul paramètre de la fonction sera donc Rayon, de type Single, et renverra un résultat de type Single. La fonction effectuera tout simplement une multiplication prenant en compte le rayon et dont le résultat est affecté directement à Result. Voici cette fonction :


function PerimetreCercle(Rayon: Single): Single;
begin
  result := 2 * PI * Rayon;
end;

La fonction SurfaceCyl devra faire appel à AireDisque et PerimetreCercle, il faudra donc l'écrire après ces deux dernières. L'aire totale se divise en deux : la surface des deux disques et la surface latérale qui s'obtient en multipliant la hauteur du cylindre par le périmètre du cercle de base (c'est en fait l'aire d'un simple rectangle "tordu", expression qui ne manquera pas de faire grimacer les matheux). L'opération à effectuer, dans un langage non informatique, est :
Surface = AireDisque x 2 + PerimetreCercle x Hauteur
Les paramètres nécessaires sont la hauteur et le rayon de la base, tous deux de type Single. Le résultat de la fonction sera aussi de type Single. Voici enfin cette fonction :


function SurfaceCyl(Hauteur, RayonBase: Single): Single;
begin
  result := 2 * AireDisque(RayonBase) + 
    PerimetreCercle(RayonBase) * Hauteur;
end;

Vous remarquerez que l'instruction, trop longue pour tenir sur une ligne dans ce guide, a été coupée en deux, à un endroit correct, c'est-à-dire à un endroit où un blanc étant possible. Il est possible de découper une instruction en plusieurs lignes, en insérant les sauts de lignes là où l'on aurait pû mettre un espace par exemple, ce qui est le cas ci-dessus.

III. Chapitre VII. Types de données avancés de Pascal Objet

III-A. Exercice 1

Aller au sujet de l'exercice

Un bloc type se déclare toujours avec le mot réservé correspondant. Le premier type à définir est une chaîne de caractère de 200 caractères. On utilise donc la syntaxe donnée au chapitre 5 :
string[200]
Le deuxième type à définir est un équivalent du type integer. Le nouveau type sera donc une sorte de synonyme de integer. Voici le code source répondant à l'exercice :


type
  TChaine200 = string[200];
  TEntier = integer;

III-B. Exercice 2

Aller au sujet de l'exercice

Nous appelerons TJourSemaine ce nouveau type énuméré. Les valeurs seront toutes nommées en utilisant le préfixe "js" qui permet de se rappeler, lorsqu'on en voit un, du type associé (TJourSemaine). Voici une proposition de bloc type à écrire :


type
  TJourSemaine =
    (jsLundi, jsMardi, jsMercredi, jsJeudi, jsVendredi, jsSamedi, jsDimanche);

(Vous aurez certainement remarqué qu'un retour à la ligne et quelques espaces ont été insérés après le signe "=" : c'est tout à fait permis à beaucoup d'endroits et ceci permet d'aèrer le code ou de permettre de faire tenir tout un texte sur une ligne, comme dans le cas présent)

Le reste de l'exercice est très semblable à ce qui est fait juste avant l'exercice dans le chapitre 5. Pour cette raison, j'y ai ajouté une petite difficulté : ne pas utiliser de variable temporaire pour stocker la valeur ordinale de "Jour". La solution est d'utiliser ce qui est affecté à cette variable temporaire à sa place. Voici donc les deux versions, avec puis sans variable intermédiaire :


procedure TForm1.Button1Click(Sender: TObject);
type
  TJourSemaine =
    (jsLundi, jsMardi, jsMercredi, jsJeudi, jsVendredi, jsSamedi, jsDimanche);
var
  Jour: TJourSemaine;
  I: Byte; { avec variable intermédiaire }
begin
  Jour := jsMardi;
  I := Ord(Jour);
  ShowMessage(IntToStr(I));
end; 

procedure TForm1.Button1Click(Sender: TObject);
type
  TJourSemaine =
    (jsLundi, jsMardi, jsMercredi, jsJeudi, jsVendredi, jsSamedi, jsDimanche);
var
  Jour: TJourSemaine;
{ sans variable intermédiaire }
begin
  Jour := jsMardi;
  ShowMessage(IntToStr(Ord(Jour)));
end;

Dans notre cas, la valeur affichée sera donc la valeur ordinale de jsMardi, qui est le deuxième identificateur déclaré dans TJourSemaine, soit la valeur 1.

III-C. Exercice 3

Aller au sujet de l'exercice

Le type tableau de chaînes de caractères, indexé de 1 à 10, s'écrit :


array[1..10] of string

Déclarer ce type ne doit pas poser de problème, de même que déclarer la variable de ce type. Pour initialiser une case du tableau, il faut faire suivre le nom de cette variable du numéro de la case entre crochets, ce qui permet d'utiliser la case et non le tableau. Chaque case, rappelez-vous le, est de type chaîne : on affecte donc une chaîne à cette case.

L'affichage du contenu de cette case se fait avec ShowMessage. La chaîne à afficher est dans la case initialisée auparavant. On utilise la même syntaxe que ci-dessus pour y accèder. Voici un code source répondant aux exigences de l'exercice :


procedure TForm1.Button1Click(Sender: TObject);
type
  TTabChaine = array[1..10] of string;
var
  Chaines: TTabChaine;
begin
  Chaines[4] := 'Bonjour';
  ShowMessage(Chaines[4]);
end;

vous pouvez également déclarer une variable temporaire S, lui affecter la valeur de Chaines[4], puis afficher S, mais c'est parfaitement inutile, comme le montre le code ci-dessus.

III-D. Exercice 4

Aller au sujet de l'exercice

le tableau utilise en guise d'indices le type TJourSemaine (type énuméré). Le type de chaque case est string. Voici le type correspondant :


array[TJourSemaine] of string

De deux choses l'une, soit nous déclarons un nouveau type (TJourChaines par exemple) et nous utilisons TJourChaines pour déclarer la constante, soit nous déclarons directement la constante avec le type décrit ci-dessus. Pour nous entraîner à déclarer des types, nous opterons pour la première solution, plus longue.

Voici la déclaration du type et de la constante :


type
  TJourSemaine =
    (jsLundi, jsMardi, jsMercredi, jsJeudi, jsVendredi, jsSamedi, jsDimanche);
  TJourChaines = array[TJourSemaine] of string;
const
  NomsDesJours: TJourChaines =
    ('Lundi', 'Mardi', 'Mercredi', 'Jeudi', 'Vendredi', 'Samedi', 'Dimanche');

La constante NomsDesJours est donc un tableau de chaînes, indicées par le type TJourSemaine. Chaque chaîne est contenue dans une case indicée par une valeur correspondante de type TJourSemaine. NomsDesJours[jsLundi], par exemple, est une chaîne et vaut 'Lundi'. Avec ces explications, il devient facile de réécrire la procédure en répondant à la question 2 :


procedure TForm1.Button1Click(Sender: TObject);
type
  TJourSemaine =
    (jsLundi, jsMardi, jsMercredi, jsJeudi, jsVendredi, jsSamedi, jsDimanche);
  TJourChaines = array[TJourSemaine] of string;
const
  NomsDesJours: TJourChaines =
    ('Lundi', 'Mardi', 'Mercredi', 'Jeudi', 'Vendredi', 'Samedi', 'Dimanche');
var
  Jour: TJourSemaine;
begin
  Jour := jsMardi;
  ShowMessage(NomsDesJours[Jour]);
end;

Voici ce qu'affiche le programme lorsqu'on clique sur l'habituel bouton de test :

IV. Chapitre VIII. Structures de programmation en Pascal

IV-A. Exercice 1

Aller au sujet de l'exercice

Réalisation pas à pas : Suivez ces étapes si vous êtes en difficulté :

1 - La première étape va être de demander le nombre à l'utilisateur, car on ne peut absolument rien faire sans ce nombre. Pour cela, il nous faut utiliser 'InputQuery'. Cette fonction, on l'a déjà vu, a besoin de 3 paramètres : les deux premiers peuvent être des constantes chaînes mais le troisième doit être une variable. Il va donc nous falloir une variable.

2 - Déclarons donc cette variable :


var
  Reponse: string;

3 - Ecrivons ensuite l'instruction qui appelle 'InputQuery' :


InputQuery('Racine carrée', 'Entrez un nombre', Reponse);

4 - Il va cependant y avoir un petit problème : les plus attentifs d'entre vous se rappelent certainement avoir lu que la valeur de la variable transmise en tant que troisième paramètre ('Reponse') est utilisée comme texte par défaut dans la boite de dialogue. Si cette chaîne contient des caractères étranges, ce sera du plus mauvais effet, il faut donc initialiser la variable 'Reponse' avant de l'utiliser avec 'InputQuery'. Voici l'initialisation de 'Reponse' (qui ne devrait normalement pas vous poser le moindre problème) :


Reponse := '0';

5 - Après l'exécution de ces deux premières instructions, on se retrouve avec une réponse sous forme de chaîne de caractères, tout à fait inutilisable sous sa forme actuelle. Il faut transformer cette réponse en un nombre. Pour cela, on utilise 'StrToFloat' (qui, soit dit en passant, est appelée comme 'IntToStr' et 'FloatToStr' mais avec un paramètre chaîne). Avant d'écrire cette instruction, on peut se poser la question : « où va être stocké le résultat de cette conversion ? ». la réponse est bien entendu « dans une variable ». Cette variable doit être de type 'extended', on la nomme 'NbTest'. L'instruction est alors :


NbTest := StrToFloat(Reponse);

6 - A partir de ce point, on peut enfin faire un test sur la valeur de cette variable 'NbTest' et réagir en conséquence. On utilisera alors un bloc if. La condition, donnée de façon presque explicite dans le texte du problème, est (X < 0). Voici le squelette de l'instruction :


if X < 0 then
  instruction si X < 0
else
  instruction sinon (si X >= 0);

7 - L'instruction à exécuter si (X < 0) est un appel à 'ShowMessage' en indiquant que les nombres négatifs n'ont pas de racine carrée (réelle, du moins...). Cette instruction sera :


ShowMessage('Pas de racine carrée pour les nombres négatifs')

A noter qu'on ne la termine pas par un point-virgule (;) (un point-virgule terminera le bloc if qui constitue, je le rappelle, une seule instruction).

8 - Si par contre le nombre est positif ou nul, calculer sa racine carrée est possible. Dans ce cas, on effectue le calcul :


sqrt(NbTest)

On convertit directement le résultat en chaîne de caractères :


FloatToStr(sqrt(NbTest))

Et on affiche cette chaîne au milieu d'un message (ce qui constitue l'instruction complète :


ShowMessage('La racine carrée est ' + FloatToStr(sqrt(NbTest)))

On peut même améliorer cette instruction de cette manière (en indiquant le nombre et sa racine carrée dans le message) :


ShowMessage('La racine carrée de ' + FloatToStr(NbTest) + ' est ' + FloatToStr(sqrt(NbTest)))

En définitive, l'instruction contenant le bloc if est :


if NbTest < 0 then
  ShowMessage('Pas de racine carrée pour les nombres négatifs')
else
  ShowMessage('La racine carrée de ' + FloatToStr(NbTest) + ' est ' + FloatToStr(sqrt(NbTest)));

9 - Voilà, toutes les instructions sont écrites, il ne reste plus qu'à regarder le résultat final dans la solution ci-dessous.

Solution : Voici l'une des nombreuses solutions possibles :


procedure TForm1.Button1Click(Sender: TObject);
var
  Reponse: string;
  NbTest: extended;
begin
  { initialisation de Reponse }
  Reponse := '0';
  { demande d'un nombre }
  InputQuery('Racine carrée', 'Entrez un nombre', Reponse);
  { transformation de cette réponse en nombre }
  NbTest := StrToFloat(Reponse);
  { deux cas, utilisation d'un 'if' }
  if NbTest < 0 then
    { nombre négatif, pas de racine carrée }
    ShowMessage('Pas de racine carrée pour les nombres négatifs')
  else
    { calcul et affichage de la racine carrée }
    ShowMessage('La racine carrée de ' + FloatToStr(NbTest) + ' est ' + FloatToStr(sqrt(NbTest)));
end;

Lors du lancement du logiciel, un clic sur le bouton affiche ce qui suit :

Lorsqu'on rentre, par exemple, 10, voici ce qui apparaît alors :

IV-B. Exercice 2

Aller au sujet de l'exercice

Cet exercice est plus délicat que le précédent : il teste vos acquis sur les fonctions ainsi que sur les blocs if. Pour chacune des questions, une solution est donnée, qui est suivie de commentaires comprenant des erreurs possibles.

Concernant tout d'abord la procédure 'TForm1.Button1Click', voici le code source utilisé :


procedure TForm1.Button1Click(Sender: TObject);
var
  NbTest: extended;
begin
  NbTest := 0;
  ShowMessage('Le nombre est ' + NbNegatif(NbTest));
end;

Dans les autres questions, seule l'appel de 'NbNegatif' changera. Cette procédure ressemble trait pour trait à d'autres que nous avons déjà étudié : une variable de type 'extended' (on n'a pas précisé quel nombre on voulait manipuler, mieux vaut dans ce cas manipuler ce qu'on a de plus large). Cette variable est initialisée (c'est cette valeur que vous devez changer pour tester les divers cas de figure).

1 - Voici une solution (et non pas la solution, la vôtre peut être différente mais bonne)


function NbNegatif(X: extended): string;
begin
  if X < 0 then
    result := 'négatif'
  else
    result := 'positif';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  NbTest: extended;
begin
  NbTest := 0;
  ShowMessage('Le nombre est ' + NbNegatif(NbTest));
end;

Notez bien que la fonction a été écrite avant la procédure, pour être reconnue par cette dernière sans avoir besoin d'une déclaration dans l'interface de l'unité.
D'après le texte de la question, il va falloir faire un test sur le paramètre (que l'on notera 'X'), et réagir différement suivant deux situations : soit le nombre est strictement négatif, soit il ne l'est pas. La fonction comporte donc une seule instruction qui est un bloc if assez simple : le test (X < 0) décide de quelle instruction va être exécutée. Dans chaque situation, il nous faut donner un résultat à la fonction : ceci se fait en donnant une valeur à 'result'.

2 - Voici une solution possible :


function SigneNombre(X: extended): string;
begin
  if X < 0 then
    result := 'négatif'
  else if X > 0 then
    result := 'positif'
  else
    result := 'zéro';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  NbTest: extended;
begin
  NbTest := 1;
  ShowMessage('Le nombre est ' + SigneNombre(NbTest));
end;

Ici, il faut également donner une réponse différente, mais avec 3 cas possibles. On utilise donc deux blocs if imbriqués l'un dans l'autre. Le premier cas (X < 0) est la condition du premier bloc if. L'instruction correspondante au cas où (X < 0) n'est pas respecté traite donc le cas (X >= 0). Le second bloc if permet de séparer ce cas en deux, d'une part si (X > 0) et enfin d'autre part si (X = 0). Dans chaque cas, 'result' est initialisé en accord avec ce qu'on sait de X.

V. Chapitre XIII. Fichiers

V-A. Exercice 1

Aller au sujet de l'exercice

Indications :

Vous aurez besoin de deux variable-fichiers, une pour la source, l'autre pour la destination.
La copie est entourée des trois étapes habituelles, en double car deux fichiers sont ouverts. Attention aux modes d'ouverture de chaque fichier.
Utilisez une boucle "while" jusqu'à épuisement des lignes du fichier source. A chaque étape, effectuez au passage une écriture dans le fichier destination.

Corrigé :

La première étape consiste à vérifier l'existence du fichier source et la non existence du fichier destination. Pour cela, on utilise AssignFile et exit. Result est initialisé à false avant le test pour que la fonction renvoie faux si le test échoue. A la fin de la fonction, Result est à nouveau fixé à True.


function CopyFichTexte(Src, Dest: string): boolean;
begin
  result := false;
  if not FileExists(Src) or FileExists(Dest) then exit;
  result := true;
end;

La deuxième étape consiste à déclarer deux variables fichiers et à écrire les trois étapes de base de leur utilisation. Le fichier source est à ouvrir en lecture seule avec Reset, tandis que le fichier destination est à ouvrir en écriture seule avec Rewrite. Voici la suite du code :


function CopyFichTexte(Src, Dest: string): boolean;
var
  SrcText, DestText: TextFile;
  tmpS: string;
begin
  result := false;
  if not FileExists(Src) or FileExists(Dest) then exit;
  AssignFile(SrcText, Src);
  AssignFile(DestText, Dest);
  Reset(SrcText);
  Rewrite(DestText);
  { copie à programmer ici }
  CloseFile(DestText);
  CloseFile(SrcText);
  result := true;
end;

La troisième étape consiste à faire la copie du fichier. Pour cela, on utilise une boucle while qui lit une ligne et l'écrit aussitôt. La boucle s'arrète lorsque le fichier source ne contient plus de lignes à copier. Voici le code complet de la fonction de copie :


function CopyFichTexte(Src, Dest: string): boolean;
var
  SrcText, DestText: TextFile;
  tmpS: string;
begin
  result := false;
  if not FileExists(Src) or FileExists(Dest) then exit;
  AssignFile(SrcText, Src);
  AssignFile(DestText, Dest);
  Reset(SrcText);
  Rewrite(DestText);
  while not Eof(SrcText) do
    begin
      Readln(SrcText, tmpS);
      Writeln(DestText, tmpS);
    end;
  CloseFile(DestText);
  CloseFile(SrcText);
  result := true;
end;

La deuxième fonction à écrire, CopyFichTexteDemi, est une adaptation de la précédente destinée à vous faire manipuler une variable et à en tenir compte dans votre programmation. Nous allons utiliser une variable Cptr de type integer. Cette variable nous permettra de compter les lignes lues et de n'effectuer l'écriture que sous une condition sur Cptr. Il faudra tout d'abord penser à initialiser Cptr à 0 (0 lignes lues) avant de lancer la copie. Après chaque lecture, et avant l'écriture, il faudra incrémenter Cptr. L'écriture sera faite dans un bloc if. Les valeurs impaires de Cptr devant permettre l'écriture, la condition à vérifier sera :


Cptr mod 2 = 1

Notez que dans le code ci-dessus, les parenthèses sont inutiles car l'opérateur mod est prioritaire sur l'opérateur = . Voici la fonction :


function CopyFichTexteDemi(Src, Dest: string): boolean;
var
  SrcText, DestText: TextFile;
  tmpS: string;
  cptr: integer;
begin
  result := false;
  if not FileExists(Src) or FileExists(Dest) then exit;
  AssignFile(SrcText, Src);
  AssignFile(DestText, Dest);
  Reset(SrcText);
  Rewrite(DestText);
  cptr := 0;
  while not Eof(SrcText) do
    begin
      Readln(SrcText, tmpS);
      cptr := cptr + 1;
      if cptr mod 2 = 1 then
        Writeln(DestText, tmpS);
    end;
  CloseFile(DestText);
  CloseFile(SrcText);
  result := true;
end;

V-B. Exercice 2

Aller au sujet de l'exercice

Cet exercice est bien plus complet que tout ce que vous avez créé jusqu'à présent. Il faudra faire preuve d'organisation car le code source va avoir tendance à allonger.

Réponse aux questions :

1 - Pour écrire une telle procédure, il faut tout d'abord bien repèrer ce qu'il faut y faire : générer aléatoirement des nombres et les utiliser pour choisir un nom, un prénom, le sexe correspondant, et enfin l'âge, en fonction de ces nombres. La première étape est donc de déclarer un certain nombre de constantes qui permettront d'obtenir toutes les informations depuis la fonction qui générera la personne. Voici ce que je vous propose :


const
  NbPrenoms = 6;
  TabPrenoms: array[1..NbPrenoms] of string =
    ('Jean', 'Jacques', 'Marie', 'Claire', 'Pierre', 'Anne');
  TabSexes: array[1..NbPrenoms] of boolean =
    (true, true, false, false, true, false);
  NbNoms = 4;
  TabNoms: array[1..NbNoms] of string =
    ('Legrand', 'Lepetit', 'Legros', 'Leneuf');
  AgeMin = 20;
  AgeMax = 70;

Tout d'abord, une constante "NbPrenoms" fixe le nombre de prénoms donnés. La constante "TabPrenoms" est une constante tableau de chaînes de caractères donnant les prénoms possibles. La même chose est faite avec "NbNoms" et "TabNoms". "TabSexes" est un tableau indicé de la même manière que "TabPrenoms" : chaque case indique quel sexe est associé avec le prénom dans la case avec le même indice dans "TabPrenoms". Enfin, "AgeMin" et "AgeMax" permettent de spécifier une fourchette dans laquelle les âges doivent être générés.

Venons-en maintenant à la fonction "GenerePersonneAlea". Cette fonction utilisera une variable "tmp" de type entier pour stocker un nombre aléatoire choisi entre deux bornes. Ce nombre sera utilisé ensuite pour fixer une ou plusieurs valeurs de la personne à générer. En ce qui concerne justement cette personne, on peut utiliser directement "Result" qui est de type TPersonne. Voici la première partie de la fonction, qui choisit un nom pour la personne :


tmp := Trunc(Random(NbNoms)) + 1;
Result.Nom := TabNoms[tmp];

"tmp" est d'abord fixé à une valeur entière entre 0 et (NbNoms - 1), puis on lui ajoute 1 pour avoir une valeur entre 1 et NbNoms. Cette valeur est alors utilisée comme indice dans le tableau TabNoms et le nom contenu dans la case indicée est écrit dans le champ Nom de Result.

De même, on génére le prénom. Le sexe est déterminé en réutilisant "tmp" dans le tableau "TabSexes" :


tmp := Trunc(Random(NbPrenoms)) + 1;
Result.Prenom := TabPrenoms[tmp];
Result.Homme := TabSexes[tmp];

Enfin, l'âge est déterminé par une formule assez simple à comprendre. On génére un nombre compris entre AgeMin et AgeMax :


Result.Age := Trunc(Random(AgeMax - AgeMin + 1)) + AgeMin;

Voici donc la fonction complète :


function GenerePersonneAlea: TPersonne;
var
  tmp: Integer;
begin
  tmp := Trunc(Random(NbNoms)) + 1;
  Result.Nom := TabNoms[tmp];
  tmp := Trunc(Random(NbPrenoms)) + 1;
  Result.Prenom := TabPrenoms[tmp];
  Result.Homme := TabSexes[tmp];
  Result.Age := Trunc(Random(AgeMax - AgeMin + 1)) + AgeMin;
end;

2 - Encore une fois, avant de vous lancer tête baissée dans l'écriture du code, il faut réfléchir un minimum : que va faire au juste la procédure qu'on nous demande d'écrire : ouvrir un fichier, en testant éventuellement son existence, et écrire dedans autant de fois que demandé, sans oublier de refermer le fichier à la fin. Il va nous falloir une variable pour le fichier, une variable temporaire pour stocker chaque personne générée et à écrire dans le fichier. Enfin, il nous faudra une variable compteur pour faire une bouble entre 1 et le nombre de personnes à écrire. Voici le début de la procédure :


procedure GenereFichierSeq(NombrePersonne: Integer);
var
  indx: integer;
  tempF: TPersFich;
  Pers: TPersonne;
begin
  AssignFile(tempF, FichierTest);
  if FileExists(FichierTest) then
    Reset(tempF)
  else
    Rewrite(tempF);

Cet extrait de code déclare les variables nécessaires, et ouvre le fichier suivant qu'il existe ou non. On peut dés à présent écrire la fin de la procédure, qui fermera simplement le fichier ouvert :


 CloseFile(tempF);
end;

entre les deux, il faut d'abord vider le fichier :


Seek(tempF, 0); Truncate(tempF);

Ensuite, l'écriture se fait à l'intérieur d'une boucle for : une personne est générée aléatoirement par l'appel à GenerePersonneAlea, puis cette personne est écrite dans le fichier par l'appel de la procédure "Write" :


for indx := 1 to NombrePersonne do
  begin
    Pers := GenerePersonneAlea;
    Write(tempF, Pers);
  end;

3 - La procédure "AffichePersone" est la plus simple de cet exercice : on concatène simplement une représentation des 4 renseignements sur une personne et on affiche le résultat. Voici cette procédure :


function AffichePersonne(Pers: TPersonne): String;
const
  Genres: array[boolean] of string = ('Femme', 'Homme');
begin
  Result := Pers.Nom + ' ' + Pers.Prenom + ' : ' +
            Genres[Pers.Homme] + ' de ' + IntToStr(Pers.Age) + ' ans.';
end;

4 - La déclaration de la procédure "TraiteFichierSeq" ne devrait pas vous poser de problèmes, puisqu'elle est expliquée dans l'énoncé :


procedure TraiteFichierSeq(Liste: TListBox; AgeMinimum: Integer);

Le paramètre "Liste" est à considérer comme n'importe quel autre objet de classe "TListBox". Ainsi, la première étape qui consiste à vider la liste, s'écrit en appelant la méthode Clear de la propriété Items du composant "Liste" :


Liste.Items.Clear;

Ensuite, il nous faut tester l'existence du fichier de personnes : s'il n'existe pas, il est impossible d'effectuer le filtrage et on n'a d'autre choix que de quitter la procédure. Voici ce que cela donne :


if not FileExists(FichierTest) then
  exit; { impossible de traiter le fichier s'il n'existe pas }

Lorsque cette étape est passée, on peut enfin passer à l'ouverture du fichier : celle-ci se fait avec un "Reset" car on est certain que le fichier existe. On se positionne, par sécurité, au tout début du fichier.


AssignFile(tempF, FichierTest);
Reset(tempF);
Seek(tempF, 0);

Une fois le fichier ouvert, on lance une boucle qui lit le fichier enregistrement par enregistrement. Cette lecture se termine lorsqu'on atteint la fin du fichier. A chaque itération, on lit un enregistrement. Si cet enregistrement correspond au critère d'affichage (âge lu >= âge minimum), on ajoute une ligne à la liste transmise. La chaîne ajoutée est obtenue en appelant la fonction "AffichePersonne" écrite à cet effet auparavant.


while not eof(tempF) do
  begin
    Read(tempF, Pers);
    if Pers.Age >= AgeMinimum then
      Liste.Items.Add(AffichePersonne(Pers));
  end;

Enfin, on ferme le fichier.


CloseFile(tempF);

5 - Rien à ajouter sur la création de l'interface, si vous avez un problème, téléchargez la version proposée en fin de correction. La procédure qui est éxécutée lors d'un clic sur le bouton "Quitter" contient simplement une instruction "Close;".

6 - Voici la procédure "btGenTestClick" qui répond à la première partie de la question :


procedure TfmPrinc.btGenTestClick(Sender: TObject);
begin
  GenereFichierSeq(100);
end;

La deuxième procédure n'est pas tellement plus compliqué à programmer. L'appel à "TraiteFichierSeq" se fait en donnant "lbResuFiltre" comme premier paramètre, et "StrToInt(edAge.Text)" comme second (on se permet ici de ne pas faire de tests, mais ce n'est pas une habitude à prendre). L'affichage du nombre de personnes ajoutées à la liste se fait en transmettant le nombre d'éléments de la zone de liste à "IntToStr" puis "ShowMessage".


procedure TfmPrinc.btFiltreClick(Sender: TObject);
begin
  TraiteFichierSeq(lbResuFiltre, StrToInt(edAge.Text));
  ShowMessage('Nombre de personnes : ' + IntToStr(lbResuFiltre.Items.Count));
end;

Téléchargement du projet complet : sequentiel.zip

VI. Chapitre XV. Manipulation de types abstraits de données

VI-A. Exercice 1

Aller au sujet de l'exercice

La fonction de comptage des éléments doit d'abord vérifier que la liste ne vaut pas nil. Ensuite, si la liste est vide, aucun traitement n'est fait et la fonction se termine. Pour que la fonction puisse toujours retourner un résultat valide, on renverra -1 pour une liste incorrecte et n pour une liste contenant n élémens. Un parcours en commençant par Liste^.Dbt et en utilisant ensuite les pointeurs Suiv des maillons permet de compter les éléments. Voici le code source correspondant :


{ retourne le nombre d'éléments dans une liste }
function LCTNbElem(Liste: TListeChaineeTriee): integer;
var
  Posi: PMaillon;
begin
  result := -1;
  if Liste = nil then exit;
  result := 0;
  if LCTVide(Liste) then exit;
  // Posi pointe sur le premier élément, non encore compté
  Posi := Liste^.Dbt;
  // l'élément Posi va parcourir la liste. Tant qu'il est valide
  while Posi <> nil do
    begin
      // on compte l'élément en cours (y compris le premier)
      inc(result);
      // et on passe à l'élément suivant
      Posi := Posi^.Suiv;
    end;
end;

La procédure de suppression d'une liste doit, après avoir testé la validité de la liste, réaliser dans tâches dans le bon ordre :

Supprimer les maillons et la mémoire associée avec les éléments de type TPersonne qu'ils pointent
Libèrer la mémoire associée à la liste elle-même.

Pour cela, on fait appel à LCTSupprIdx en supprimant toujours le premier élément, ce qui est avantageux connaissant la manière dont opére LCTSupprIdx (notez qu'à ce niveau, on a le droit de tenir compte du code source des autres opérations). Voici un code source possible :


{ destruction complète d'une liste }
procedure LCTDetruire(Liste: TListeChaineeTriee);
begin
  if Liste = nil then exit;
  // destruction des maillons
  while not LCTVide(Liste) do
    Liste := LCTSupprIdx(Liste, 0);
  // libération de la mémoire associée à la liste
  Dispose(Liste);
end;

Une boucle supprime le premier élément tant que la liste n'est pas vide. Une fois cette condition réalisée, la mémoire associée à la liste est libérée. Quant à la procéure d'affichage du contenu de la liste, elle se contente, après initialisation de la sortie, et vérification de la liste, de réaliser un parcours en affichant chaque personne présente dans la liste.


{ affichage du contenu d'une liste }
procedure AfficheListe(Liste: TListeChaineeTriee; Sortie: TStrings);
var
  Posi: PMaillon;
begin
  Sortie.Clear;
  if Liste = nil then exit;
  // Si la liste est vide
  if Liste^.Dbt = nil then
    Sortie.Add('(liste vide)')
  else
    begin
      // initialisation du parcours de la liste
      Posi := Liste^.Dbt;
      repeat
        // pour chaque élément trouvé, affichage
        Sortie.Add(AffichPers(Posi^.Elem));
        // et passage à l'élément suivant
        Posi := Posi^.Suiv;
      // on s'arrète dés que Posi devient invalide
      until Posi = nil;
    end;
end;

VII. Chapitre XVI. Programmation à l'aide d'objets

VII-A. Exercice 1

Aller au sujet de l'exercice

Les éléments à ajouter sont au nombre de 6 : 2 déclarations de propriétés et 4 déclarations de méthodes servant d'accesseurs pour les propriétés. Les nouvelles déclarations ont été mises en évidence ci-dessous :


 AppareilAEcran = class
  private
    fPoids: integer;
    fLongueur_Diagonale: integer;
    fAllume: boolean;
    function getPoids: integer;
    procedure setPoids(valeur: integer);
    function getAllume: Boolean;                       // Ajouté
    function getLongueur_Diagonale: integer;           // Ajouté
    procedure setAllume(Value: Boolean);               // Ajouté
    procedure setLongueur_Diagonale(Value: integer);   // Ajouté
  public
    procedure allumer;
    procedure eteindre;
    constructor Create; virtual;
    destructor Destroy; override;
    property Poids: integer
      read getPoids
      write setPoids;
    property Longueur_Diagonale: integer               // Ajouté
      read getLongueur_Diagonale                       // Ajouté
      write setLongueur_Diagonale;                     // Ajouté
    property Allume: Boolean                           // Ajouté
      read getAllume                                   // Ajouté
      write setAllume;                                 // Ajouté
  end;

Voici le code source des 4 méthodes réalisant les accès en lecture/écriture des propriétés :


function AppareilAEcran.getAllume: Boolean;
begin
  Result := fAllume;
end;

function AppareilAEcran.getLongueur_Diagonale: integer;
begin
  Result := fLongueur_Diagonale;
end;

procedure AppareilAEcran.setAllume(Value: Boolean);
begin
  if Value <> fAllume then
    begin
      if fAllume then
        eteindre
      else
        allumer;
    end;
end;

procedure AppareilAEcran.setLongueur_Diagonale(Value: integer);
begin
  if Value >= 0 then
    fLongueur_Diagonale := Value;
end;

Copyright © 2000 F.Beaulieu. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.