Задачи и решения для программирования в Паскаль

readkey;

end.

С клавиатуры вводится символ. Определить, к какому алфавиту – русскому или латинскому – он принадлежит.

program xxxx;

uses crt;

var a: char;

begin

clrscr;

write('Введите символ: ');readln(a);

case a of

'a'..'z','A'..'Z':writeln('символ латинского алфавита');

'а'..'я','А'..'Я': writeln('символ русского алфавита');

end;

readkey;

end.

Определить, является введенное 3-хзначное число палиндромом

uses crt;

var n,n1,n2,n3,r:word;

begin

clrscr;

Write('Ведите 3-хзначное число: '); readln(n);

n1:=n div 100;

n2:=(n div 10) mod 10;

n3:=n mod 10;

r:=n3*100+n2*10+n1;

writeln('обратное число--',r);

if r=n then writeln('Введеное число ',n,' - палиндром ')

else writeln('Введеное число ',n,' - не является палиндром ');

readkey;

end.

В двенадцатилетнем цикле года носят названия животных: мышь, корова, тигр, заяц, улитка, змея, лошадь, овца, обезьяна, курица, собака, свинья. Известно, что 1984 год был годом мыши. Написать программу, которая вводит номер года нашей эры с клавиатуры и выводит его название по 12-ти летнему циклу. (1001 – корова).

program t2;

uses crt;

var a,n:word;s:string;

begin

clrscr;

write('Введите год: ');

readln(a);

n:=a mod 12;

case n of

1:s:='курца';

2:s:='собака';

3:s:='свинья';

4:s:='мышь';

5:s:='корова';

6:s:='тигр';

7:s:='заяц';

8:s:='улитка';

9:s:='змея';

10:s:='лошадь';

11:s:='овца';

12:s:='обезьяна';

end;

writeln(s);

readkey;

end.

Написать программу проверки знания таблицы умножения

program tm;

uses crt;

label 1;

var c,b,a:byte;q:char;

begin

1:textbackground(7);textcolor(9);

clrscr;

writeln(' п р о в е р к а з н а н и я т а б л и ц ы у м н о ж е н и я');

randomize;

a:=random(10)+1;

b:=random(10)+1;

gotoxy(30,5);

textcolor(1);

write(a,'*',b,'=? ');

textcolor(9);

readln(c);

textcolor(1);

if (a*b=c) then writeln('Правильно!':50) else writeln('Неправильно!':50);

gotoxy(45,20);

textcolor(9);

write('п р о д о л ж и т ь ? ( Y / N )');

readln(q);

if (q='y')or(q='Y')or(q='н')or(q='Н') then goto 1;

readkey;

end.

Представить вещественное число в денежном формате

Uses crt;

Var a,b:word; r:string; x:real;

begin

clrscr;

write ('Введите число - ');

readln (x);

a:=trunc (x);

if a div 10 mod 10 1 then

case a mod 10 of

0,5..9:r:='рублей';

1:r:='рубль';

2..4:r:='рубля';

end

else r:='рублей';

write (a,' ',r);

x:=frac (x);

b:=trunc (x*100);

if b div 10 mod 10 1 then

case b mod 10 of

0,5..9:r:='копеек';

1:r:='копейка';

2..4:r:='копейки';

end

else r:='копеек';

write (' ',b,' ',r);

readkey;

end.

Циклы

Выдать на экран волны

program rrrr;

uses crt,graph;

var gd,gm:integer;j,x,y,i:word;

begin

gd:=detect;

initgraph(gd,gm,'');

y:=60;

for j:=1 to 5 do begin

x:=50;

for i:=1 to 4 do begin

arc(x,y,0,180,50);

arc(x+100,y,180,360,50);

x:=x+200; end;

y:=y+110; end;

readkey;

end.

program ti; {таблица пифагора}

uses crt;

var j,i:word;

begin

clrscr;

for i:=1 to 10 do begin

for j:=1 to 10 do

write(i*j:4);

writeln; end;

readkey;

end.

определить число фазанов к кроликов по числу голов и ног}

Uses crt;

var x,y,a,b:integer;

begin

clrscr;

write('Введите число голов ');readln(a);

write('Введите число ног ');readln(b);

for x:=0 to a do

for y:=0 to a do

if (x+y=a) and (x*2+y*4=b) then

begin writeln('фазанов - ',x,'кроликов - ',y);readkey;halt;end;

