سوال :برنامه ای بنویسید که تمام اعداد سه رقمی که یکان و صدگان آنها برابر باشد را در خروجی چاپ کند:

طریقه حل: از آنجایی که اعداد 3 رقمی بین 100 تا 999 می باشد ابتدا به یک حلقه  for بین 100 تا 999 نیاز داریمبعد از آن باید یکان و صدگان عدد را جدا کرده با هم مقایسه کنیم برای جدا کردن یکان عدد را mod    10 میکنیم زیرا اگر عددی را  mod  10 کنیم با قی مانده آن فقط قسمت یکان عدد میباشد وبرای جدا کردن صدگان عدد آن را div   100 میکنیم  وسپس با یک شرط آنها را مقایسه میکنیم در صورت برابر بودن عدد را چاپ میکنیم ودر غیر این صورت به عدد بعدی حلقه می رویم.

uses crt;

var

f:integer;

begin

for f:= 100 to 999 do

if (f div 100)=(f mod 10) then

write(f:5);

readln;

end.

سوال: برنامه ای بنویسید که عددی را از ورودی دریافت کند و در صورت کامل بودن عدد پیغامی مناسب چاپ کند:

طریقه حل :(کامل بودن عدد یعنی برابر بودن مجموع مقسوم علیه های کوچکتر از عدد با خود عدد )برای حل این مسئله ابتدا به یک حلقه  for  نیاز داریم که تمام مقسوم علیه های عدد را از 1 تا یک رقم کمتر از خود عدد بدست آورد (y در صورتی مقسوم علیه x  میباشد که x mod y = 0  باشد)و آنها را با هم جمع کند و در صورت برابر بودن مجموع با خود عدد آن عدد کامل است و در آخر فقط به یک پیغام مناسب در خروجی نیاز داریم

uses crt;

var

i,s,a:word;

begin

clrscr;

write('enter a number:');

readln(a);

for i:= 1 to a-1 do

if (a mod i)=0 then

begin

write(i,'  ');

s:= s+i;

end;

writeln;

writeln(s);

if a=s then

writeln('yes yes yes yes yes')

else

write('no no no no no ');

readln

end.

سوال: برنامه ای بنویسید که صدایی را بلندگوی کیس خارج کند (صدای دزدگیر)و در صورت زدن یک کلید از برنامه خارج شود

uses crt;

var

i,b:word;

begin

repeat

for b:= 1 to 4 do

begin

for i:=1000 to 2500 do

begin

sound(i);

delay(1);

end;

end;

nosound;

delay(100);

until keypressed;

end.

سوال:برنامه ای بنویسید که تعدادی از عناصر سری فیبوناچی را برابر با ورودی چاپ کند و این کار را تا زمانی ادامه دهد که ورودی برابر  با صفر باشد و در صورت صفر بودن از برنامه خارج شود .(در سری فیبوناچی از جمع دو عنصر اول عنصر سوم بدست می آید)

طریقه حل : ابتدا برنامه در حلقه wile  میگذاریم که برنامه تا زمانی اجرا شود که ورودی نابرابر صفر باشد بعد از یک حلقه  for  استفاده میکنیو که به تعدادی که میخواهیم از سری فیبو را چاپ کند  از آنجایی که دو عنصر اول فیبو 1 و 1 هستند یکی را خودمان مقدار دهی میکنیم و دیگری را از حلقه مقدار میدهیم  و آنها را چاپ میکنیم سپس آنها را جمع کرده و مقادیر را جابجا میکنیم و تعداد دفعات تکرار به مقدار ورودی بستگی دارد و در صورت ی که ورودی صفر باشد از برنامه خارج میشویم.

Program test;

Uses crt;

Var

a,b,c,d,e:integer;

Begin

a:= 1;

Clrscr;

while a<>0 do

begin

Write ('enetr a number:');

Readln(a);

Clrscr;

d:=0;

e:=1;

For b:= 1 to a do

begin

c:=d+e;

write (e,'  ');

d:=e;

e:=c;

end;

writeln;

end;

end.

uses crt ;

var  i,j,n,c:byte ;

begin

  textmode(co40); textattr:=(1*16)+14;

    write('enter number= ');

    readln(n);

    clrscr;c:=1;

   for i:=0 to n-1  do

     begin

     c:=c+i;

      for j:=c to (i+c) do

      write(j:3);

      writeln;

      end;

readln

end.

سوال : برنامه ای بنویسید که در صورتی که ورودی 5 باشد خروجی آن به صورت زیر باشد

12345

12345

12345

12345

12345

طریقه حل:برای اینکار از دو حلقه  for  تودرتو با مقداری برابر ورودیاستفاده میکنیم  از حلقه اول برای تکرار کار حلقه دوم استفاده میشود اما حلقه دوم برای چاپ اعداد 1  تا  ورودی به کار میرود  از یک  writeln  برای انتقال کرسر  به خط بعد استفاده میکنیم.

