المساعد الشخصي الرقمي

مشاهدة النسخة كاملة : برنامج رائع بلغة باسكال من إنجازي مع زميلي ارجو ان يفيدكم


boughaba mohamed
2013-05-30, 19:18
السلام عليكم
لقد قمت منذ ايام بوضع طلب مساعدة في إتمام برنامج يتكون من 12 تعليمه واليوم وبفضل الله وبالإستعانة ببعض الخبراء وكذلك زميلي في المشروع تم إنجازه وأردت أن اضعه بين ايديكم وذلك لما فيه من افكار جيدة ومفيدة خاصتا للمبتدئين في عالم البرمجة فأرجو ان تستفيدو منه
هذا البرنامج منجز بلغة الباسكال

Program Project;
type
tab = array [1 .. 100] of integer;

Var
T: tab;
f, h, n, i: integer;

Choix: char;

Label MnuP;

procedure creier(var T: tab; var Taille_actuelle: integer);
begin
repeat
Write('Donner la taille du tableau: ');
readln(Taille_actuelle)
until n > 0;
for i := 1 to n do
begin
write('T[', i, ']=');
read(T[i]);
end;
end;

procedure afficher(T: tab; n: integer);
begin
for i := 1 to n do
begin
Writeln('T[', i, ']=', T[i]);
end;
end;

procedure modification(x, y: integer; var T: tab);
begin
for i := 1 to n do
if x <= n then
begin
T[x] := y;
Writeln('T[', i, ']=', T[i]);
end;
end;

procedure insertion(var n: integer; y: integer; var T: tab);
begin

n := n + 1;
T[n] := y;

end;

procedure calculer(x: integer; T: tab);
var
i, nb: integer;
begin
nb := 0;
Write('entere la valeur que vous souhaitez rechercher le nombre de r‚p‚tition: ');
readln(x);
for i := 1 to n do
if T[i] = x then
nb := nb + 1;
Writeln('le nombre de r‚p‚tition de cette valeur est :', nb,' fois');
end;

procedure minimum(T: tab; n: integer);
var
min: integer;
begin
min := T[1];
for i := 2 to n do
if min > T[i] then
min := T[i];
Writeln('le plus petit ‚l‚ment donns le tableau est: ', min);
end;

procedure maximum(T: tab; n: integer);
var
max: integer;
begin
max := T[1];
for i := 2 to n do
if max < T[i] then
max := T[i];
Writeln('le plus grand ‚l‚ment donns le tableau est: ', max);
end;

procedure recherche(T: tab; n: integer);
var
x: integer;
begin
Write('entrer la valeur que vous souhaitez rechecher: ');
readln(x);
for i := 1 to n do
if T[i] = x then
Writeln('la position de ce nombre donns le tablaeu est :', i);
end;

procedure trie(T: tab; n: integer);
var
i, j, smallpos, smallest: integer;
begin
for i := 1 to n do
begin
smallpos := i;
smallest := T[smallpos];
for j := i to n do
if T[j] < smallest then
begin
smallpos := j;
smallest := T[smallpos];
end;
T[smallpos] := T[i];
T[i] := smallest;
Writeln('T[', i, ']=', T[i]);
end;end;
procedure supp(var T: tab; var n: integer);
var
x, j: integer;
begin
Write('entere la valeur que vous souaitez supprimer: ');
readln(x);
for i := 1 to n do
begin
if T[i] = x then
begin
for j := i to n do
begin
T[j] := T[j + 1];
end;
n := n - 1;

end;

end;

end;
procedure invertion(var T: tab;var n:integer);
var
center, j, i, temp: integer;
begin
center := n div 2;
j := n;
for i := 1 to center do
begin
temp := T[i];
T[i] := T[j];
T[j] := temp;
j := j - 1;
end;
end;
BEGIN
writeln;
writeln('bienvenue sur le programme fait parles deux amais:');
writeln(' boughaba mohamed et brahim boukhris .');
writeln;
writeln('appuyez sur entrer pour enttrer au programme.');