writeln('error');

readkey;

end.

program ti; {нахождение НОД}

uses crt;

var i,n,s,q:word;

begin

clrscr;

randomize;

s:=0;

writeln('enter n ');

readln(n);

for i:=1 to n do begin

q:=random(90)+10;

writeln('числа',q);

s:=s+q; end;

writeln('сумма-- ',s);

readkey;

end.

program ti; {сумма делителей}

uses crt;

var i,n,s:word;

begin

clrscr;

s:=0;

writeln('enter n ');

readln(n);

for i:=1 to n-1 do

if n mod i=0 then begin writeln(i); s:=s+i;end;

writeln('сумма-- ',s);

readkey;

end.

program ti; {n чисел фибоначчи }

uses crt;

var n,n1,n2,n3,i:word;

begin

clrscr;

writeln('введите n ');

readln(n);

n1:=1;

n2:=1;

write(n1:5,n2:5);

for i:=3 to n do begin

n3:=n1+n2;

write(n3:5);

n1:=n2;

n2:=n3;

end;

readkey; end.

Найти число в последовательности Фибоначчи большее заданного числа М и его порядковый номер. Члены ряда Фибоначчи вычисляются по формуле: F(1) = F(2) = 1

F(k) = F(k-1) + F(k-2), k 2

program xxxx;

uses crt;

var n1,n2,k,f,M:word;

begin

clrscr;

writeln('Введите число M');

read(m);

n1:=1;n2:=1;k:=2;

while m=n2 do begin

k:=k+1;

f:=n1+n2;

n1:=n2;

n2:=f; end;

writeln('Число - ',n2, ' его порядковый номер - ',k);

readkey;

end.

Вычислить сумму с точностью до 0.0001:

program xxxx;

uses crt;

var n,k:word;s:real;

begin

clrscr;

s:=2;n:=2; k:=0;

while 2/n=0.0001 do begin

k:=k+1;

s:=s+(2/n);

n:=n+1 end;

writeln('S=',s:10:4,' к-во элементов - ',k);

readkey;

end.

Решить арифметический ребус КИО*ИО= ТОКИО. Вместо каждой буквы необходимо поставить некоторую цифру, причем одинаковые буквы означают одинаковые цифры, а различные буквы - различные цифры.

program xxxx;

uses crt;

var i,k,o,t:word;

begin

clrscr;

for t:=0 to 9 do

for o:=0 to 9 do

for k:=0 to 9 do

for i:=0 to 9 do

If (k*100+i*10+o)*(i*10+o)=(t*10000+o*1000+k*100+i*10+o) then

if (ki) and (ko) and (kt) and (io) and (it) and (ot) then

begin writeln('T-',t:2,' O - ',o,' K - ',k,' I - ',i);

writeln(k,i,o,'*',i,o,'=',t,o,k,i,o)

end;

readkey;

end.

В магазине имеется мастика в ящиках по 16 кг, 17 кг и 21 кг. Получить 185 кг мастики без вскрытия ящиков. Рассмотреть все варианты.

program xxxx;

uses crt;

var o,k,t:word;

begin

clrscr;

for t:=0 to 185 div 21 do

for o:=0 to 185 div 17 do

for k:=0 to 185 div 16 do

If t*21+o*17+k*16=185 then

writeln('по 21 кг -',t:4,' по 17 кг - ',o:4,' по 16 кг - ',k);

readkey;

end.

program ti; {совершенные числа между m и n}

uses crt;

var i,m,n,j,s:word;

begin

clrscr;

writeln('enter m,n ');

readln(m,n);

if mn then begin m:=m+n;n:=m-n;m:=m-n;end;

for j:=m to n do begin

s:=0;

for i:=1 to j-1 do

if j mod i=0 then s:=s+i;

if j=s then writeln(j);

end;

readkey;end.

Проход по экрану имени

program rnok;

uses crt;

var x:word;

begin;

clrscr;

for x:=1 to 76 do begin

textcolor(14);

gotoxy(x,12);

write('Lena ');

delay(10000);

textcolor(0);

gotoxy(x,12);

write('Lena ');

end;

textcolor(14);

gotoxy(x,12);

write('Lena ');

readkey;

end.

Нахождение числа Pi/4 с заданной точностью.

program w5;

uses crt;

var s1,s2:real;k,i:word;

begin

