مجموعه كبيرة من التطبيقات على الباسكال

يوسف الضادي

  • Hero Member
  • *****
    • مشاركة: 5333
    • مشاهدة الملف الشخصي
    • http://www.sou9dz.com
    • البريد الالكتروني
في: نيسـان 16, 2009, 10:26:01 صباحاً
باسم الله الرحمن الرحيم

أترككم الان مع هذه التطبيقات الرائعة

Ex ex_tva[/B]

[
B][/B]

  
program tva(input,output);
var 
prix_unitaire,quantite,
    
total_ht,tva,total_ttc:real;
begin
  writeln
('prix de l''article ?');
  
readln(prix_unitaire);
  
writeln('quantité désirée ? ');
  
readln(quantite);
  
total_ht:=prix_unitaire*quantite;
  
tva:=total_ht*(18.6/100);
  
total_ttc:=total_ht+tva;
  
writeln('total ht  : ',total_ht);
  
writeln('tva       : ',tva);
  
writeln('           -------------');
  
writeln('total ttc : ',total_ttc)
end.


-- Ex ex_puiss

  program puissances(input,output);
var 
n,max:integer;
begin
  writeln
('nombre maxi ? ');
  
readln(max);
  
n:=2;
  while 
n<=max do begin
    writeln
(n);
    
n:=n*2
  end
;
  
writeln('c''est fini')
end.
-- Ex ex_jeu

  program jeu(input,output);
var 
choix,rep,nb:integer;
begin
  nb
:=0;
  
choix:=random(11);
  
repeat
    nb
:=nb+1;
    
writeln('choix ndeg. ',nb,' ? ');
    
readln(rep)
  
until rep=choix;
  
writeln('trouvé en ',nb,' coups')
end.
-- Ex ex_moy

  program moyenne(input,output);
var 
n,i:integer;
    
note,total,moyenne:real;
begin
  writeln
('nombre notes à entrer ?');
  
readln(n);
  
total:=0;
  for 
i:=1 to n do begin
    writeln
(i,'ième note ? ');
    
readln(note);
    
total:=total+note
  end
;
  
moyenne:=total/n;
  
writeln('la moyenne est : ',moyenne)
end.
-- Ex ex_jeu_bis

  program jeu_ameliore(input,output);
var 
choix,rep,nb:integer;
begin
  nb
:=0;
  
choix:=random(11);
  
repeat
    nb
:=nb+1;
    
writeln('choix ndeg. ',nb,' ? ');
    
readln(rep);
    if 
rep<choix then
      writeln
('c''est plus')
    else if 
rep>choix then
      writeln
