برنامج رائع بالباسكال pascal

يوسف الضادي

  • Hero Member
  • *****
    • مشاركة: 5333
    • مشاهدة الملف الشخصي
    • http://www.sou9dz.com
    • البريد الالكتروني
في: أيار 01, 2009, 02:05:09 مسائاً
باسم الله الرحمن الرحيم

أقدم اليكم برنامج صغير بالباسكال يحتوي عدة برامج وتطبيقات على الباسكال كتبته بنفسي

صورة البرنامج


سورس البرنامج
program miniprog;
var
a:array [1..100,1..100]of real;
t,b,c:array[1..100]of real;
x,v,r:real;
 
kchoix:char;
n,m,j,l,i,s,y:integer;

function 
add(var x,vreal):real;
begin
r
:=x+v;
end;
function 
sub(var x,vreal):real;
begin
r
:=x-v;
end;
function 
mul(var x,vreal):real;
begin
r
:=x*v;
end;
function 
divis(var x,vreal):real;
begin
r
:=x/v;
end;

begin
repeat
writeln
;
writeln;
writeln ('         ححححححححححححححححححححححححححححححححححححححححححححححححححححححححح');
writeln ('         * ----------------------------------------------------- *');
writeln ('         * *                                                   * *');
writeln ('         * *              *****  MR . MAZOOUG  *****           * *');
writeln ('         * *                                                   * *');
writeln ('         * *                  BENABDELLAH YOUCEF               * *');
writeln ('         * _____________________________________________________ *');
writeln ('         ححححححححححححححححححححححححححححححححححححححححححححححححححححححححح');
writeln;
writeln ('         MENU DU CHOIX :   ');
writeln;
writeln ('         كككككككككككككككككككككككككككككككككككككككككككككككككككككككككك');
writeln ('         ³³³                                                    ³³³');
writeln ('         ³³³  A _       PROGRAMME DE recherche                  ³³³');
writeln ('         ³³³                                                    ³³³');
writeln ('         ³³³  B _       PROGRAMME DE produit                    ³³³');
writeln ('         ³³³                                                    ³³³');
writeln ('         ³³³  C _       PROGRAMME DE parmitation                ³³³');
writeln ('         ³³³                                                    ³³³');
writeln ('         ³³³  D _       PROGRAMME DE method gusse               ³³³');
writeln ('         ³³³                                                    ³³³');
writeln ('         ³³³  E _       PROGRAMME DE calculitte                 ³³³');
writeln ('         ³³³                                                    ³³³');
writeln ('         كككككككككككككككككككككككككككككككككككككككككككككككككككككككككك');
writeln;
writeln;
readln;
write ('    choix= ')    ;
read (choix)    ;
case 
choix of
'A':
begin
writeln
;
writeln ('                         ============================');
writeln ('                         *                          *');
writeln ('                         *  PROGRAMME DE recherche  *');
writeln ('                         *                          *');
writeln ('                         ============================');
writeln;
j:=0;
writeln;
write ('    chiffer de recherche x= ');
read (x);
writeln;
write ('    chiffer en les case n= ');
read (n);

for 
i:=1 to n do
begin
writeln
;
write ('    case t[',i,']=');
read(t[i]) ;
end;