uses crt;

var

x,i,j:integer;

begin

readln(x);

for i:=1 to x do

begin

for j:=1 to x do

write(j);

writeln;

end;

readln

end.

سوال : برنامه ای بنویسید که در صورتی که ورودی 5 باشد خروجی آن به صورت زیر باشد

1

12

123

1234

12345

طریقه حل:در این برنامه از دو حلقه متداخل استفاده میکنم حلقه اول برای تکار حلقه دوم و دادن مقدار ثانویه به آن بکار میرود در حلقه دوم مقدار ثانویه با هر بار تکرار تغییر میکند تا اعداد به صورت بالا چاپ شوند از  writeln  برای انتقال کرسر  به خط بعد استفاده میشود.

uses crt;

var

x,i,j:integer;

begin

readln(x);

for i:=1 to x do

begin

for j:=1 to i do

write(j);

writeln;

end;

readln

end.

سوال : برنامه ای بنویسید که در صورتی که ورودی 5 باشد خروجی آن به صورت زیر باشد

11111

22222

33333

44444

55555

طریقه حل :

uses crt;

var

x,i,j:integer;

begin

readln(x);

for i:=1 to x do

begin

for j:=1 to x do

write(i);

writeln;

end;

readln

end.

سوال : برنامه ای بنویسید که در صورتی که ورودی 5 باشد خروجی آن به صورت زیر باشد

1

22

333

4444

55555

طریقه حل :

uses crt;

var

x,i,j:integer;

begin

readln(x);

for i:=1 to x do

begin

for j:=1 to i do

write(i);

writeln;

end;

readln

end.

سوال : برنامه ای بنویسید که در صورتی که ورودی 5 باشد خروجی آن به صورت زیر باشد

12345

23451

34512

45123

51234

طریقه حل :

uses crt;

var

i,j,x,k:integer;

begin

clrscr;

readln(x);

for i:=1 to x do

begin

for j:=i to x do

write(j);

for k:=1 to i-1 do

write(k);

writeln;

end;

readln

end.

سوال: برنامه ای بنویسید که در صورت زدن کلیدی از کیبرد مشخص کند که این کلید از حروف بزرگ است یا حروف کوچک یا عدد است یا غیره و پیغامی مناسب چاپ کند و این کار را تا زمانی ادامه دهد که کلید  Esc  را فشار دهیم.

طریقه حل: با استفاده از دستور readkey   کلیدی را از کیبرد میگیریم و سپس با استفاده از دستور  case  مشخص میکنیم  که جز کدام گروه کلیدها است

uses crt;

var

a:char;

begin

repeat

a:=readkey;

CLRSCR;

case a of

#48..#57:writeln(' this is nomber key');

#65..#90:writeln(' this is longword key');

#97..#122:writeln(' this is shortword key');

#27:halt;

else

writeln(' this key isnot long or shortword or nomber key');

end;

until a=#27 ;

end.

سوال : برنامه ای بنویسید که عددی را از ورودی گرفته معکوس آن را چاپ کند (معکوس 12345 = 54321)

طریقه حل: ابتدا با استفاده از دستور mod   ارقام عدد را یک به یک جدا کرده و سپس با ضرب رقم اول در 10 و جمع کردن آن با رقم دوم و ادامه این کار تا پایان عدد ،معکوس آن عدد را بدست می آوریم

uses crt;

var

a,b,c:longint;

begin

clrscr;

c:=0;

write('enter your nomber = = =>');

readln(a);

repeat

b:= a mod 10;

a:= a div 10;

c:=(c*10)+b;

until a=0;

writeln(c);

readln

end.

سوال : برنامه ای بنویسید که در صورتی که ورودی 5 باشد خروجی آن مثلث متساوی الساقین  زیر باشد

     1         

  232    

34543  

4567654 

567898765

طریقه حل:

uses crt;

var

a,x,i,j,b,z:integer;

begin

CLRSCR;

WRITE ('ENTER A NOMBER =');

a:=0;

Readln(x);

for b:=1 to x do

begin

write('':x*2-b);

for i:=1 to b do

write(i+a);

for j:=(b-1) downto 1 do

write(j+a);

a:=a+1;

Writeln;

End;

readln

end.

سوال: برنامه ای بنویسید که یک عدد را گرفته درخت فاکتوری آن را به صورت زیر چاپ کند ودر صورتی که عدد اول بود پیغامی مناسب چاپ کند

     1001

     /       \

7                        143

/     \

11                  13

طریقه حل : با استفاده از حلقه ها  for  متداخل ابتدا کوچکترین مقسوم علیه اول عدد را پیدا کرده و عدد را بر آن تقسیم کرده هر دو را چاپ میکنیم  با عدد حاصل هم همینگونه عمل میکنیم تا ریشه یک عدد اول بدست آید

uses crt;

var

a,b,c,d,g:longint;

begin

