PROTOTYPE DE DC1 PRATIQUE

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

PROTOTYPE DE DC1 PRATIQUE

Message  Hanafi le Ven 7 Nov - 15:46

Ecrire un programme Pascal permettant de créer un fichier texte DEVOIR.TXT dans le dossier BAC2009, remplir ce fichier par 4 lignes de texte, remplacer tous les lettres ‘a’ par ‘o’ et afficher ce fichier.

Ecrire un programme Pascal permettant de créer un fichier D, contenant les dates. Chaque date est présentée par le jour, le mois et l’année. Ecrire dans un nouveau fichier D1 la plus petite et la plus grande date à partir du fichier D et dans un nouveau fichier D2 tous les dates de printemps.
avatar
Hanafi

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

Voir le profil de l'utilisateur

Revenir en haut Aller en bas

Question ?

Message  Hanafi le Sam 8 Nov - 23:25

Pourquoi vous ne donnez pas les propositions de solutions ? Est-ce que ce type de devoir est difficile ? Question
avatar
Hanafi

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

Voir le profil de l'utilisateur

Revenir en haut Aller en bas

RE: PROTOTYPE DE DC1 PRATIQUE

Message  Saafi RAMI le Mer 12 Nov - 20:07

Mon Essai :

program PROTOTYPE ;
uses wincrt;
var
t:text;

procedure creer(var t:text);
var
i:integer;
ch:string;
begin
rewrite(t);
for i:=1 to 4 do
begin
writeln('Donner la ligne N° ',i,' = ');
readln(ch);
writeln(t,ch);
end;
close(t);
end;

procedure remp(var t:text);
var
ch:array[1..4]of string;
n,i:integer;
begin
reset(t);
n:=0;
while not eof(t) do
begin
n:=n+1;
readln(t,ch[n]);
while pos('a',ch[n])<>0 do
ch[n] [pos('a',ch[n])]:='o';

end;
rewrite(t);
for i:=1 to n do
writeln(t,ch[i]);
close(t);
end;

procedure afficher(var t:text);
var
ch:string;
begin
reset(t);
while not eof(t) do
begin
readln(t,ch);
writeln(ch);
end;
close(t);
end;

begin
assign(t,'C:\BAC2009\DEVOIR.txt');
creer(t);
remp(t);
writeln ('********');
afficher(t);
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

Message  Ilyes KHAILI le Jeu 13 Nov - 20:29

program
uses wincrt;
type

date=record
jj:1..31;
mm:1..12;
aa:word;
end;

fiche=file of date;
var
d:fiche;
dt:date;

procedure creation(var d:fiche);
var choix:char;
begin
rewrite(d);
repeat
with dt do
begin
write('Donner le jour (1..31) :');readln(jj);
write('Donner le mois (1..12) :');readln(mm);
write('Donner l''anné :');readln(aa);
end;
write(d,dt);
write('Autre date ? (N pour non) = ');
readln(choix);
until upcase(choix)='N';
close(d);
end;

procedure chercher(dt:date;var grand,petit:date);
begin
if dt.aa<petit.aa then
petit:=dt
else
if dt.aa=petit.aa then
if dt.mm<petit.mm then
petit:=dt
else
if dt.mm=petit.mm then
if dt.jj<petit.jj then
petit:=dt;
if dt.aa>grand.aa then
grand:=dt
else
if dt.aa=grand.aa then
if dt.mm>grand.mm then
petit:=dt
else
if dt.mm=grand.mm then
if dt.jj>grand.jj then
grand:=dt;
end;

procedure grandpetit(var d:fiche);
var
d1:fiche;
petit,grand:date;
begin
reset(d);
read(d,petit);
grand:=petit;
while not eof(d) do
begin
read(d,dt);
chercher(dt,grand,petit);
end;
close(d);
assign(d1,'c:\bac2009\d1');
rewrite(d1);
write(d1,grand);
write(d1,petit);
close(d1);
end;

procedure printemp(var d:fiche);
var
d2:fiche;
begin
assign(d2,'c:\bac2009\d2');
rewrite(d2);
reset(d);
while not eof(d) do
begin
read(d,dt);
if (dt.mm in[3..6])then
write(d2,dt);
end;
close(d);
close(d2);
end;

procedure afficher;
var
d1,d2:fiche;
begin
clrscr;
writeln;
assign(d,'c:\bac2009\d');
reset(d);
writeln('Les dates enregistrées sont :');
while not eof(d) do
begin
read(d,dt);
writeln(dt.jj,' : ',dt.mm,' : ',dt.aa);
end;
writeln;
assign(d1,'c:\bac2009\d1');
reset(d1);
writeln('La plus petite et la plus grande dates sont :');
while not eof(d1) do
begin
read(d1,dt);
writeln(dt.jj,' : ',dt.mm,' : ',dt.aa);
end;
writeln;
assign(d2,'c:\bac2009\d2');
reset(d2);
writeln('Les dates du printemps sont :');
while not eof(d2) do
begin
read(d2,dt);
writeln(dt.jj,' : ',dt.mm,' : ',dt.aa);
end;
end;

begin
assign(d,'c:\bac2009\d');
creation(d);
grandpetit(d);
printemp(d);
afficher;
end. Laughing

Ilyes KHAILI

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

Voir le profil de l'utilisateur

Revenir en haut Aller en bas

PROTOTYPE DE DC1 PRATIQUE

Message  Hanafi le Jeu 13 Nov - 20:48

Salut, Rami. Bon travail Exclamation sunny Surtout, ch[n] [pos('a',ch[n])], c'est très fort.
Voici la correction avec l'utilsation du deuxième fichier T1, qui va être effacé à la fin du travail :
program SUJET1;
uses wincrt;
var t:text;
procedure remplir(var t:text);
var i:integer;
ch:string;
begin
rewrite(t);
for i:=1 to 4 do
begin
write('Donner la ligne N°',i,' ');
readln(ch);
writeln(t,ch);
end;
close(t);
end;
procedure remplace(var t:text);
var t1:text;
i:integer;
ch:string;
begin
reset(t);
assign(t1,'c:\BAC2009\nouveau.txt');
rewrite(t1);
while not eof(t) do
begin
readln(t,ch);
for i:=1 to length(ch) do
if ch[i]='a' then
ch[i]:='o';
writeln(t1,ch);
end;
reset(t1);
rewrite(t);
while not eof(t1) do
begin
readln(t1,ch);
writeln(t,ch);
end;
close(t);
close(t1);
erase(t1);
end;
procedure affiche(var t:text);
var ch:string;
begin
reset(t);
while not eof(t) do
begin
readln(t,ch);
writeln(ch);
end;
close(t);
end;
begin
assign(t,'c:\BAC2009\devoir.txt');
remplir(t);
remplace(t);
affiche(t);
end.
J'attends votre essai pour le deuxième exercice Question
avatar
Hanafi

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

Voir le profil de l'utilisateur

Revenir en haut Aller en bas

PROTOTYPE DE DC PRATIQUE - Sujet2

Message  Hanafi le Jeu 13 Nov - 21:02

Salut Ilyes ! Beinvenue chez nous. Excellent travail. Bonne continuation. sunny
avatar
Hanafi

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

Voir le profil de l'utilisateur

Revenir en haut Aller en bas

Re: PROTOTYPE DE DC1 PRATIQUE

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