for 
i:=1 to n do
begin
if x=t[ithen
j
:=j+;
if 
x=t[ithen
writeln
(    x:     4:0,' ','existe dans la case',i)  ;
writeln;
end;
writeln;
writeln(    'la valeur',' ',:4:0,' ','existe',' ',j,'  fois');
end;

'B':
begin
writeln
;
writeln ('                         ============================');
writeln ('                         *                          *');
writeln ('                         *  PROGRAMME DE produite   *');
writeln ('                         *                          *');
writeln ('                         ============================');
writeln;
writeln;
    
write('  line horizontal n=');

read(n);
writeln;
    
write('    line vertical   m=');
read(m);
    for 
i:=1 to m do
     for 
j:=1 to n do
        
begin
        writeln
;
            
write('la case     a[',i,',',j,']=');
read(a[i,j]);
      
writeln;
        
end;
        for 
i:=1 to m do
begin
for j:=1 to n do
 
write(a[i,j]:4:0,'  ');
writeln;
writeln;
end;
       for 
j:=1 to n do
        
begin
        writeln
;
            
write('la case           b[',j,']=');
read(b[j]);
        
end;
        
writeln;
       for 
i:=1 to m do
       
begin
       c
[i]:=0;
       for 
j:=1 to n do c[i]:=c[i]+a[i,j]*b[j];
         
write('  ','c[',i,']=',c[i]:4:0);
         
writeln;
end;
end;
      
'C':
      
begin
      writeln
;
writeln ('                         ============================');
writeln ('                         *                          *');
writeln ('                         * PROGRAMME DE permitation *');
writeln ('                         *                          *');
writeln ('                         ============================');
writeln;
      
writeln;
write('line horizontal et vertical n= ');
read(n);
writeln;
for 
i:=1 to n do
for 
j:=1 to n do
begin
  write
('a[',' ',i,' ',j,' ',']=',' ');
  
read(a[i,j]);
  
writeln;
  
end;
  
writeln ;
  
writeln ;
  
writeln ;
     
writeln('matrice de a[i,j] ','       ');
     
writeln;
         for 
i:=1 to n do
         
begin
         
for j:=1 to n do
         
write(a[i,j]:4:0,'  ');
           
writeln;
           
writeln;
          
end;
          
writeln('parmitation de a[i,j] ','       ') ;
          
writeln;
          for 
i:=1 to n-do

           for 
j:=i+1 to n do
           
begin
           v
:=a[i,j];
           
a[i,j]:=a[j,i] ;
            
a[j,i]:=;
             
end;
             for 
i:=1 to n do
             
begin
              
for j:=1 to n do
              
write (a[i,j]:4:0,'  ');
              
writeln ;
                
writeln;
              
end;
              
end;
              
'D':
      
begin
writeln
;
writeln ('                         ============================');
writeln ('                         *                          *');
writeln ('                         *  PROGRAMME DE gusse      *');
writeln ('                         *                          *');
writeln ('                         ============================');
writeln;
write('            les line n=');
read(n);
writeln ;
for 
i:=1to n do
for 
j:=1 to i do
begin
write
('      a[',' ',i,' ',j,' ',']',' ','=',' ');
readln(a[i,j]);
writeln  end;
for 
i:=1to n  do
begin
write
('              b[',' ',i,' ',']',' ','=',' ');
readln(b[i]);writeln  ;
end;

for 
i:=n downto 1 do
r:=0;
begin
for j:=i+1 to n do
r:=r+a[i,j]*t[j];
t[i]:=(b[i]-r)/(a[i,i]);
end;
for 
i:=1 to n do
begin

writeln
('            ') ;
writeln(b[i]:4:0)  ;

writeln('            ') ;
end;

 for 
i:=1 to n do

  
begin
       
for j:=1 to n do
             
write(a[i,j]:4:0,'   ');
writeln ;
writeln;

end;
for 
i:=1 to n do
begin
write
('t[',i,']=',t[i]:4:0)   ;
 
writeln('    '); writeln('    ');

end;
  
end;
  
'E':
  
begin
writeln
('        **********************************************');
writeln('        *            calculette PASCAL               *');
writeln('        **********************************************');
writeln;
writeln;
write ('           la val : a =  ');
readln(x);
writeln;
write ('           opiration (* - + /) =   ');
readln(k);
writeln;
write ('           la val : b =  ');
readln(v);
case 
k of
'+'add(x,v);
'-'sub(x,v);
'*'mul(x,v);
'/'divis(x,v);
end;
writeln;
writeln('          resilta est un ',r:4:0);

end;
  
end;




       
writeln;
 
writeln;
 
writeln ('          POUR SORTIR TAPPEZ a 0 ');
read (l);
        
until  l=0;
end.
حمله من المرفقات



الفتاة الرقمية

  • Hero Member
  • *****
    • مشاركة: 6420
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #1 في: أيار 01, 2009, 02:17:54 مسائاً
نشيط كعادتك
ذكرتني بأيام الباسكال عندي مدة لم ابرمج
اظنني نسيت
موفق
احترامي



يوسف الضادي

  • Hero Member
  • *****
    • مشاركة: 5333
    • مشاهدة الملف الشخصي
    • http://www.sou9dz.com
    • البريد الالكتروني
رد #2 في: أيار 01, 2009, 02:26:41 مسائاً
مقتبس من: DigitalGirl;250289
نشيط كعادتك
ذكرتني بأيام الباسكال عندي مدة لم ابرمج
اظنني نسيت
موفق
احترامي


شكرا على مرورك لكن لازم تعاودي طلي عليه
كنت حاقره وخرج يستحق التعلم
بانتظار بعض دروس منك في basse de donné
(fichier ...etc)


الفتاة الرقمية

  • Hero Member
  • *****
    • مشاركة: 6420
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #3 في: أيار 01, 2009, 02:45:46 مسائاً
شوف خويا يحصل فيا
الباسكال لغة قديمة انا تاني حقرتها لكنها سهلة مناسبة جدا للتعليم الاكاديمي.وكلغة أساس للبداية تكون جيدة.
اما قواعد البيانات  لا أعرف عنها الكثير لكن قد اتوسع لا حقا واحاول ان افيدك ان شاء الله
موفق يا نشيط.
شهيتني باش نبرمج لازم نبدأ بكاتبه برنامج يحل معادلة  هو اول تمرين كنا نتدرب عليه
احترامي


mimik

  • Hero Member
  • *****
    • مشاركة: 1607
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #4 في: أيار 01, 2009, 03:30:42 مسائاً
شكرا تستحق الشكر بارك الله فيك
ننتضر المزيد


يوسف الضادي

  • Hero Member
  • *****
    • مشاركة: 5333
    • مشاهدة الملف الشخصي
    • http://www.sou9dz.com
    • البريد الالكتروني
رد #5 في: أيار 01, 2009, 05:22:15 مسائاً
ان شاء الله سأقدم لكم من روائع الباسكال
....
----
****
====


soumia.com

  • زائر
رد #6 في: أيار 01, 2009, 06:27:18 مسائاً
benabdallah youcef tu es en quelle année


روبن

  • Full Member
  • ***
    • مشاركة: 144
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #7 في: أيار 02, 2009, 07:34:29 صباحاً
                     مشكور بارك الله

            برنامج جميل ورائع





روبن

  • Full Member
  • ***
    • مشاركة: 144
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #8 في: أيار 04, 2009, 03:55:56 مسائاً
والله تستحق الرد مرة أخرى لقد رأيت البرنامج
أوه راك واصل خويا
ما شاء الله لا قوة إلا بالله
ننتظر المزيد للإستفادة منك
مشكوووووور


Tayiss

  • Hero Member
  • *****
    • مشاركة: 518
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #9 في: أيار 04, 2009, 05:14:07 مسائاً
je vais voir, merci


شذى الروح

  • Hero Member
  • *****
    • مشاركة: 3501
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #10 في: أيار 04, 2009, 08:40:19 مسائاً
ما شاء الله
رائع يوسف في انتظار جديدك


يوسف الضادي

  • Hero Member
  • *****
    • مشاركة: 5333
    • مشاهدة الملف الشخصي
    • http://www.sou9dz.com
    • البريد الالكتروني
رد #11 في: أيار 07, 2009, 06:37:09 صباحاً
أنبه الاخوة الاعضاء بأنه لا يسمح بنقل البرنامج
الا في حالة تركه كما هو
و الكتابه عليه منقول للافادة


becho

  • Jr. Member
  • **
    • مشاركة: 52
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #12 في: أيار 07, 2009, 10:48:51 مسائاً
احسن برنامج جزاك الله الخير انشاء الله اريد امثلة مثله
مشكوووووووووووووووووووووووووووووور.


abdosite

  • Jr. Member
  • **
    • مشاركة: 59
    • مشاهدة الملف الشخصي
    • البريد الالكتروني
رد #13 في: أيار 07, 2009, 11:26:01 مسائاً
بارك الله فيك


abdosite

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