clrscr;

write('enter a nomber = ');

readln (a);

clrscr;

writeln('       ',a);

d:=5;

for b:= 2 to a do

for c:= 2 to a-1 do

if  a mod c =0 then

begin

writeln('/   \':d+6);

for g:= 1 to d do

write(' ');

d:=d+4;

write (c,'     ');

a:= a div c ;

writeln(a);

break;

end;

if d < 8 then

begin

clrscr;

writeln (a,' is a prime !');

end;

readln

end.

سوال: برنامه ای بنویسید که یک برنامه رمز را شیبه سازی کند(حداکثر 8 کاراکتر)با هر بار زدن کلید یک کارکتر * در صفحه ظاهر شود

طریقه حل : با استفاده از حلقه 8 کاراکتر گرفته و با مقایسه آنها با رمز تعریف شده صحت یا عدم صحت رمز را مشخص میکنیم

uses crt;

var

a,b:char;

z,i,j:integer;

begin

b:=#32;

z:=0;

clrscr;

write ('enter a password = = =>');

for i:= 1 to 8 do

begin

a:=readkey;

if i<>9 then

begin

write('*');

if a=b then

z:=z+1

end;

end;

clrscr;

if z=8 then

write ('your password is true')

else

writeln(' password isnot true');

readln

end.

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

طریقه حل : با استفاده از چند حلقه متداخل و چاپ مقادیر حلقه ها در داخلیترین حلقه و نیز شرطی میگذاریم که در صورت زدن کلیدی از برنامه خارج شویم

uses crt;

var

h,m,c,e:integer;

d:longint;

begin

for h:= 0 to 24 do

for m:= 0 to 60 do

for c:= 0 to 60 do

for e:= 0 to 99 do

begin

write (h,' : ',m,' : ',c,' : ',e);

for d:= 1 to 1000000 do;

if keypressed then halt;

clrscr;

end;

end.

سوال : برنامه ای بنویسید که تاریخ یک روز را از شما گرفته تاریخ روز بعد را نشان دهد (با فرض اینکه اسفند همیشه 29 روز است)

uses crt;

var

y,m,d:byte;

begin

clrscr;

write('enter a date = = =>  /  /');

gotoxy(18,1);

read(y);

gotoxy(21,1);

read(m);

gotoxy(24,1);

read(d);

if m<=6 then

if d=31 then

begin

d:=1;

m:=m+1;

end

else

d:=d+1

else

if m<=11 then

if d=30 then

begin

d:=1;

m:=m+1;

end

else

d:=d+1

else

if d=29 then

begin

d:=1;

m:=1;

y:=y+1;

end

else

d:=d+1;

write(y,'/',m,'/',d);

readln;

readln

end.

سوال : برنامه ای بنویسید که جدول ضرب 10 را چاپ کند

طریقه حل : با استفاده از دو حلقه تودرتو و ضرب کردن مقادیر آنها

uses crt;

var

i,j:1..10;

begin

clrscr;

textbackground(12);

for i:=1 to  10 do

for j:=1 to 10 do

begin

textcolor(3);

gotoxy(j*8-7,i);

write(j,'*',i,'=',j*I);

end;

readln;

end.

سوال برنامه ای بنویسید که خروجی زیر را چاپ کند

1            64

2            32

4          16

      8        8

     16       4

     32       2

     64       1

uses crt;

var

a,b:integer;

begin

clrscr;

a:=1;

b:=64;

while a<= 64 do

begin

write(a,'     ');

writeln(b);

a:=a*2;b:=b div 2;

end;

readln

end.

سوال : برنامه ای بنویسید که کلیدی از کیبرد بگیرد و مشخص کند کلید زده شده  f  هست یا نه .

طریقه حل ک با دستور  readkey  یک کلید میگیریم  سپس با دستور  case  کد  اسکی آن را با کلید های f    مقایسه میکنیم

uses crt;

var

c:char;

BEGIN

CLRSCR;

TEXTMODE(CO40);

writeln('enter F1....F10');

c:=readkey;

if c=#0 then

c:=readkey;

case c of

#59:writeln('F1');

#60:writeln('F2');

#61:writeln('F3');

#62:writeln('F4');

#63:writeln('F5');

#64:writeln('F6');

#65:writeln('F7');

#66:writeln('F8');

#67:writeln('F9');

#68:writeln('F10');

ELSE WRITELN('THE NOT F1....F10');

END;

READLN

END.

سوال: برنامه ای بنویسید که 10 عدد از ورودی گرفته کوچکترین وبزرگترین آنها را مشخص کند و بگوید در ورودیها چند  7و  چند 14 و چند 24 بوده

uses crt;

var i,max,min,b,c,d,a:integer;

begin

clrscr;

d:=0;

b:=0;

c:=0;

write('enter number=');

readln(a);

max:=a;

min:=a;

for i:=1 to 9 do

begin

readln(a);

if max