Essayez de le faire - Devoir tayara!

Voir le sujet précédent Voir le sujet suivant Aller en bas

Essayez de le faire - Devoir tayara!

Message  Hanafi le Ven 5 Déc - 16:33





avatar
Hanafi

Messages : 106
Date d'inscription : 25/10/2008

Voir le profil de l'utilisateur

Revenir en haut Aller en bas

RE

Message  Saafi RAMI le Mer 17 Déc - 19:18

Exercice 1
1) Il manque la condition d'arret
2)il faut ajouter au programme
si n > 0 alors

Exercice 2
function McCarthy (n:integer): integer;
begin
if n>100 then
McCarthy:= n-10
else
McCarthy:=McCarthy (n+11);
end;
avatar
Saafi RAMI

Messages : 37
Date d'inscription : 16/10/2008
Age : 27

Voir le profil de l'utilisateur http://www.imraude.skyrock.com

Revenir en haut Aller en bas

Re: Essayez de le faire - Devoir tayara!

Message  Ilyes KHAILI le Sam 27 Déc - 20:43

Bon travail RAMI


Dernière édition par Ilyes KHAILI le Dim 28 Déc - 0:49, édité 1 fois

Ilyes KHAILI

Messages : 24
Date d'inscription : 13/11/2008
Age : 27

Voir le profil de l'utilisateur

Revenir en haut Aller en bas

Re: Essayez de le faire - Devoir tayara!

Message  Ilyes KHAILI le Sam 27 Déc - 20:46

bonjour everybody cheers
bon travail Rami,
voici ma solution du problème et j'espère qu'elle est correcte Cool :
program restaurant;
uses wincrt;
type
repas=record
num:1..20;
nom:string[20];
prix:real;
end;
fiche=file of repas;
var
r:repas;
f:fiche;
c:text;
choix:char;
p:string;

function admin(p:string):boolean;
var
pw:text;
pas:string;
begin
assign(pw,'c:\pw.txt');
reset(pw);
read(pw,pas);
admin:=pas=p;
end;

procedure creer(var f:fiche);
var
n,i:integer;
begin
rewrite(f);
write('Donner le nombre des repas : ');readln(n);
for i:=1 to n do
begin
write(' -Repas N°',i,' : ');readln;
with r do
begin
write('Donner le numéro du repas : ');readln(num);
write('Donner le nom du repas : ');readln(nom);
write('Donner le prix du repas : ');readln(prix);
end;
write(f,r);
end;
close(f);
end;

procedure modifrepas(var f:fiche);
var
nmr:1..20;
existe:boolean;
begin
write('Donner le numéro du repas a modifier : ');readln(nmr);
existe:=false;
reset(f);
while (not eof(f))and(not existe) do
begin
read(f,r);
existe:=r.num=nmr;
end;
if existe then
begin
seek(f,filepos(f)-1);
with r do
begin
write('Donner le numéro du repas : ');readln(num);
write('Donner le nom du repas : ');readln(nom);
write('Donner le prix du repas : ');readln(prix);
end;
write(f,r);
end
else
write('Repas inexistant.');
readln;
end;

procedure affcommande(var c:text);
var
com:string;
begin
reset(c);
while not eof(c) do
begin
readln(c,com);
writeln(com);
end;
readln;
end;

procedure afficher(var f:fiche);
begin
reset(f);
while not eof(f) do
begin
read(f,r);
with r do
begin
writeln('Le numéro du repas est : ',num);
writeln('Le nom du repas est : ',nom);
writeln('Le prix du repas est : ',prix:0:3);
end;
end;
close(f);
readln;
end;

procedure affmax(var f:fiche);
var
max:real;
begin
write('Donner le prix maximal : ');readln(max);
reset(f);
while not eof(f) do
begin
read(f,r);
writeln;
if max>=r.prix then
with r do
begin
writeln('Le numéro du repas est : ',num);
writeln('Le nom du repas est : ',nom);
writeln('Le prix du repas est : ',prix:0:3);
end;
end;
close(f);
readln;
end;

function test(var f:fiche;nm:string):boolean;
var
t:boolean;
begin
reset(f);
t:=false;
while (not eof(f))and(not t) do
begin
read(f,r);
t:=r.nom=nm;
end;
test:=t;
end;