clrscr;

s1:=0;

s2:=1;

i:=1;k:=1;

while abs(s1-s2)0.0001 do begin

s1:=s2;

i:=i+2;

if k mod 2=0 then

s2:=s1+(1/i) else s2:=s1-(1/i);

k:=k+1; end;

writeln(s2:10:6);

writeln('Pi=',s2*4:10:6);

readkey;

end.

График функции

uses crt,graph;

var gd,gm,x,y:integer;x1,y1:real;

begin

gd:=detect;

initgraph(gd,gd,'');

setlinestyle(0,0,3);

line(0,240,640,240);

line(320,0,320,480);

while x

line(x,235,x,245);

x:=x+10; end;

while y

line(315,y,325,y);

y:=y+10; end;

x1:=-10;

while x1

y1:=(x1-2)*(x1-2)+2;

x:=trunc(x1*10)+320 ;

y:=240-trunc(y1*10);

putpixel(x,y,14);

x1:=x1+0.01; end;

readkey;

end.

таблица значений функции у=|x|+2 от -4 до 4 с шагом 0.5

program rnok;

uses crt;

var x,y:real;

begin;

clrscr;

writeln('y':20,' : ','x':5);

writeln(' --------------');

x:=-4;

repeat

y:=abs(x)+2;

writeln(y:20:1,' : ',x:5:1);

x:=x+0.5;

until x4;

readkey;

end.

наименьшее общее кратное

program nok1;

uses crt;

var nok,n1,n2:byte;i:word;

begin

clrscr;

writeln('введите два числа'); readln(n1,n2);

nok:=1;

for i:=n1*n2 downto 2 do

if (n1 mod i=0) and (n2 mod i=0) then nok:=i;

write('NOK -',nok);

readkey;

end.

перевод вещественного 10-го числа в двоичный код

program w2;

uses crt;

var i:byte;kc,yc,xc,yd,x1c:longint;xd,kd,x1d,x:real;

begin

clrscr;

kc:=1; x1c:=0;

writeln('введите x ');

readln(x);

xc:=trunc(x);xd:=frac(x);

while xc0 do begin

yc:=xc mod 2;

x1c:=x1c+yc*kc;

kc:=kc*10;

xc:=xc div 2; end;

kd:=0.1; x1d:=0;

for i:=1 to 10 do begin

yd:=trunc(xd*2);

x1d:=x1d+yd*kd;

xd:=frac(xd*2);

kd:=kd*0.1; end;

writeln(x1c+x1d:12:10);

readkey;

end.

{Имеется А монет по 1 тенге, В - 5 тенге,С - 10 тенге, D - 20 тенге

Е - 50 тенге, F - 100 тенге. Можно ли набрать этими монетами сумму S тенге?

Если да, то как}

Uses crt;

var a,b,c,d,e,f,s:word;

i1,i5,i10,i20,i50,i100:word;

k:boolean;

begin

textbackground(7);

clrscr;

textcolor(2);

write('Ведите количество монет по 1 тенге: ');

textcolor(4); readln(a);

textcolor(2);

write('Ведите количество монет по 5 тенге: ');

textcolor(4); readln(b);

textcolor(2);

write('Ведите количество монет по 10 тенге: ');

textcolor(4); readln(c);

textcolor(2);

write('Ведите количество монет по 20 тенге: ');

textcolor(4); readln(d);

textcolor(2);

write('Ведите количество монет по 50 тенге: ');

textcolor(4); readln(e);

textcolor(2);

write('Ведите количество монет по 100 тенге: ');

textcolor(4); readln(f);

textcolor(14);

gotoxy(2,10);

write('Введите сумму: '); readln(s);

k:=false;

gotoxy(1,12);

for i1:=0 to a do

for i5:=0 to b do

for i10:=0 to c do

for i20:=0 to d do

for i50:=0 to e do

for i100:=0 to f do

if s=i100*100+i50*50+i20*20+i10*10+i5*5+i1*1 then begin

writeln(s,'= 100* ',i100,' + 50* ',i50,' + 20* ',i20,' + 10* ',i10,

' 5* ',i5,' 1* ',i1);

k:=true; end;

textcolor(4);

if k=false then write('нельзя набрать эту сумму');

readkey;

end.

Напечатать изображение всех простых несократимых правильных дробей, знаме­натель которых не превышает 8. Найти и напечатать их сумму

