وبلاگ رسمی مهدی غلامی میاندهی

S1:=pas***cal
Delete(s1,4,3)
S2:='paal';
S3:='sc';
Insert(s3,s2,);

Readln(name);
For i:=length(name) downto 1 do
Write (name[ i])

Readln(name);
If name[1]='a' then
Writeln('ok')
Else
Writeln('not ok');

Readln(name);
For i:=1 to length(name) do
If I mod 2 = 0 then
Writeln(name[ i]);
روش دیگر:"
For i:=1 to int(length(name)/2) do
Writeln(name[ i*2]);

var
N:string;
Begin
Readln(n);
For i:=1 to int(length(n)/2) do
Begin
If n[i ] <> n[length(n) -i+1] then
K:=0;
End;
If k=1 then
Writeln ('ok')
Else
Writeln('no');
End.

Var st:string;
Begin
Readln(st);
C:=0;
For i:=1 to length(st) do
If st[ i]='a' then ?if st[ i] in ['a','A'] then
C:=c+1;
Writeln(c)

Begin
Readln(st);
C:=0;
While pos('alireza',st) <> 0 do
Begin
C:=c+1;
J:=pos('alireza',st);
Delete(st,pos('ali',st),3);
End;
Write ( c );
End.

Readln(st,st1);
J:=pos('=',st);
Writeln(copy ((st,1 j) , st1, copy (st,j+1,100));

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.

Var
A:text;
B:string;
Begin
Assign(a,'a1.dat');
Reset(a);
Sum:=0;
For i:=1 to 00 do
Begin
Readln(a,b);
If b='ali' then
Sum:=sum+1;
End;
Close(a,b);
End;

Program test;
Var
Name : string;
F,f1,f2:text;
Begin
Assign(f,'a.dat');
Rewrite(f);
Writeln('enter a name ');
Readln(name);
While length(name)>0 do
Begin
Writeln(f,name);
Writeln('enter a name');
Readln(name);
End;
Close(f);
Reset(f);
Assign(f1,'a1.dat');
Assign(f2,'a2.dat');
Rewrite(f1);
Rewrite(f2);
While not eof (f) do
begin
Readln(f,name);
Case name[1] of
'a'..'u':writeln(f1,name);
'v'..'z':writeln(f2,name);
end;
end;
close(f2);
close(f1);
close(f);
end.

var
h,f,g:text;
a:string;
begin

writeln('enter first filename') ;
readln(a);
assign(h,a);
writeln('enter second filename') ;
readln(a);
assign(f,a);
reset(h);
reset(f);
assign(g,'out.dat');
rewrite(g);
while not eof(h) do
begin
readln(h,a);
writeln(g,a);
end;
while not eof(f) do
begin
readln(f,a);
writeln(g,a);
end;
close(f);
close(h);
close(g);
End.

3 2 1 a
B+...+3+2+1 1..b b..1 واكنش
Begin
Writeln (' enter a,b :');
Readln(a,b);
Case a of
1:begin
for i:=1 to b do
write(i);
end;
2:begin
or I;=b downto 1 do
write(i);
end;
3:begin
sum:=0;
for i:=1 to b do
sum:=sum+I;
write(sum);
end;
end.

Var
A:array[1..100] of real;
Begin
For i:=1 to 100 do
Readln(a[i ]);

Var
A:array[1..100] of real;
Begin
For I;=1 to 100 do
Writeln('enter no(',I,')');
Readln(a[ i]);
For i:=1 to 50 do
Writeln(a [ i]);
S:=0;
For i:=1 to 100 do
If i:=1 to 100 do
If a[ i]=20 then
S:=s+1;
Writeln(s);
End.

Var
A:array[1..100] of real;
I:integer;
Begin
For i:=1 to 100 do
Readln(a[ i ] );
Min:=a[1];
Max:=a[1];
For i:=2 to 100 do
Begin
If a[1]< min then
Min:=a[ i];
If a[ i]>max then
Max := a[i ];
End;
Writeln('max is :',max,'min is :',min);
End.

Var
A:array [1..100] of string;
Begin
For i:=1 to 100 do
Readln(a[ i ]);
Ali:=0;
Reza:=0;
Hassan:=0;
For i:=1 to 100 do
Begin
If a[ i]='ali' then
Ali:=ali+1;
If a[ i]='reza' then
Reza:=reza+1;
If a[ i]='hassan' then
Hassan:=hassan+1;
Endd
Writeln(ali is :',ali);
If reza>hassan then
Writeln('reza')
Else
Writeln('hassan');
End.

Var
Name:array[1..100] of string;
No:array[1..100] of real;
Begin
For i:=1 to 100 do
Begin
Readln(name[ i]);
Readln(no[ i]);
End;
Min:=no[1];
Namemin:=name[1];
For i:=2 to 100 do begin
If no[ i]
Begin
Min:=no[ i];
Namemin:=name[ i];
Writeln(namemin);
End.

Var
A:array[1..20,1..4] of real;
Begin
For i:=1 to 4 do
Begin
For j:=1 to 20 do
Readln(a[j, i]);
End;
Min:=a[1,1];
For i:=1 to 4 do
For j:=1 to 20 do
If a[j,i]< min then
Min:=a[j,i];
Writeln(min);
End.

Var
A:array[1..20,1..100] of character;
Bool:Boolean;
B,b1:integer;
Begin
For i:=1 to 100 do
For j:=1 to 20 do
If a[I,j]='A' then
B:=b+1;
If a[I,j]='a' then
B1:=b1+1;
If a[I,j]='z' then
Bool:=true;
End;
If b>b1 then writeln('A>a');
If bIf b=b1 then writeln('A=a');
If true then writeln('''z''exist');
End.

Var

a:array [1..100] of string ;
b:array[1..100] of real;
begin
i:=1;
read(a[ i]);
while a[ i]<>'end' do begin
readln(b[ i]);
i:=i+1;
readln(a[ i]);
end;
j:=i-1;
min:=a[1];
max:=a[1];
for i:= 2 to j do
begin
if b[ i] >max then
begin
max:=b[ i];
name:a[ i];
end;
end
writeln(name);
count:=0;
for i:=1 to j do
if b[i ]<=10 then
count:=count+1;
writeln(count);
for i:=1 to j do
if (b[ i]<17) and (b[ i]>15) then
write(b[ i],a[ i]);
end.

i/i!=1/1!+2/2!+3/3!+4/4!+5/5!
N!= 1*2*3*4*…*n
Begin
Sum:=0;
For n:=1 to 5 do
Begin
For m:=1 to n do
F:=f*m;
Sum:=sum+n/f;
End;
Writeln(sum);
End.

Var
A:array [1..4,1..20] of real;
Begin
For i:=1 to 4 do
For j:=1 to 20 do
Begin
Writeln('please enter nomreh');
Readln(a[I,j]);
End;
For i:=1 to 4 do
Begin
Sum:=0 ;
For j:=1 to 20 do
Begin
Sum:=a[I,j]+sum;
End;
Writeln(sum/20,'average of this class');
End;
For i:=1 to 4 do
Begin
Max :=a[1,1];
Min:=a[1,1];
For j:=2 to 20 do
Begin
If a[I,j]>max then
Max :=a[I,j];
End;
Writeln(I,min,max);
End;
End.

Var st :string;
Num,e:integer;
St:='352';
Val (st,num,e);

St:='35#'2;
Val (st,num,e);

Var x:integer;
St:string;
X=352;
Str(x:5,st);

با اجرای این دستور مقدار 352 به رشته '352' تبدیل شده در st قرار میگیرد

موفق باشید .

مثال : برنامه ای بنویسید كه دو عدد را از ورودی دریافت و چنانچه عدد اول در بازه 0 تا 5 بود توان دوم عدد دوم را چاپ كند چنانچه 68 بود حاصلضرب دو عدد را چاپ كند و در غیر اینصورت مقادیر مجاز را چاپ كند.

BEGIN
WRITELN('ENTER TWO NUMBER');
READLN(A,B);
CASE A OF
0..5 :WRITELN(B*B);
68:WRITELN(A*B)
ELSE
WRITELN('ENTER 0..5 OR 68');
END;
END.

- معادل برنامه بالا با دستور If

Begin
Writeln('enter 2 number');
Readln(a,b);
If (a>=0)and(a<=5) then
Writeln(b*b)
Else
If a=68 then
Writeln(a*b)
Else
Writeln('enter 0..5 or68');
End.

تكلیف : روشی برای تلفظ اعداد پیدا كنید.

حلقه تكرار :

1- تعداد معین
2- تعداد معین

Do مقدار نهایی to { مقدار شروع=: متغیر for

begin
___
___
___
end; 

توجه مهم : در برخی از حلقه ها دستورات داخل حلقه به متغیر حلقه مرتبط می باشند و در برخی موارد هیچگونه ارتباطی وجود ندارد.
حلقه for برای تعداد تكرار معین به كار میرود

Downto : در مواردی به كار میرود كه مقدار اولیه از مقدار نهایی بیشتر باشد

مثال : برنامه ای بنویسید كه توان دوم اعداد 100 تا 200 را چاپ كند. 

Begin
For i:=100 to 200 do
Begin
Writeln(i*i);
End;
End.

نكته : اجازه ندارید مقدار متغیر حلقه را در داخل بدنه عوض كنید .

مثال : برنامه ای بنویسید كه حاصلجمع اعداد 100..1 را چاپ كند.

Begin
Sum:=0;
For i:=1 to 10 do
Begin
Sum:=sum+i
End;
Write(sum);
End.


مثال : برنامه ای بنویسید كه حاصلجمع مضارب 5 بین 0 تا 100را به دست آورد. 

Begin
Sum:=0;
For I:=1 to 20 do
Begin
Sum:=sum+i*5;
End;
Writeln(sum);
End. 

مثال : برنامه ای بنویسید كه دو عدد را از ورودی دریافت و اعداد ما بین این دو عدد را چاپ كند (aBegin

Writeln('enter a,b');
Readln(a,b);
For I:= a to b do
Writeln(i);
End.

مثال : برنامه ای بنویسید كه با یك حلقه for اعداد بین100..1 و738..353و 950..940 را چاپ كند

For i:=1 to 950 do
Begin
If ( i>=1) and (i<=100) then
Writeln(i);
If (i>353) and (i<=738) then
Writeln(i);
If (i>=940) and (i<=950) then
Writeln(i);
End;
End.

Begin
For i:=1 to 950 do
Case I of
1..100,353..738,940..950: writeln(i);
end;
end. 

باقیمانده mod 

مثال :
X mod y 

مثال : برنامه ای بنویسید كه مضارب 7 بین 1 تا 100 را چاپ كند 

Begin
For i:= 1 to 100 do
Begin
If I mod 7 = 0 then
Writeln(i);
End;
End. 

مثال : برنامه ای بنویسید كه تعداد مضارب 5و7 را در بازه 231~846 چاپ كند. 

Begin
K:=0;
C:=0;
For i:=846 downto 231 do
Begin
If I mod 5 = 0 then
C:=c+1;
If I mod 7 = 0 then
K:=k+1;
End;
Writeln('5=',c,'7=',k);
End;
End. 

مثال : برنامه ای بنویسید كه حقوق پایه وتعداد فرزندان 100 كارگر را از ورودی دریافت و مبلغ حقوق آنها را بر اساس فرمول زیر حساب كند0
1000*تعداد فرزند + حقوق پایه = حقوق كل 

Begin
For i:=1 to 100 do
Begin
Writeln('enter salary and number of children');
readln(salary,num);
kol := salary + num * 1000;
writeln(kol);
end;
end.

مثال : برنامه ای بنویسید كه 100 عدد را از ورودی دریافت و میانگین و حاصلجمع آنها را به ما بدهد. 

Begin
Sum:=0;
For i:= 1 to 100 do
Begin
Writeln('enter num');
Readln(num);
Sum:=sum+num;
End;
Ave:=ave/100;
Writeln(sum,ave);
End.


تعداد تكرار نامعین :
Do شرط while
begin
___
___
___
end;
مثال : برنامه ای بنویسید كه اعداد 100..1 را چاپ كند 

Begin
I:=1;
While i<=100 do
Begin
Write(i);
I:=i+1;
End; 

مثال : برنامه ای بنویسید كه تعدادی اسم را از ورودی دریافت و به ما بگوید چند بار اسم ali تكرار شده است(آخرین اسم end است). 

Var
S:integer;
St:string;
Begin
Read(st);
While st<> 'end' do
Begin
If st='ali' then
S:=s+1;
Read(st);
End;write(s);
End.

مثال : برنامه ای بنویسید كه تعدادی عدد كه آخرین آنها صفر است را از ورودی دریافت و حاصلجمع آنها را چاپ كند. 

Begin
Readln(num);
T:=1;
While num<>0 do
Begin
Sum:=sum+num;
Readln(num);
T:=t+1;
End;
Writeln('s=',s,'average',s/t);
End;
تكلیف : برای دانش آموزان یك كلاس برنامه ای بنویسید كه نام آنها به همراه تعداد نمرات و سپس نمرات آنها را به فرم زیر از ورودی دریافت كند.تعداد دانش آموزان كلاس نامعین است ولی آخرین نفر نامش end است .برنامه میبایستی پس از دریافت هر یك از اطلاعات پیامی به شكل زیر چاپ كند.

Average: Sum: Ali Name:
3
18
20
13.5

var
name:string[10];
ave,sum,nomreh:real;
num,i:integer;
begin
writeln('enter name ' );
readln(name);
while name <> 'end' do
begin
writeln('enter num:');
readln(num);
for i:=1 to num do
begin
writeln('enter nomreh: ');
readln(nomreh);
sum:=sum+nomreh;
end;
ave:=sum/num;
writeln('name:',name,'sum:',sum,'ave:',ave);
writeln('enter name ');
readln(name);
end;
end.

تكلیف : میخواهیم برای برنامه های خود یك منو تهیه كنیم این منو شامل موارد زیر است 

1) load
2) save
3) edit
4) exit
please select a number :

var
num:integer;
begin
writeln(' 1) load');
writeln(' 2) save');
writeln(' 3) edit');
writeln(' 4) exit');
writeln(please select a number : ');
readln(num);
while num<>4 do
begin
case num of
1:writeln('loading');
2:writeln('saving');
3:writeln('editing');
end;
end;
end.

موفق باشید .

زبان پاسكال یكی از زبانهای برنامه سازی است كه ویژگیهای آموزشی آن بسیار بالاست یعنی زبان خوبی برای آموزش برنامه نویسی منظم و دقیق است.قابلیت خوانایی و درك برنامه های این زبان بالاست ومیتوان برنامه هایی نوشت كه احتمال خطاهای آنها بسیار اندك باشد علتش این است كه یك زبان ساختار یافته (structed) است .

ساختار كلی برنامه چیست؟
1-تعریف
2-به وسیله procedure و functionقسمتهای تكراری را از بین ببریم
3-بدنه
فرم كلی پاسكال:
اسم Program
; تعریف ثابت const
; تعریف نوع type
; تعریف متغیرها var
)پارامترها ) نام procedure


begin
____
____
____
end ;
; ( پارامترها ) نام نوع تابع function
begin
____
____
____
end ;
begin
____
____
____
end . 

متغیر : محلی است كه دارای یك اسم می باشد و می توان مقداری را در آن ذخیره كرد

انواع متغیرها در پاسكال: 

Integer :انواع عددی صحیح شامل اعداد بدون نقطه ممیز است
نوع مقادیری كه می پذیرند طول(بایت)
byte 0 تا 255 1
Shortint 128- تا 127 1
integer 32768- تا 32767 2
Word 0 تا 65535 2
Longint 2147483648- تا 2147483647 4



اعداد اعشاری:
انواع عددی اعشاری شامل اعدادی با نقطه ممیز است

نوع مقادیری كه میپذیرند ارقام با معنی طول(بایت) 

single 1.5e-45 تا3.4e38 7 تا 8 4
real 2.9e-39 تا 1.7e38 11 تا 12 6
Double 5.0e-324تا 1.7e308 15 تا 16 8
extended 1.9e-4951تا 1.1e493 19 تا 20 10 

انواع داده های اعشاری

Char :
نوع داده كاراكتری كه با كلمه char مشخص می شود میتواند یك كاراكتر را در خود نگهداری كند بنابراین كاراكترها در یك بایت از حافظه كامپیوتر ذخیره می شوند

String  :
این نوع داده ها برای ذخیره رشته ها مثل اسامی افراد به كار می رود و با كلمه كلیدی string مشخص ی گردد
برای هر رشته باید طول معلوم كنیم اگر طولی تعریف نشود به طور پیش فرض 80 در نظر گرفته میشود(مقدار طول حداكثر 255 است)

 Boolean :
نوع دیگری از داده ها در پاسكال وجود دارند كه داده های بولی خوانده می شوند مقادیر بولی دارای دو ارزش درستی یا نادرستی اند كه در پاسكال با صفر و یك نمایش داده می شوند صفر به معنی نادرستی و یك به معنی درستی به كار میرود این نوع داده ها با كلمه Boolean تعریف میشوند. 

دستورات ورودی در پاسكال:
دستور Readlnبرای خواندن اطلاعات از ورودی به كار میرود.
فرمت آن به صورت مقابل است:
(اسامی متغیرها)read/ln
اسامی متغیرها باید با كاما از یكدیگر جدا شوند..
برای چاپ اطلاعات در خروجی از دستور write/ln استفاده میكنیم.
فرمت آن به صورت مقابل است: 

' یك پیام '
( متغیر ) write/ln
عبارت محاسباتی
انتساب متغیرها:
مقدار ثابت
( متغیر )=: متغیر
عبارت محاسباتی

مثال : برنامه ای بنویسید كه دو عدد را از ورودی دریافت و حاصلجمع آن دو را چاپ كند . 

Program add;
Var
a,b:integer;
begin
writeln('enter 2 num');
readln(a,b);
c:=a+b;
writeln('result is =',c);
end.

تكلیف : چرا برنامه باید ادب داشته باشد ؟
مثال : برنامه ای بنویسید كه حقوق پایه وتعداد فرزندان یك كارگر را از ورودی دریافت و مبلغ حقوق وی را بر اساس فرمول زیر حساب كنید.
10*تعداد فرزندان + حقوق پایه =حقوق كل 

Program test;
Var
Salary:longint;
Child:byte;
kole:integer
Begin
Writeln('enter salary and number of child);
Readln(salary,child);
Kole := salary + child *10
Writeln('kole is ',kole);
END. 

اولویت عملگرها: 

/ *
- + 

then شرط if
Begin
____
____
____
end
else
begin
____
____
____
end;

عناصر شرط:
< > <= >= = <>
اپراتورها :
AND OR NOT XOR
NOT A
1 0
0 1

XOR OR AND B A
0 1 1 1 1
1 1 0 0 1
1 1 0 1 0
0 0 0 0 0 

مثال : برنامه ای بنویسید كه با دریافت دو عدد بزرگترین آنها را چاپ كند. 

Program test;
Var
a,b:integer;
if a>b then
begin
writeln(a);
end
else
writeln(b);
end.

مثال : برنامه ای بنویسید كه با دریافت سه عدد به عنوان ضرایب y=ax2+bx+c معادله درجه دو را حل كند(این برنامه را با یك If بنویسید).
Var
A,b,c:integer;
D,x1,x2:real;
Begin
Writeln('enter a,b,c');
Readln(a,b,c);
D:=b*b-4*a*c;
If (d >=0 ) then
Begin
X1:=(-b+sqrt(d))/2*a);
X1:=(-b-sqrt(d))/2*a);

مثال : برنامه ای بنویسید كه تعداد فرزندان وحقوق پایه و رتبه یك كارگر را از ورودی دریافت و حقوق كل وی را بر اساس فرمول زیر حساب كند.
كسریها - مزایا +بیمه = حقوق كل
5*رتبه +1000* تعداد فرزند = مزایا
مالیات + بیمه = كسریها

بیشتر كمتر یا مساوی 2 تعداد فرزند
تعداد فرزندان 1000 بیمه
هر چیزی دیگر 20 تا 0 رتبه
حقوق پایه حقوق پایه*100/10 مالیات 

begin
writeln('enter salary and grade and number of child');
readln(salary ,num,grade);
if num<=2 then
bimeh:=100
else
bimeh :=num*500;
if (grade>=0) and (grade<=20)then
net := 10/100*salary
else
if grade >20 then
begin
net:=20/100*salary;
mazaya:=num*1000+grade*50;
kasry:=bimeh+net;
kol :=salary + mazaya-kasry;
end;
writeln(kol);
end.

تكلیف : در یك تركیب شیمیایی 4 عنصر شركت دارند مقدار مجاز برای تهیه ماده ای به نام asxd به این صورت است.
A 0 ~ 50
S 0.5 ~ 0.83
X 81 ~ 92 or 824 ~ 901
D -100 ~ 100 

با دریافت مقادیر a,s,x,d از ورودی به ما بگوید كه آیا می توان این ماده را تولید كرد یا نه ؟ 

Begin
Num:=0;
Writeln('please enter a s x d');
Readln(a,s,x,d);
If (a>0) and(a<50) then
Num:=num+1;
If (s>0.5)and (s<0.83) then
Num:=num+1;
If ((x>81)and(x<92))or ((x>824)and(x<901))then
Num:=num+1;
If (d>-100) and (d<100) then
Num:=num+1;
If num=4 then
Writeln('yes can')
Else
Writeln('you can not');
End.

تكلیف : برنامه ای بنویسید كه با دریافت سه عدد و با فرض اینكه عدد دوم وتر میباشد به ما بگویید كه آیا این سه عدد تشكیل یك مثلث قایم الزاویه می دهد یا خیر؟

CASE میتواند تعدادای شرط را بگیرد و انتخاب كند.
مقادیری كه دستور CASE میپذیرد ORDINAL است مقادیری كهORDINAL هستند دارای تركیب نیستند و همچنین قابل شمارش هم هستند مثل INTEGER,CHARACTER,BYTE,BOOLEAN,LONGINT,…
پسREAL,STRING ORDINAL<---- نیستند
CASE تنها دستوری است كه BEGIN ندارد ولی END دارد
مقدارها میتوانند شامل یك مقدار یا چند مقدار كه از یكدیگر با كاما جدا شده اند باشند و یا یگ سری شمارشی باشند مثل:
1:------
1,10,28:------
1..100,150..243:---------
'A'..'Z':---------

Of متغیر Case
Begin : مقدار1
-------
-------
End;
Begin : مقدار2
-------
-------
End;
Begin :Else
-------
-------
End;
End. 

مثال : برنامه ای بنویسید كه یك عدد را از ورودی دریافت (0<=x<3) و تلفظ آنها را چاپ كند.

موفق باشید .