Correction Bac pratique 19/05/2009

Devoir 9h


uses wincrt;
type
tab = array[1..100]of integer;
var
T,TS:tab;
n,k,m:integer;
procedure saisie_n(var n : integer);
begin
repeat
write('N= '); readln(n);
until n in [5..30];
end;
procedure saisie_k(var K : integer;n:integer);
begin
repeat
write('K= '); readln(K);
until n in [1..N];
end;
procedure lecture (var T: tab;n: integer);
var
i:integer;
begin
for i := 1 to n do
repeat
write('T[',i,'] = ');
readln(T[i]);
until T[i] > 0;
end;
procedure affichage(T:tab;n:integer);
var
i:integer;
begin
for i := 1 to n do
writeln(T[i]);
end;
procedure remplir(Var TS:tab;T:tab;n,k:integer;var m:integer);
var
i,j:integer;
begin
i:=1;
m:=0;
while i + k - 1 <= n do
begin
m:=m+1;
TS[m]:=0;
for j:=i to k+i-1 do TS[m]:=TS[m]+T[j];
i:=i+1
end;
end;

begin
writeln('****borjlouzir.1fr1.net****');
Saisie_n(n);
Saisie_k(k,n);
lecture(T,n);
remplir(TS,T,n,k,m);
affichage(TS,m);
end.

Devoir 10h30


uses wincrt;
type
tab = array[1..30]of string[5];
var
T,TS:tab;
n,k,m:integer;
procedure saisie_n(var n : integer);
begin
repeat
write('N= '); readln(n);
until n in [2..30];
end;
procedure lecture (var T: tab;n: integer);
var
i:integer;
begin
for i := 1 to n do
repeat
write('T[',i,'] = ');
readln(T[i]);
until T[i] <> '';
end;
function somme(T:tab;n:integer):integer;
var
i,j,S,x,e:integer;
ch1,ch:string[5];
begin
s:=0;
for i:=1 to n do
begin
ch:=T[i];
ch1:='';
for j:=1 to length(ch) do
if ch[j] in ['0'..'9']
then ch1:=ch1+ch[j];
if ch1 <> ''
then val(ch1,x,e)
else x:=0;
S:=S+x;
end;
Somme :=S;
end;

begin
writeln('***borjlouzir.1fr1.net*****');
Saisie_n(n);
lecture(T,n);
writeln(Somme(T,n));
end.

Devoir 14h


uses wincrt;
type
C=string[50];
var
ch: C;
function test(ch: C):boolean;
var
i:integer;
begin
i:=1;
while (ch[i] in ['A'..'Z','a'..'z']) and (i <= length(ch)) do
i := i+1;
test:=i > length(ch);
end;
procedure saisie(var ch : C);
begin
repeat
write('ch= '); readln(ch);
until test(ch);
end;
function traitement(ch:c):c;
var
i:integer;
res:C;
begin
res:='';
for i :=1 to length(ch) do
if ch[i] in ['A'..'Z'] then
if not(ch[i] in ['A','O','E','I','Y','U']) then res:=res+ch[i];
for i :=1 to length(ch) do
if ch[i] in ['A','O','E','I','Y','U'] then res:=res+ch[i];
for i :=1 to length(ch) do
if ch[i] in ['a'..'z'] then
if not(ch[i] in ['a','o','e','i','y','u']) then res:=res+ch[i];
for i :=1 to length(ch) do
if ch[i] in ['a','o','e','i','y','u'] then res:=res+ch[i];
traitement:=res;
end;
begin
writeln('****borjlouzir.1fr1.net****');
Saisie(ch);
writeln(traitement(ch));
end.

Merci pour le partage

Bonne chance pour demain !!