readln;
writeln('la liste suivante aidera … choisir les commandes que vous souhaitez effectuer:');
writeln;
MnuP:
Writeln('[A]- Quitter');
Writeln('[B]- cr‚ation du tableau');
Writeln('[C]- affichage du tableau');
Writeln('[D]- modification d''un ‚l‚ment du tableau');
Writeln('[E]- insertion d''un ‚l‚ment dons le tableau');
Writeln('[F]- suppression d''un ‚l‚ment du tableau');
Writeln('[G]- inverser le tableau');
Writeln('[H]- calculer le nombre des occurrences d''un nombre donn‚ X dans le tableau');
Writeln('[I]- recherche du plus petit ‚l‚ment dons le tableau');
Writeln('[J]- recherche du plus grand ‚l‚ment dens le tableau');
Writeln('[K]- recherche un ‚l‚ment donn‚ dans le tableau');
Writeln('[L]- trie le tableau');
Write('Entrez votre choix :');
Repeat
Read(Choix)
Until Upcase(Choix) in ['A' .. 'L'];
Choix := Upcase(Choix);
Case Choix Of
'A':
begin
Exit;
end;
'B':
Begin

creier(T, n);
Writeln('Le Tableau a ‚t‚ cr‚ie.');
Writeln('Tapez entrer pour retour.');
readln;
readln;


Goto MnuP;
end;
'C':
Begin
writeln('le tableau:') ;
afficher(T, n);
Writeln('Le Tableau a ‚t‚ Affich‚ie.');
Writeln('Tapez entrer pour retour.');
readln;
readln;

Goto MnuP;

end;
'D':
Begin
write('donner la posutoin que vous voulez changer i=');
readln(f);
Write('donner la valeur que vous voulez mettre =');
readln(h);
writeln('le tableau pr‚c‚dent');
afficher(T, n);
writeln('le tableau actuel');
modification(f, h, T);
Writeln('Tapez entrer pour retour.');
readln;
Goto MnuP;
End;
'E':
begin

Write('Donner la valeur que vou souaitez ajouter: ');
readln(h);
writeln('le tableau pr‚ceent:');
afficher(T,n);
insertion(n, h, T);
writeln('le tableau actuel');
afficher(T,n);
Writeln('Tapez entrer pour retour.');
readln;

Goto MnuP;
end;
'H':
begin

calculer(f, T);
Writeln('Tapez entrer pour retour.');
readln;
goto MnuP;
end;
'I':
begin
minimum(T, n);
Writeln('tapez entrer pour retour.');
readln;
readln;
goto MnuP;
end;
'J':
begin
maximum(T, n);
Writeln('Tapez entrer pour retour.');
readln;
readln;
goto MnuP;
end;
'K':
begin
recherche(T, n);
Writeln('Tapez entrer pour retour.');
readln;

goto MnuP;
end;
'L':
begin
writeln('le tableau pr‚ceent:');
afficher(T, n);
writeln('le tableau aprŠs le classement des valeur:');
trie(T, n);
Writeln('Tapez entrer pour retour.');
readln;
readln;
goto MnuP;
end;
'F':
begin
supp(T, n);
writeln('le tablaeu aprŠs la suppression:');
afficher(T,n);
Writeln('Tapez entrer pour retour.');
readln;

goto MnuP;
end;

'G':
begin
writeln('le tableau pr‚ceent:');
afficher(T, n);
invertion(T,n);
writeln('le tableau aprŠs linvertion des valeurs :');
afficher(T,n) ;
writeln('le tableau … ‚t‚ inverser');
Writeln('Tapez entrer pour retour.');
readln;
readln;goto Mnup;end;
end;


end.

سأقوم في الرد التالي بإذن الله بوضع صورتين بهما نص المطلوب لكي تفهمو مبدأ البرنامج
بد التعديل:
هذه روابط الصور
http://www5.0zz0.com/2013/05/14/14/781844431.jpg
http://www2.0zz0.com/2013/05/14/14/675090152.jpg

عمار ابن غارداية
2013-05-30, 20:43
لو وضعت ماذا يعمل البرنامج لكان سهلت علينا الامور يجب علينا تتبع كافة التعليمات لمعرفة عمل البرنامج على كل مشكوور

boughaba mohamed
2013-06-01, 21:14
آسف إخواني على التأخر هذا في وضع المطلوب هذه روابط لصور فيها كل المطلوب فأرجو ان تقيموه :
http://www5.0zz0.com/2013/05/14/14/781844431.jpg
http://www2.0zz0.com/2013/05/14/14/675090152.jpg

boughaba mohamed
2013-06-01, 21:15
,,,,,,,,,,,,,,,,,,,,,,,,,,,,