منو
لينکهاي سريع
صفحه اول
آرشيو
ايميل

  موضوعات

  آرشيو

  معرفي وب به دوستان
« ارسال براي دوستان »
نام شما :
ايميل شما :
نام دوست شما:
ايميل دوست شما:

Powered by ParsTools


  مترجم زبان سايت / Translator Language

 

  صفحه 2 اموزش پاسکال

تابع کسینوس

function cosinos(a:real):real;
var
s,d,f:real;
i,k,j,h,p:integer;
begin
for h:=0 to 360 do
 for p:=0 to 360 do
   if(360*h+p*1)=a then
   a:=a-(360*h);
if (a<=360)and(a>180)then a:=360-a
else a:=a;
a:=(pi*a)/180;  //bar hasbe radian
s:=1;
f:=1;
k:=1;
d:=1;
begin
 for i:=1 to 5 do
  begin
   f:=-(a*a)*f;
  for j:=2 to 2*i do //mohasebe tavan
   begin
    k:=k*j;
   end;
d:=(f/k);
k:=1;
if (d<0.00001)and (d>=0) then break;
s:=s+d;
end;   //end of for
writeln;
writeln;
cosinos:=s;
end;
var
x,r:real;
begin
writeln('please enter a degree');
readln(x); //bar hasbe daraje
r:=cosinos(x);
writeln('cos x:=',r:6:3);
readln;
end
.

تابع سینوس

function sinos(a:real):real;
var
s,d,f:real;
i,k,j,h,p:integer;
begin
for h:=0 to 360 do
 for p:=0 to 360 do
   if(360*h+p*1)=a then
   a:=a-(360*h);
if (a<=360)and(a>180)then a:=360-a
else a:=a;
a:=(pi*a)/180;  //bar hasbe radian
s:=a;
f:=a;
k:=1;
 for i:=1 to 10 do
  begin
   f:=-(a*a)*f; //mohasebe tavan
  for j:=2 to (3*i)-i+1 do //mohasebe factoriel
    k:=k*j;
d:=(f/k);
k:=1;
s:=s+d;
if (d<0.0001)and (d>=0) then break;
end;   //end of for
writeln;
writeln;
sinos:=s;
end;
var
x,r:real;
begin
writeln('please enter a degree');
readln(x); //bar hasbe daraje
r:=sinos(x);
writeln('sin x:=',r:6:3);
readln;
end.

 مبناي 2 يک عدد
var
a:array[1..20]of integer;
i,n:integer;
begin
writeln('please enter a number');
readln(n);
i:=1;
while n>0 do
 begin
  a[i]:=n mod 2;
  i:=i+1;
  n:=n div 2;
 end;
if n<=0 then
 begin
  i:=i-1;
  while i>0 do
  begin
   write(a[i]);
   i:=i-1;
  end;
 end;
 readln;
end.


 ضرب دو ماتريس
var
a,b,c:array[1..20,1..20]of integer;
i,j,m,n,h,l,s:integer;
begin
writeln('please enter m,n,l:');{m*n,,,n*l}
readln(m,n,l);
for i:=1 to m do
  for j:=1 to n do
  begin
    writeln('a[',i,j,']:=' );
    readln(a[i,j]);
  end;
for i:=1 to n do
 for j:=1 to l do
  begin
   writeln('b[',i,j,']:=' );
   readln(b[i,j]);
  end;
for i:=1 to m do
 for j:=1 to l do
 begin
 h:=1;
 s:=0;
 while h<=n do
   begin
    c[i,j]:=a[i,h]*b[h,j];
    s:=c[i,j]+s;
    c[i,j]:=s;
    h:=h+1;
   end;
 end;
for i:=1 to m do
 for j:=1 to l do
writeln('c[',i,j,']:',c[i,j]);
readln;
end.

 


 جايگزيني عدد صفر به جاي اعدادي که مربع کامل هستند.
var
x:array[1..10,1..10]of integer;
i,j,n:integer;
begin
writeln('please enter one number');
readln(n);
for i:=1 to n do
 for j:=1 to n do
 begin
  write('x[',i,j,']:=');
  readln(x[i,j]);
  end;
  for i:=1 to n do
   for j:=1 to n do
   if frac(sqrt(x[i,j]))=0 then
   x[i,j]:=0;
  for i:=1 to n do
  begin
  for j:=1 to n do
  write(x[i,j]:3);
  writeln;
  end;
readln;
end.

 


 جمع سطر و ستون وچاپ ان به همراه ماتريس ورودي.
var
m:array[1..5,1..5]of integer;
row,col:array[1..5]of integer;
i,j:integer;
begin
writeln('please enter elements of array');
for i:=1 to 5 do
 begin
  writeln('enter row:',i);
  for j:=1 to 5 do
  readln(m[i,j]);
 end;
for i:=1 to 5 do
 for j:=1 to 5 do
  begin
   row[i]:=row[i]+m[i,j];
   col[i]:=col[i]+m[j,i];
  end;
  for i:=1 to 5 do
   begin
    for j:=1 to 5 do
     write(m[i,j]:5);
     write(row[i]:5);
     writeln;
     end;
     for i:=1 to 5 do
     write(col[i]:5);
readln;
end.

 


 ترانهاده يک ماتريس
var
a:array[1..3,1..3]of integer;
i,j:integer;
t:integer;
begin
for i:=1 to 3 do
for j:=1 to 3 do
begin
writeln('a[',i,j,']');
readln(a[i,j]);
end;
for i:=1 to 3 do
for j:=1 to 3 do
if j>i then
begin
t:=a[i,j];
a[i,j]:=a[j,i];
a[j,i]:=t;
end;
writeln;
for i:=1 to 3 do
begin
for j:=1 to 3 do
write(a[i,j]:4);
writeln;
end;
readln;
end.

 


 ضرب 2 ماتريس(با کمي تغيير نسبت به راه حل قبلي).