('c''est moins')
{
le 2ème if empêche d'écrire si juste}
  until rep=choix;
  writeln('
juste en ',nb,' coups')
end.
  -- Ex ex_calc

  program calculatrice(input,output);
var 
val1,val2,resultat:real;
    
operation:char;
begin
  writeln
('première valeur ?');
  
readln(val1);
  
writeln('opération (+ - * /) ? ');
  
readln(operation)
  
writeln('deuxième valeur ? ');
  
readln(val2);
  case 
operation of
    
'+':resultat:=val1+val2;
    
'-':resultat:=val1-val2;
    
'*':resultat:=val1*val2;
    
'/':resultat:=val1/val2
  end
;
  
writeln('résultat : ',resultat)
end.
-- EX moy.a

  program moyenne(input,output);
var 
n,compteur:integer
    somme
,moyenne,ecart:real;
    
note:array[1..100of real;
begin
  repeat
    writeln
('nb notes (100 maxi)?');
    
readln(n)
  
until (n>0) and (n<=100);
{
entrée notes et calcul de la somme}
  
somme:=0;
  for 
compteur:=1 to n do
    
begin
      writeln
(compteur,'è note ?');
      
readln(note[compteur]);
      
somme:=somme+note[compteur]
    
end;
{
calcul et affichage de la moyenne}
  
moyenne:=somme/n;
  
writeln('moyenne : ',moyenne);
{
calcul et affichage des écarts}
  
writeln('écarts :');
  for 
compteur:=1 to n do
    
begin
      ecart
:=note[compteur]-moyenne;
      
writeln(compteur,'ième note (',
              
note[compteur],
              
') : écart : ',ecart)
    
end
end
.
-- Ex rot.b

 
program rotation(input,output);
var 
index,n:integer;
    
prem:real;
    
tableau:array[1..100]of real;
begin
  repeat
    writeln
('nb valeurs (100 maxi)?');
    
readln(n)
  
until (n>0) and (n<=100);
(* 
entrée des valeurs *)
  for 
index:=1 to n do
    
begin
      writeln
(index,'ième valeur ?');
      
readln(tableau[index]);
    
end;
  
writeln('on décale vers le haut');
  
prem:=tableau[1]; {ne pas écraser!}
  for 
index:=2 to n do
    
tableau[index-1]:=tableau[index];
  
tableau[n]:=prem;
  for 
index:=1 to n do
    
writeln(tableau[index]);
  
writeln('on re-décale vers le bas');
  
prem:=tableau[n];
  for 
index:=n downto 2 do
    
tableau[index]:=tableau[index-1];
  
tableau[1]:=prem;
  for 
index:=1 to n do
    
writeln(tableau[index])
end.

-- Ex clas.c

  program classer(input,output);
var 
n,i,index,petit,indexpetit:integer;
   
avant,apres:array[1..100]of integer;
   
pris:array[1..100of boolean
         {
pour noter ceux déjà pris}
begin
repeat
  writeln
('nb valeurs (100 maxi) ?');
  
readln(n)
until (n>0) and (n<=100);
{
entrée valeurs initialisation de pris}
for 
index:=1 to n do begin
  writeln
(index,'ième valeur ? ');
  
readln(avant[index]);
  
pris[index]:=false
end
;
{
ordre croissant,on cherche N valeurs}
for 
i:=1 to n do begin
  petit
:=maxint; {plus grand possible}
{
recherche du plus petit non pris}
  for 
index:=1 to n do
    if (
not pris[index]) and
       (
avant[index]<=petitthen begin
      petit
:=avant[index];
      
indexpetit:=index
    end
;
sauvegarde dans le tableau APRES et
  mise à jour de PRIS 
}
  
apres[i]:=petit;
  
pris[indexpetit]:=true
end
; { passage au prochain i }
{
affichage du tableau APRES}
writeln('par ordre croissant : ');
for 
i:=1 to N do writeln(apres[i]);
{
classement par ordre décroissant}
writeln('par ordre décroissant : ');
for 
i:=n downto 1 do writeln(apres[i])
  {
n'auriez-vous pas tout refait ?}
end.
-- Ex str

 
program position(input,output);
var 
ch,sch:string[255];
    
i,j,n,l,ls:integer;
begin
  writeln
('chaîne à tester ? ');
  
readln(ch);
  
writeln('sous-chaîne à trouver ?');
  
readln(sch);
  
l:=length(ch);ls:=length(sch);
  
n:=0;
  for 
i:=1 to l-ls do begin
    j
:=1;
    while (
j<=l)and(ch[i+j-1]=sch[j])
          do 
j:=j+1;
    if 
j>ls then begin
      writeln
('trouvé position ',i);
      
n:=n+1
    end
  end
;
  
writeln(n,' fois ',sch,' dans ',ch)
end.

--Ex mat

  program produit_mat(input,output);
var 
m1,m2,m3:array[1..10,1..10]of real;
    
l,m,n,jl,jm,jn:integer;
begin
  writeln
('nb lignes 1ère matrice ?');
  
readln(m);
  
writeln('nb colonnes 1è matrice ?');
  
readln(l);
  
writeln('nb colonnes 2è matrice ?');
  
readln(n);
(* 
entrée de m1 *)
  
writeln('première matrice');
  for 
jm:=1 to m do for jl:=1 to l do
  
begin
    writeln
('lig',jm,', col',jl,'?');
    
readln(m1[jm,jl])
  
end;
(* 
entrée de m2 *)
  
writeln('2ième matrice');
  for 
jl:=1 to l do for jn:=1 to n do
  
begin
    writeln
('lig',jl,', col',jn,'?');
    
readln(m2[jl,jn])
  
end;
(* 
calcul du produit *)
  for 
jm:=1 to m do for jn:=1 to n do
    
begin {calcul composante m,n de m2}
    
m3[jm,jn]:=0;
    for 
jl:=1 to l do   m3[jm,jn]:=
      
m3[jm,jn]+(m1[jm,jl]*m2[jl,jn]);
  
end;
(* 
affichage du résultat *)
  
writeln('résultat');
  for 
jm:=1 to m do for jn:=1 to n do
   
writeln('m[',jm,',',jn,']=',
            
m3[jm,jn])
end.
-- Ex tel

  program annuaire(input,output);
(* 
version simplifiée *)
type ligne=string[40];
     
typepersonne=record
                    nom
:ligne;
                    
num_tel:ligne
(* integer malheureusement 32635 *)
                  
end;
var 
pers:array[1..100]of
                      typepersonne
;
    
nb,i:1..100;
    
rep:char;
    
imprimer:boolean;
    
texte:ligne;

begin
{on suppose avoir ici les instructions
permettant de lire sur fichier disque
NB et le tableau PERS 
}
  
repeat
    writeln
('recherche suivant : ');
    
writeln(' N : nom');
    
writeln(' T : numéro téléphone');
    
writeln(' Q : quitter le prog');
    
writeln('quel est votre choix ?');
    
readln(rep);
    if 
rep<>'Q' then begin
      writeln
('texte à chercher ? ');
      
readln(texte)
      for 
i:=1 to nb do with pers[i] do
        
begin
        
case rep of
          
'N':imprimer:=nom=texte;
          
'T':imprimer:=num_tel=texte;
        
end;
        if 
imprimer then begin
          writeln
('nom  : ',nom);
          
writeln('tel  : ',num_tel)
        
end
      end
    end
  until rep
='Q'
end.
-- Ex rec

  program determ(input,output);
on se limite à 10x10ce qui fait 7h
de calcul et 6.235.314 appels à DETN 
}
type tmat=array[1..10,1..10of real;
var 
dim:integer
    {
dimension matrice à calculer}
    
det:real;   {résultat désiré}
    
mat:tmat;   {matrice à calculer}
    
appel:real; {nb appels à }

procedure entree;
var 
lig,col:integer;
begin
  writeln
('dimension de la matrice ?');
  
readln(dim); {DIM variable globale}
  
writeln('entrez les composantes :');
  for 
lig:=1 to dim do begin
    writeln
('pour la ligne ndeg. ',lig);
    for 
col:=1 to dim do begin
      writeln
('colonne  ',col,' ?');
      
readln(mat[lig,col])
    
end
  end
end
;

procedure sous_mat(mdeb:tmat; var mfin:
              
tmatind,dim:integer);
{
on supprime la colonne 1 et la ligne
 ind pour avoir la s
/mat de dim-1}
  var 
col,lig,l:integer;
  
begin
    l
:=0;
    for 
lig:=1 to dim do begin
      
if lig<>ind then begin  
        l
:=l+1;
        for 
col:=2 to dim do 
          
mfin[l,col-1]:=mdeb[lig,col]
      
end
    end
  end
;

function 
detn(m:tmat;d:integer):real;
{
dét ordre d en fonction ordre d-1}
var 
result:real;
    
mprim:tmat; {matrice intermédiaire}
    
lig,signe:integer;
begin
  appel
:=appel+1;
  if 
d=1 then detn:=m[1,1
          (* 
fin de récursivité *)
  else 
begin
    result
:=0;
    
signe:=-1;
    for 
lig:=1 to d do begin
      sous_mat
(m,mprim,lig,d);
      
signe:=-signe;
      {
changer de signe à chaque ligne}
      
result:=result 
       (
signe*m[lig,1]*detn(mprim,d-1))
    
end;
    
detn:=result
  end
end
;

begin (* programme principal *)
  
entree;
  
appel:=0;
  
det:=detn(mat,dim);
  
writeln('résultat : ',det);
  
writeln('nb appels DETN : ',appel)
end.
-- Ex fichier

 
procedure lirefic;
var 
i:1..100;
    
f:file of typepersonne;
(* 
variables globales :
          
NB et le tableau PERS *)
begin
  assign
(f,'annuaire'); {non standard}
  
reset(f);
  
nb:=0;
  while 
not EOF(f) do begin
    nb
:=nb+1;
    
read(f,pers[nb)
  
end;
  
close(f)
end;  
{
à vous de faire la suite}

-- Ex pointeurs


program liste
(input,output);
  
TYPE tpoint=^tval;
       
tval=record
              valeur
:integer;
              
suivant:tpoint
            end
;
  VAR 
prem:tpoint; {variable globale}
      
n:integer;
      
c:char;

procedure lire;
var 
precedent,point:tpoint;
    
i:integer;
modifie N et PREM }
  
begin
    write
('combien d''éléments?');
    
readln(n);
    new(
prem);
    
write('1ère valeur ? ');
    
readln(prem^.valeur);
    
precedent:=prem;
    for 
i:=2 to n do begin
      
new(point);
      
write(i,'ième valeur ? ');
      
readln(point^.valeur);
      
precedent^.suivant:=point;
      
precedent:=point
    end
;
    
precedent^.suivant:=NIL   
(* le dernier ne pointe sur rien *)
  
end;

procedure afficher;
var 
point:tpoint;
    
i:integer;
  
begin
    point
:=prem;
    for 
i:=1 to n do begin
      writeln
(point^.valeur);
      
point:=point^.suivant
    end
  end
;

procedure supprimer;
var 
point,prec:tpoint;
    
rep:char;
  
begin
    point
:=prem;
    
repeat
      write
(point^.valeur,' à ôter ?');
      
readln(rep);
      if 
rep='O' then begin
        n
:=n-1;
        if 
point<>prem then begin
         prec
^.suivant:=point^.suivant;
         
dispose(point);
         
point:=prec^.suivant 
       
(* se préparer pour la suite *)
        
end
        
else begin
          prem
:=prem^.suivant;
          
dispose(point);   
          (* 
ancien premier *)
          
point:=prem
        end
      end
      
else begin 
     
(* pointer sur le suivant *)
        
prec:=point;
        
point:=point^.suivant
      end
    until point
=nil
  end
;

procedure rajouter;
var 
p1,p2,prec:tpoint;
    
rep:char;
  
begin
    p1
:=prem;
    
repeat
      write
(p1^.valeur,' rajouter un
 élément avant (O/N) ? '
);
      
readln(rep);
      if 
rep='O' then begin
        n
:=n+1;
        if 
p1<>prem then begin
          
new(p2);
          
write('valeur ? ');
          
readln(p2^.valeur);
          
prec^.suivant:=p2;
          
p2^.suivant:=p1;
          
prec:=p2;
        
end
        
else begin
          
new(p1);
          
write('valeur ? ');
          
readln(p1^.valeur);
          
p1^.suivant:=prem;
          
prem:=p1
        end
      end
      
else begin 
(* pointer sur le suivant *)
        
prec:=p1;
        
p1:=p1^.suivant
      end
    until p1
=nil;
    
p1:=prec;
    
repeat
      write
('ajouter un élément en fin
de liste (O/N) ? '
);
      
readln(rep);
      if 
rep='O' then begin
        n
:=n+1;
        new(
p2);
        
write('valeur ? ');
        
readln(p2^.valeur);
        
p1^.suivant:=p2;
        
p2^.suivant:=nil;
        
p1:=p2
      end
    until rep
<>'O'
  
end;

BEGIN {prog principal}
  
lire;
  
repeat
    writeln
('A:afficher, S:supprimer R:rajouter, F:fin');
    
write('votre choix ? ');
    
readln(c);
    case 
c of
      
'A':afficher;
      
'S':supprimer;
      
'R':rajouter
    end
  until c
='F'
end.


أنا بانتظار نقاشاتكم الهادفة
و الا فضغط على الزر شكرا


silya

  • Jr. Member
  • **
    • مشاركة: 99
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #1 في: نيسـان 16, 2009, 01:50:53 مسائاً
بارك الله فيك


مامي

  • Hero Member
  • *****
    • مشاركة: 1140
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #2 في: نيسـان 17, 2009, 08:40:30 صباحاً
بارك الله فيك
 
 
 


يوسف الضادي

  • Hero Member
  • *****
    • مشاركة: 5333
    • مشاهدة الملف الشخصي
    • http://www.sou9dz.com
    • البريد الالكتروني
رد #3 في: نيسـان 24, 2009, 11:48:01 صباحاً
مقتبس من: silya;241914
بارك الله فيك

مقتبس من: مامي;242371
بارك الله فيك
 
 
 

شكرا لمرورك الطيب بانتظار استفساراتكم


شذى الروح

  • Hero Member
  • *****
    • مشاركة: 3501
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #4 في: أيار 06, 2009, 08:40:39 مسائاً
ما شاء الله يوسف يعطيك الصحة
يوسف ممكن توضح اكثر عمل كل برنامج في العنوان لكي تكون الافادة افضل


يوسف الضادي

  • Hero Member
  • *****
    • مشاركة: 5333
    • مشاهدة الملف الشخصي
    • http://www.sou9dz.com
    • البريد الالكتروني
رد #5 في: أيار 07, 2009, 06:41:56 صباحاً
مقتبس من: شذى الروح;253388
ما شاء الله يوسف يعطيك الصحة
يوسف ممكن توضح اكثر عمل كل برنامج في العنوان لكي تكون الافادة افضل
شكرا لمرورك أختي و لتثبيت الموضوع


يوسف الضادي

  • Hero Member
  • *****
    • مشاركة: 5333
    • مشاهدة الملف الشخصي
    • http://www.sou9dz.com
    • البريد الالكتروني
رد #6 في: أيار 07, 2009, 10:22:52 صباحاً
السلام عليكم
شرح البرامج عملها فقط
أما المكونات فهي سهلة و بسيطة و لا تحتاج الشرح
Ex ex_tva
هذا البرنامج يقوم بحساب ضريبة مالك وفق قانون محدد يحدده المبرمج
Ex ex_puiss
هذا البرنامج يحسب قوى 2 حتى يصل الى العدد الذي وضعته انت
Ex ex_jeu
هذا البرنامج لعبة الأرقام العشوائية
Ex ex_moy
هذا البرنامج يحسب لك معدل المادة
Ex ex_jeu_bis
مثل اللعبة السابقة لكن تزيد عليها شيء
Ex ex_calc
ألة حاسبة بسيطة تقوم بالعمليات المعتادة
EX moy.a
يحسب معدل مجموعة كبيرة
Ex rot.b
Ex clas.c
يعمل على تنظيم مصفوفة
Ex str
العمل داخل الحروف و الكلمات
Ex mat
مجموع ثلاث مصفوفات
Ex tel
برنامج تسجيل معلومات على حسب أرقام الهاتف
Ex rec
برنامج ....... الاتمام
Ex fichier
البحث عن ملف و اظهاره
Ex pointeurs
التعديل على الملفات

حمل كل سورسات البرامج من المرفقات


abdosite

  • Jr. Member
  • **
    • مشاركة: 59
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #7 في: أيار 07, 2009, 09:14:17 مسائاً
بارك الله فيك
 رائع



GNX

  • Newbie
  • *
    • مشاركة: 37
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #8 في: أيار 08, 2009, 07:05:01 مسائاً
بارك الله فيك


abdelaali.abdou

  • Full Member
  • ***
    • مشاركة: 118
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #9 في: أيار 09, 2009, 07:54:17 مسائاً
بارك الله فيك
اخي الكريم


khelef

  • Hero Member
  • *****
    • مشاركة: 1023
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #10 في: أيار 10, 2009, 05:16:30 صباحاً
السلام عليكم
من فضلك الا قدرت تحلي تمارين
Exercie1
[/RIGHT]
écrire une fonction qui calcule la suite de Fibonacci on utilisera de filtrage
[/RIGHT]
Exercie2
[/RIGHT]
écrire une fonction qui calcul la somme pour n allant de 1 à i de f(i
[/RIGHT]
[/RIGHT]
solution en CAML
[/RIGHT]
[/RIGHT]


vitchou

  • Newbie
  • *
    • مشاركة: 1
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #11 في: أيار 11, 2009, 04:16:20 مسائاً
السلام عليكم انا اطلب المساعدة طالب في MIAS ولقد قدم لنا tp informatique حاولة بجميع الطرق ولكن لم استطيع و نصه هو الاتي     Soit un graphe représentant des différentes villes a une pie.
  Ecrire un programme qui gère les différent voyage en répondent au question des genres :
  ¨L’existence d’un schéma entre deux villes.
  ¨La distance à parcourir entre deux villes.
  ¨Tout les schéma entre deux villes en précise les différentes distances.
  ¨Le schéma le plus court entre deux villes. وشكرا


روبن

  • Full Member
  • ***
    • مشاركة: 144
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #12 في: أيار 14, 2009, 08:23:17 صباحاً
بارك الله فيك


روبن

  • Full Member
  • ***
    • مشاركة: 144
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #13 في: أيار 25, 2009, 07:48:21 مسائاً
مشكوووور على الإفادة
جزاك الله خير


doudi0505

  • Newbie
  • *
    • مشاركة: 1
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #14 في: أيار 28, 2009, 04:15:27 مسائاً
شكرااااااااااااااااااااااااااااااااااااا