program xxxx;

uses crt;

var k,n,m,i:byte;

begin

clrscr;

write('Выбери число от 2 до 9: ');readln(k);

i:=0;

for n:=1 to k do

for m:=1 to k do

if (n0) or (n=1)) then begin

writeln (n,'/',m);

i:=i+1; end;

writeln('к-во чисел - ',i);

readkey;

end.

Найти все четырехзначные числа кратные 7 , у которых и сумма цифр кратна 7.

program xxx;

uses crt;

var k,n,m,i:word;

begin

clrscr;

writeln('Числа, кратные 7 , и у которых сумма цифр кратна 7:');

for i:=100 to 999 do begin

k:=i div 100;

n:=i div 10 mod 10;

m:=i mod 10;

if (i mod 7=0) and ((k+m+n) mod 7=0) then

writeln (i); end;

readkey;

end.

Заданы числители и знаменатели двух правильных положительных простых дро­бей. Вычесть вторую дробь из первой. Результат представить в виде знака дроби, а также ее числителя и знаменателя после возможного их сокращения. Выполнить проверку ввода информации.

program xxxx;

uses crt;

label 1 ;

var i,a,b,c,d,x,y,z,nod:integer;

begin

1:clrscr;

write('Ведите числитель и знаменатель 1 дроби: ');readln(a,b);

write('Ведите числитель и знаменатель 2 дроби: ');readln(c,d);

if (a=b) or (c=d) then begin Writeln('повтори ввод!!');readkey;goto 1;end;

x:=(a*d-b*c);

y:=(b*d);

z:=0;

writeln('Результат: ');

if x=0 then begin writeln(x); readkey;halt;end;

if xy then begin

if (x mod y=0) then begin

x:=x div y; writeln(x); readkey;halt;

end

else z:=x div y;

end;

for i:=1 to abs(x) do

if (x mod i=0) and (y mod i=0) then nod:=i;

x:=x div nod;

y:=y div nod;

if z=0 then writeln(x,'/',y) else writeln(z,' ',x,'/',y);

readkey;

end.

Ввести предложение. Определить:

• Количество слов

• Количество слов с буквой а

• Количество букв в каждом слове

• Порядковый номер самого длинного слова

• С какого символа по счету начинается самое длинное слово

uses crt;

var s:string;

ll,lmax,max,mmax,l,m,m1,i,k,n:integer;

begin

clrscr;

readln(s);

max:=0;

l:=1;{к-во слов}

m:=0; {№ слова}

ll:=0; {всего символов до конца максимального слова}

m1:=0;{длина слова c № m}

k:=0; {к-во слов с а}

n:=0; {=2, если в слове есть а}

for i:=1 to length(s) do begin ll:=ll+1;

if s[i]' ' then begin m1:=m1+1;

if s[i]='a' then n:=2

end

else begin l:=l+1;

if n=2 then begin k:=k+1;n:=0; end;

m:=m+1;

If m1max then begin max:=m1;mmax:=m;lmax:=ll-m1;end;

writeln('слово ',m,' - ',m1);

m1:=0;

end;

end;

m:=m+1;

writeln('слово ',m,' - ',m1);

if n=2 then k:=k+1;

If m1max then begin max:=m1;mmax:=m;lmax:=ll-max+1;end;

writeln('к-во слов с а - ',k);

writeln(' всего слов - ',l);

writeln('самое длинное слово и его длинна -',mmax,max:7);

writeln('самое длинное словo начинается на символе - ',lmax);

readkey;

end.

{Взять числа из файла и переписать их в другой отделяя каждые

3 знака пробелом.Пример, 10000 - 10 000.}

Uses crt;

Var b,s,c:string;

f,t:text;i,j,n,k:integer;

a: array[1..10] of string;

Begin

Clrscr;

Assign(f,'om.in');

Reset(f);

i:=0;

while not(eof(f)) do begin

i:=i+1;

readln(f,a[i]);

writeln(a[i]);

end;

close(f);

n:=i;

Assign(t,'om.out');

rewrite(t);

for i:=1 to n do begin

s:='';b:=a[i];c:='';k:=0;

For j:=length(b) downto 1 do begin

k:=k+1;

if k mod 3=0 then s:=' '+b[j]+s else s:=b[j]+s;

end;

writeln(s);

writeln(t,s);

end;

close(t);

readkey;

end.