var
a : array [1..3] of integer;
b : array [1..3] of integer;
c : array [1..9] of integer;
i,j,co: integer;
begin
for i:= 1 to 3 do
    begin
    writeln('a[',i,']:=' );
    readln(a[i]);
    write('b[',i,']:='  );
    readln(b[i]);
    end ;
for i:=1 to 3 do
    for j:=1 to 3   do
     begin
      co:=co+1 ;
      c[co]:=a[i]*b[j];
     end ;
for i:=1 to 9 do
    begin
    writeln(c[i]);
    end;
readln;
end.

 


 مرتب سازي خطي
var
x:array[1..100]of integer;
i,a,n:integer;
f:boolean;
begin
f:=false;
writeln('pleae enter a number');
readln(n);
writeln('please enter ',n,' number');
for i:=1 to n do
readln(x[i]);
writeln('please choose one of the number''s');
readln(a);
for i:=1 to 3 do
if a=x[i]then
f:=true;
if f=true then writeln('found')
else write('not found');
readln;
end.

 


 مرتب سازي انتخابي
var
x:array[1..100]of integer;
i,j,n,min,f:integer;
begin
write('enter n:=');
readln(n);
writeln('please enter ',n,' number');
for i:=1 to n do
readln(x[i]);
for i:=1 to n-1 do
 begin
  min:=x[i];
  f:=i;
  for j:=i+1 to n do
  if x[j]   begin
    min:=x[j];
    f:=j;
   end;
  x[f]:=x[i];
  x[i]:=min;
 end;
 for i:=1 to n do
 write(':',x[i]);
readln;
end.

 

اميدوارم تا اينجاي کار مشکلي براتون پيش نيومده باشه.
 برنامه اي که دو کلمه ميگيرد و بعد از کاراکتر '='در عبارت اول کلمه دوم را قرار مي دهد.

var
n,m:string;
j:integer;
Begin 
writeln('please enter two word');
readln(n);
readln(m);
j:=pos('=',n);
delete(n,j+1,length(n)-j);
insert(m,n,j+1);
writeln(n);
readln;
end.

 


 مرتب سازي حبابي
var
x:array[1..10]of integer;
i,a,j:integer;
begin
writeln('please enter 5 number');
for i:=1 to 5 do
readln(x[i]);
for i:=1 to 5 do
for j:=1 to 5-i do
if x[j]>x[j+1]then
begin
a:=x[j];
x[j]:=x[j+1];
x[j+1]:=a;
end;
for i:=1 to 5 do
write(x[i]:3);
readln;
end.

 


  تبديل کلمه is  به are
var
a,b,c:string;
i:integer;
begin
a:='pascal is book';
b:='is';
c:='are';
i:=pos(b,a);
while i>0 do
 begin
   delete(a,i,2);
   insert(c,a,i);
   i:=pos(b,a);
 end;
 write(a);
readln;
end.

 


 تشخيص متقارن بودن يک کلمه يا عدد مثل عدد 123321 يا 13431
var
n:string;
i,k:integer;
begin
k:=1;
writeln('please enter a string');
readln(n);
for i:=1 to(length(n)div 2)do
begin
if n[i]<>n[length(n)-i+1]then
k:=0;
end;
if k=1 then writeln('ok')
else write('no');
readln;
end.

 


 10 عدد رندوم بين 10 تا 30
var
 i,a:integer;
begin
 for i:=1 to 10 do
 begin
 randomize;
 a:=random(21)+10;
 writeln(a);
 end;
readln;
end.

 


نکته:در اين برنامه عدد 21 در واقع تفاضل بين دو عدد انتخابي است.
 برنامه اي بنويسيد که تعداد کلمات يک جمله را حساب کند.
Readln(st);
S:=0;
St:=st+' '
While pos(' ',st) <> 0 do
Begin
S;=s+1;
Delete(st,1,pos(' ',st));
While st[1]=' 'do
Delet (st,1,1);
End;
End.

 


 يه برنامه جالب با استفاده از تابع chr
var
y:char;
begin
y:=chr(3);
writeln(y:20,y,y:4,y:1);
writeln(y:18,y:5,y:5);
writeln(y:17,y:12);
writeln(y:17,y:12);
writeln(y:17,y:12);
writeln(y:18,y:10);
writeln(y:19,y:8);
writeln(y:20,y:6);
writeln(y:21,y:4);
writeln(y:22,y:2);
writeln(y:23);
readln;
end.

 

مدير

  درباره




  آمار

»تعداد بازديدها:
»کاربر: Admin

لينك Rss

  مديران / وضعيت در ياهو


  لينک ها
سایت استاد ارش میرزائی
بهترین نرم افزارهای موبایل
یه وبلاگ بسیار خوب برای دانلود برنامه های مختلف
اموزش برنامه نویسی پاسکال
pascalprograms.mihanblog.com
smt2.persianblog.ir
سایت دانشکده فناوری اطلاعات
وبلاگ تخصصی برنامه نویسی c++
پرقدرت ترین و با امکانات ترین سایت جذاب و علمی مخصوص دانش آموزان ایرانی
بهترین وبلاگ دانلود سوالات پیام نور
تبلیغات وبلاگی
برنامه نویسی شی گرا در سی شارپ
دانلود نرم افزار

 

 

Designed Template By: PersiaStyle.Com
Coryright© PersiaStyle. All Rights Reserved