procedure commande(var f:fiche;var c:text);
var
nm:string;
nmr:integer;
begin
write('Donner le numéro de votre table : ');readln(nmr);
repeat
write('Donner le nom du repas a commander : ');readln(nm);
until test(f,nm);
rewrite(c);
write(c,nmr);
writeln(c,nm);
close(c);
end;

procedure modifpass;
var
pw:text;
pas,p,p2:string;
err:boolean;
begin
assign(pw,'c:\pw.txt');
err:=false;
repeat
write('Donner le nouveau mot de passe : ');readln(p);
write('Repeter le nouveau mot de passe : ');readln(p2);
if p2=p then
begin
rewrite(pw);
write(pw,p);
err:=true;
end;
until err;
close(pw);
end;

procedure ajouter(var f:fiche);
begin
reset(f);
seek(f,filesize(f));
with r do
begin
write('Donner le numéro du repas : ');readln(num);
write('Donner le nom du repas : ');readln(nom);
write('Donner le prix du repas : ');readln(prix);
end;
write(f,r);
end;

procedure supprimer(var f:fiche);
var
nmr:1..20;
existe:boolean;
p:integer;
begin
write('Donner le numéro de repas a supprimer : ');readln(nmr);
existe:=false;
reset(f);
while (not eof(f))and(not existe) do
begin
read(f,r);
existe:=r.num=nmr;
end;
if existe then
begin
p:=filepos(f)-1;
if p<>filesize(f)-1 then
begin
p:=p+1;
seek(f,p);
while p<filesize(f) do
begin
seek(f,p);
read(f,r);
seek(f,p-1);
write(f,r);
p:=p+1
end;
end;
seek(f,filesize(f)-1);
truncate(f);
end;
close(f);
end;

procedure administrateur(var f:fiche;var c:text);
begin
repeat
write('Donner le mot de passe : ');readln(p);
until admin(p);
repeat
clrscr;
writeln(' *** Gestion du restaurant ***');
writeln;
writeln;
writeln;
writeln('Pour créer la menu des repas appuyez sur C.');
writeln('Pour modifier un repas appuyez sur M.');
writeln('Pour ajouter un repas appuyez sur J.');
writeln('Pour supprimer un repas appuyez sur S.');
writeln('Pour afficher tous les repas appuyez sur V.');
writeln('Pour afficher tous les commandes appuyez sur A.');
writeln('Pour modifier le mot de passe appuyez sur P.');
writeln('Pour afficher la menu principale appuyez sur R.');
readln(choix);
choix:=upcase(choix);
case choix of
'C':creer(f);
'M':modifrepas(f);
'J':ajouter(f);
'S':supprimer(f);
'V':afficher(f);
'A':affcommande(c);
'P':modifpass;
'R':exit;
end;
until false;
end;

begin
assign(f,'c:\repas.dat');
assign(c,'c:\commandes.txt');
repeat
writeln(' *** Bienvenu dans notre restaurant ***');
writeln;
writeln;
writeln;
writeln;
writeln;
writeln('Pour afficher tous les repas appuyez sur V.');
writeln('Pour afficher tous les repas ayant un prix maximal a donner appuyez sur P.');
writeln('Pour commander un repas appuyez sur C.');
writeln('Si vous êtes l''administrateur appuyez sur A.');
writeln('Pour quitter le programme appuyer sur Q');
readln(choix);
choix:=upcase(choix);
case choix of
'V':Afficher(f);
'P':affmax(f);
'C':commande(f,c);
'A':administrateur(f,c);
'Q':exit;
end;
clrscr;
until false;
clrscr;
writeln(' *** Nous vous remercions de votre visite A bientôt. ***');
end. Very Happy

Ilyes KHAILI

Messages : 24
Date d'inscription : 13/11/2008
Age : 27

Voir le profil de l'utilisateur

Revenir en haut Aller en bas

Re: Essayez de le faire - Devoir tayara!

Message  Contenu sponsorisé


Contenu sponsorisé


Revenir en haut Aller en bas

Voir le sujet précédent Voir le sujet suivant Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum