CIRCLE (Random(640),Random(480), 50)

Примеры решения задач на языке Паскаль

 

{ 1. Одна сторона прямоугольника на 5 см. длиннее другой, а сумма их длин равна 17 см. Найти стороны этого прямоугольника.}

Uses crt;

var summa,raz,st:real;

storona1,storona2:real;

Begin

ClrScr;

writeln('Введите сумму длин сторон прямоугольника');

Readln(summa);

writeln('Введите на сколько одна сторона больше другой');

Readln(raz);

st:= (summa - raz) / 2;

storona1:= st;

storona2:= st + raz;

write ('ширина-',storona1:7:2,'см.');

write ('длина-',storona2:7:2,'см.');

End.

{ 2. Нефтебаза отпустила за два дня 2560 л. бензина. Во второй день база отпустила на 280 л. больше. Сколько литров бензина база отпустила отдельно за каждый день? }

Uses crt;

var summa,raz,st,day1,day2:real;

Begin;

Clrscr;

write('Сколько литров бензина отпустила нефтебаза за 2 дня');

Readln(summa);

writeln('Введите на сколько отпущенное кол-во бензина одного дня больше чем другого');

Readln(raz);

st:= (summa - raz) / 2.0;

day1:= st;

day2:= st + raz;

writeln('первый день-',day1:7:2,'л.');

writeln('второй день-',day2:7:2,'л.');

End.

{ 3. Одно число в 2 раза больше другого, а их сумма равна 93. Найти эти числа.}

Uses crt;

var summa,raz,st,storona1,storona2:real;

Begin

ClrScr;

writeln('Введите сумму двух чисел');

Readln(summa);

writeln('Введите во сколько раз одно больше другого');

Readln(raz);

st:= summa / (raz + 1);

storona1:= st;

storona2:= st * raz;

write ('1 число-',storona1:7:2,' ед.');

write ('2 число-',storona2:7:2,' ед.');

End.

{ 4. Составьте алгоритм и программу для определения сдачи после покупки в магазине товара: перчаток стоимостью а руб., портфеля стоимостью б руб., галстука стоимостью с руб. Исходная сумма, выделенная на покупку d руб. В случае нехватки денег сдача получится отрицательной.}

Uses crt;

var change,per,por,gal,cash:longint;

Begin;

Clrscr;

write('введите стоимость перчаток-');

Readln(per);

write('введите стоимость портфеля-');

Readln(por);

write('введите стоимость галстука-');

Readln(gal);

write('введите кол-во денег, имеущихся в наличии-');

Readln(cash);

change:= cash - (per + por + gal);

writeln('Сдача - ',change,'руб.');

End.

{ 5. В течении месяца продавец доставлялна дом 4 л молока в день. В марте молоко стоило х руб за литр Спервого апреля цена молока увеличилась до [x+a] руб за литр Сколько надо заплатить продавцу за все доставленное молоко в конце апреля? Кол-во покупаемого молока осталось прежним}

Uses crt;

var march,april,payment:real;

Begin;

Clrscr;

writeln('Введите стоимость отпускаемого молока в марте');

Readln(march);

writeln('Введите стоимость отпускаемого молока в апреле');

Readln(april);

payment:= march * 4 * 31 + april * 4 * 30;

writeln('Вы должны заплатить с 1-го марта по 30-е апреля включительно ',payment:7:2, ' руб.')

End.

{ 6. Хозяин хочет оклеить обоями длинную стену в своем доме. Длина этой стены равна а и высота б. Рулон обоев имеет длину 12 м и ширину 1 м. Сколько будут стоить обои для всей стены если цена одного рулона к руб}

Uses crt;

var a,b,c,d,price,payment,k:real;

Begin;

Clrscr;

writeln('Введите параметры стены(высота)');

Readln(a);

writeln('Введите параметры стены(ширина)');

Readln(b);

writeln('Введите стоимость одного рулона обоев');

Readln(price);

writeln('Введите длину рулона обоев)');

Readln(d);

writeln('Введите ширину рулона обоев');

Readln(c);

k:=b/((d/a)*c)+1;

payment:=k * price;

writeln('Обои для всей стены будут стоить ',payment:7:2,' руб.');

writeln('Вам потребуется купить',k,' рулонов');

End.

{ 7. Некоторый автомат может запросить два числа и выполнить 3 команды. Команда а преобразует имеющуюся пару чисел (х,у) в пару (х-у,у) команда б преобразует пару чисел (х,у) в пару (х+у,у) команда с преобразует пару (ч,у) в (у,х) Составьте алгоритм и программу работы автомата}

Uses crt;

var x,y,number:integer;

Begin;

Clrscr;

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

Readln(x);

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

Readln(y);

writeln('Какое преобразование следует выполнить:1.(x-y,y), 2.(x+y,y), 3.(y,x)');

Readln(number);

Case number of

1: writeln(x - y,',',y);

2: writeln(x + y,',', y);

3: writeln(y,',', x);

End;

End.

{ 8. Составьте алгоритм и программу выбирающую из трех чисел то которое лежит между двумя другими }

Uses crt;

var a,b,c,low,high,mid:integer;

Begin;

Clrscr;

writeln('Введите три числа(после каждрого ENTER)');

Readln(a);

Readln(b);

Readln(c);

low:=a;

high:=a;

IF b < low THEN low:=b;

IF c < low THEN low:= c;

IF b > high THEN high:= b;

IF c > high THEN high:= c;

IF low=a THEN begin

if high=b then mid:=c;

if high=c then mid:=b;

End;

IF low=b THEN begin

if high=c then mid:=a;

if high=a then mid:=c;

End;

IF low=c THEN begin

if high=a then mid:=b;

if high=b then mid:=a;

End;

writeln('Между ',low,' и ', high,' лежит ', mid);

End.

 

Uses crt;

var choice,x,y:integer;

Label 1,2;

Begin;

Clrscr;

writeln('Под какой буквой следует выполнить задание A(1) Б(2)');

Readln(choice);

IF choice = 1 THEN GOTO 1;

IF choice = 2 THEN GOTO 2;

Halt;

1:

Clrscr;

writeln('Введите Х');

Readln(x);

IF x >= 0 THEN writeln('Y=0');

IF x < 0 THEN writeln('Y=2*x', ' y=', x * 2);

Halt;

2:

Clrscr;

writeln('Введите Х');

Readln(x);

IF x < 0 THEN writeln('Y=x^2', ' Y=', x *x);

IF x >= 0 THEN writeln('Y=-(x^2)', ' y=', -(x * x));

Halt;

End.

{ 10. Определить в какие отряды распределят детей}

Uses crt;

var adge:integer;

Begin;

Clrscr;

writeln('Введите возраст ребенка');

Readln(adge);

IF (adge > 5) and (adge <= 7) THEN writeln('5-й отряд');

IF (adge > 7) AND (adge <= 9) THEN writeln('4-й отряд');

IF (adge > 9) AND (adge <= 11) THEN writeln('3-й отряд');

IF (adge > 11) AND (adge <= 13) THEN writeln('2-й отряд');

IF (adge > 13) AND (adge <= 15) THEN writeln('1-й отряд');

IF (adge < 6) OR (adge > 15) THEN writeln('В лагерь не допускается');

End.

{ 11 Построение треугольника по трем точкам}

Uses crt,graph;

var x,x1,x2,y,y1,y2,gd,gm:integer;

a,b,c:real;

Begin

Clrscr;

writeln('Введите координаты первой точки (X и Y) после каждой коор. ENTER');

Readln(x);

Readln(y);

writeln('Введите координаты второй точки (X1 и Y1) после каждой коор. ENTER');

Readln(x1);

Readln(y1);

writeln('Введите координаты третьей точки (X2 и Y2) после каждой коор. ENTER');

Readln(x2);

Readln(y2);

a:=sqrt((x-x1)*(x-x1)+(y-y1)*(y-y1));

b:=sqrt((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2));

c:=sqrt((x2-x)*(x2-x)+(y2-y)*(y2-y));

if (a+b>c) and (c+b>a) and (a+c>b) then

Begin

writeln('Построение треугольника провести можно ');

initgraph(gd,gm,'c:\bp\bgi');

Line(x,y,x1,y1);

Line(x1,y1,x2,y2);

Line(x2,y2,x,y);

Delay(3000);

End

else writeln('Треугольник не построится ');

End.

{ 12 Программа проверяющая выполняется ли условие существования треугольника}

Uses crt;

var a,b,c:integer;

p,s:real;

Begin

Clrscr;

writeln('Введите длины сторон тр-ка (a,b,c)');

Readln(a);

Readln(b);

Readln(c);

p:=a+b+c;

s:=sqr(p/2*(p/2-a)*(p/2-b)*(p/2-c));

if (a+b>c) and (a+c>b) and (c+b>a) then

Begin

writeln('Периметр - ',p);

writeln('Площадь - ',s);

End

else writeln('Треугольник не существует');

End.

{ 13. Определить какая из двух точек находится дальше от: начала координат; окружности заданного радиуса с центром в начале координат }

Uses crt;

var x1,x2,y1,y2,r:real;

Begin;

Clrscr;

writeln('Введите координаты первой точки (X и Y) после каждой коор. ENTER');

Readln(x1);

Readln(y1);

writeln('Введите координаты второй точки (X1 и Y1) после каждой коор. ENTER');

Readln(x2);

Readln(y2);

writeln('Введите радиус окружности(если нет, то r=0)');

Readln(r);

{Т.к. координаты должны браться по модулю, то:}

x1:= SQR(x1*x1);

x2:= SQR(x2*x2);

y1:= SQR(y1 *y1);

y2:= SQR(y2 * y2);

IF r *r > x1 * x1 + y1 *y1 THEN writeln('Первая точка лежит в пределах окружности');

IF r * r > x2 *x2 + y2 *y2 THEN writeln('Вторая точка лежит в пределах окружности');

IF x1 * x1 + y1 *y1> x2 *x2 + y2 *y2 THEN

Begin

writeln('первая точка находится дальше.');

End

else writeln ('вторая точка находится дальше.');

IF x1 * x1 + y1 *y1> x2 *x2 + y2 *y2 THEN

Begin

writeln('Первая точка лежит дальше от окружности');

End

else writeln('Вторая точка лежит дальше от окружности');

End.

{ 14. Определите из двух девочек старшую}

Uses crt;

var adge1,adge2:integer;

Begin;

Clrscr;

writeln('Введите годы рождения девочек (первой и второй после каждой ENTER)');

Readln(adge1, adge2);

iF adge1 < adge2 THEN writeln('Первая девочка старше') ELSE writeln('Вторая девочка старше');

End.

{ 15. Вводятся оценки по физике и математике Выведи на экран "Молодец" если их сумма равна или более 9 в противном случае выведи "Подтянись"}

Uses crt;

var a,b:integer;

Begin;

Clrscr;

writeln('Введите оценки за контрольные работы по физике и математике после каждого пред. Enter');

Readln(a);

Readln(b);

IF a + b >= 9 THEN writeln('Молодец!') ELSE writeln('Подтянись');

End.

{16. Вычисление сдачи с покупки музыкального диска}

Uses crt;

var r,k,r1,k1,how:real;

Begin;

Clrscr;

writeln('Введите стоимость диска(руб.,коп.) через Enter');

Readln(r);

Readln(k);

writeln('Введите размер располагаемой суммы(руб.,коп.) через Enter');

Readln(r1);

Readln(k1);

IF r * 100 + k < r1 * 100 + k1 THEN writeln('Да, вам хватит денег на покупку');

IF r * 100 + k > r1 * 100 + k1 THEN

Begin;

how:= (r * 100 + k) - (r1 * 100 + k1);

r:= INT(how / 100);

k:= how - INT(how / 100) * 100;

writeln('Нет, вам не хватит денег на покупку ',r:7:0,' руб. ', k:7:0, ' коп.');

END;

End.

{ 17. Написать алгоритм вычисления чисел}

Uses crt;

var x:real;

Begin;

Clrscr;

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

Readln(x);

IF x > 0 THEN writeln('положительное число');

if x < 0 then writeln('отрицательное число');

if x=0 then writeln('0 = 0');

End.

 

 

{ 18. Написать алгоритм читающий "N" и выдающий на экран квадраты чисел от 1 до "N"}

Uses crt;

var i,n:integer;

Begin;

Clrscr;

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

Readln(n);

FOR i:= 1 TO n do

Begin;

writeln(i * i);

End;

End.

 

 

{ 19. Нахождение точки с координатами (х,у)}

Uses crt;

var x,y:integer;

Begin;

Clrscr;

writeln('Введите координаты точки (x)');

Readln(x);

writeln('Введите координаты точки (y)');

Readln(y);

IF (x = 0) OR (y = 0) THEN writeln ('Точка лежит на разделе четвертей');

IF (x > 0) AND (y > 0) THEN writeln('I-я четверть');

IF (x < 0) AND (y > 0) THEN writeln('II-я четверть');

IF (x < 0) AND (y < 0) THEN writeln('III-я четверть');

IF (x > 0) AND (y < 0) THEN writeln('IV-я четверть');

End.

 

 

{ 20. Определение номера краски}

Uses crt;

var color:string;

a:integer;

Begin;

Clrscr;

writeln('Введите цвет (маленькие буквы)');

Readln(color);

a:=1;

IF color = 'красный' THEN

Begin

writeln('1');a:=0;

End;

IF color = 'зеленый' THEN

Begin

writeln('2');a:=0;

End;

IF color = 'желтый' THEN

Begin

writeln('3');a:=0;

End;

IF color = 'черный' THEN

Begin

writeln('4');a:=0;

End;

IF color = 'белый' THEN

Begin

writeln('5'); a:=0;

End;

IF color = 'синий' THEN

Begin

writeln('6'); a:=0;

End;

IF color = 'коричневый' THEN

Begin

writeln('7');a:=0;

End;

if a=1 then writeln('такой краски нет');

End.

 

 

{ 21. Выбрать лучший результат}

Uses crt;

var a,b,c,high:integer;

Begin;

Clrscr;

writeln('Введите результаты по плаванию для трех спортсменов через Enter');

Readln(a);

Readln(b);

Readln(c);

IF (a > b) AND (a > c) THEN high:= a;

IF (b > a) AND (b > c) THEN high:= b;

IF (c > a) AND (c > b) THEN high:= c;

writeln('Наивысший результат ',high);

End.

 

 

Uses crt;

var n,a,k:integer;

nn:real;

Label 1;

Begin

Clrscr;

writeln('Введите целое число N(1-100)');

Readln(n);

writeln('Введите число для поиска в разложении ведденого числа');

Readln(k);

a:=0;

nn:=n;

1:

nn:=(nn/k);

if int(nn) <> nn then

Begin

Clrscr;

writeln('Число ',k,' встречается ',a,' раз(а)');

End

else a:=a+1;

Goto 1

End.

{ 23. Сколько раз встречается цифра К в натуральном М}

Uses crt;

var m:string[79];

k:string[79];

number,i:integer;

position:byte;

Procedure Search;

Begin

Position:=pos(k,m);

IF position<>0 then number:= number + 1;

End;

Begin;

Clrscr;

writeln('Введите натуральное число M');

Readln(m);

writeln('Введите число k (так, чтобы 0<=k<=9)');

Readln(k);

Clrscr;

Search;

writeln('В числе ', m, ' число ', k, ' встречается ', number, ' раз');

End.

 

 

{ 24. Вычислить сколько цифр в числе}

Uses crt;

var number:string;

Begin;

Clrscr;

writeln('Введите натуральное число N');

Readln(number);

writeln('В числе ', number, ' цифр ', length(number));

End.

{25. Расписание уроков в определенный день}

Uses crt;

var day:integer;

Label 11,22,33,44,55;

Begin;

Clrscr;

writeln('введите номер дня недели');

Readln(day);

Case day of

Goto 11;

Goto 22;

Goto 33;

Goto 44;

Goto 55;

End;

writeln('А у нас пятидневка');

Halt;

11: writeln ('1.математика');

writeln ('2.математика');

writeln('3.химия');

writeln('4.физика');

writeln('5.биолог');

Halt;

22: writeln ('1.математика');

writeln ('2.литер.');

writeln ('3.ин.яз.');

writeln ('4.физика');

writeln ('5.физ-ра');

Halt;

33: writeln ('1.литер.');

writeln ('2.литер.');

writeln ('3.ин.яз.');

writeln ('4.химия');

Halt;

44: writeln ('1.инф');

writeln ('2.математика');

writeln ('3.биолог');

writeln ('4.географ.');

writeln ('5.географ');

Halt;

55: writeln ('1.математика');

writeln ('2.литер.');

writeln ('3.истор');

writeln ('4.истор');

writeln ('5.литер.');

Halt;

End.

 

 

{26. Кол-во дней в месяцах}

Uses crt;

var m,year:integer;

Begin;

Clrscr;

writeln('Високосный ли год (1-да,0-нет)');

Readln(year);

writeln('Введите номер месяца');

Readln(m);

IF m = 1 THEN writeln ('январь, 31-день');

IF (m = 2) AND (year = 0) THEN writeln ('февраль(невисокосный), 28-дней');

IF (m = 2) AND (year = 1) THEN writeln ('февраль(високосный), 29-дней');

IF m = 3 THEN writeln ('март, 31-день');

IF m = 4 THEN writeln ('апрель, 30-день');

IF m = 5 THEN writeln ('май, 31-день');

IF m = 6 THEN writeln ('июнь, 30-день');

IF m = 7 THEN writeln ('июль, 31-день');

IF m = 8 THEN writeln ('август, 31-день');

IF m = 9 THEN writeln ('сентябрь, 30-день');

IF m = 10 THEN writeln ('октябрь, 31-день');

IF m = 11 THEN writeln ('ноябрь, 30-день');

IF m = 12 THEN writeln ('декабрь, 31-день');

End.

 

 

{27. Угадывание целых чисел}

Uses crt;

var number,partner:integer;

Label 1;

Begin;

Clrscr;

writeln('Первый игрок, введите число');

Readln(number);

Clrscr;

writeln('Второй игрок, ваш ход');

1:

Readln(partner);

IF partner > number THEN

Begin

writeln ('меньше'); GOTO 1;

End;

IF partner < number THEN

Begin

writeln ('больше'); GOTO 1;

End;

IF partner = number THEN

Begin

writeln ('Вы угадали'); halt;

End;

End.

 

 

{ 28. Подсчитывание кол-во кругов ученика}

Uses crt;

var ask,number:integer;

Label 1;

Begin;

Clrscr;

1:

writeln('Пробежишь еще кружочек? (1-да, 2-нет)');

Readln(ask);

IF ask = 1 THEN

Begin

number:= number + 1; clrscr; GOTO 1;

End;

IF ask = 2 THEN

Begin

writeln('На нет и суда нет. Ты пробежал ', number, ' кругов');

Halt;

End;

End.

 

{29. }

Uses crt;

var choice:integer;

Begin;

Clrscr;

writeln('Математика(1) Физика(2) Информатика(3)');

Readln(choice);

IF choice = 1 THEN

Begin

clrscr;writeln('Математика-4')

End;

IF choice = 2 THEN

Begin

clrscr;writeln('Физика-3');

End;

IF choice = 3 THEN

Begin

clrscr;writeln('Информатика-5');

End;

End.

 

{ 30. Вычеркивание по выбору граф элементы}

Uses graph,crt;

var gd,gm,choice:integer;

Begin

initgraph(gd,gm,'');

outtext('Выберите длину отрезка:1-50 точек(1), 2-150 точек(2)');

Readln(choice);

Case choice of

LINE (295, 240,345, 240);

LINE (245, 240,395, 240);

End;

Repeat;

Until keypressed;

Closegraph;

End.

{ 30. Выполнение граф построений}

Uses graph,crt;

var gd,gm:integer;

Begin

initgraph(gd,gm,'c:\bp\bgi');

LINE (150, 100,67, 100);

LINE (67, 100,102, 68);

LINE (102, 68,150, 100);

Floodfill (100, 90, 15);

Delay(2000);

Clearviewport;

Bar(73, 49,141, 109);

Delay(2000);

Clearviewport;

LINE (73, 49,103, 79);

LINE (103, 79,92, 120);

LINE (92, 120,50, 120);

LINE (50, 120,31, 79);

LINE (31, 79,73, 49);

Floodfill (90, 90, 15);

Delay(2000);

Clearviewport;

LINE (73, 49,111, 49);

LINE (111, 49,132, 71);

LINE (132, 71,111, 93);

LINE (111, 93,73, 93);

LINE (73, 93,52, 71);

LINE (52, 71,73, 49);

Floodfill (100, 90, 15);

Repeat;

Until keypressed;

Closegraph;

End.

 

{ 32. Начертить N окружностей}

Uses graph,crt;

var gd,gm,n,i:integer;

Begin

initgraph(gd,gm,'c:\bp\bgi');

outtext('Введите кол-во окружностей');

Readln(n);

Clearviewport;

FOR i:= 1 TO n do

Begin;

CIRCLE (Random(640),Random(480), 50)

End;

Repeat;

Until keypressed;

Closegraph;

End.

{ 33. Построить многоугольник со сторонами 60 и 20 точек}

Uses graph,crt;

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

Begin

initgraph(gd,gm,'c:\bp\bgi');

outtextxy(20,0,'Введите координаты левого верхнего угла прямоугольника (x,y)');

Readln(x);

Readln(y);

outtextxy(20,10,'Введите координаты правого нижнего угла прямоугольника (x1,y1)');

Readln(x1);

Readln(y1);

Rectangle(x,y,x1,y1);

Repeat;

Until keypressed;

Closegraph;

End.

{ 34. Построить и закрасить круг}

Uses graph,crt;

var gd,gm,x,y,r:integer;

Begin

initgraph(gd,gm,'c:\bp\bgi');

outtextxy(40,0,'Введите координаты центра окружности');

Readln(x);

Readln(y);

outtextxy(40,20,'Введите радиус окружности');

Readln(r);

CIRCLE (x, y, r);

Floodfill(x,y, 15);

Repeat;

Until keypressed;

Closegraph;

End.

 

 

{ 35. Построить из окружностей рисунок облака}

Uses graph,crt;

var gd,gm:integer;

Begin

initgraph(gd,gm,'c:\bp\bgi');

SetFillStyle(1, 15);

Setcolor(15);

CIRCLE (320, 240, 100);

Floodfill (320, 240, 15);

CIRCLE (220, 240, 80);

Floodfill (200, 240, 15);

CIRCLE (420, 240, 80);

Floodfill (440, 240, 15);

Repeat;

Until keypressed;

Closegraph;

End.

{ 36 Построение звезды}

Uses graph,crt;

var gd,gm:integer;

Begin

initgraph(gd,gm,'c:\bp\bgi');

Setcolor(15);

Line(220,240,320,100);

Line(320,100,420,240);

Line(220,140,420,140);

Line(220,140,420,240);

Line(420,140,220,240);

Delay(3000);

End.

 

 

{ 37. Построение квадрата}

Uses graph,crt;

var gd,gm,x,y,side:integer;

Begin

initgraph(gd,gm,'c:\bp\bgi');

outtextxy(30,0,'Введите сторону квадрата.');

Readln(side);

Clearviewport;

outtextxy(30,0,'Введите координаты центра квадрата(X и Y через ENTER)');

Readln(x);

Readln(y);

Clearviewport;

rectangle(x-side,y - side,x + side, y + side);

Repeat;

Until keypressed;

Closegraph;

End.

 

 

{ 38 Рисование луны}

Uses crt,graph;

var gd,gm,choice:integer;

Label 1,2,3;

Begin;

Clrscr;

writeln('1.полнолуние, 2.1/2 луны, 3.месяц');

Readln(choice);

initgraph(gd,gm,'c:\bp\bgi');

IF choice = 1 THEN GOTO 1;

IF choice = 2 THEN GOTO 2;

IF choice = 3 THEN GOTO 3;

Halt;

1:

CIRCLE (320, 240, 100);

Floodfill(320,240,15);

Repeat;

Until keypressed;

Halt;

2:

Arc(320, 240, 90, 270, 100);

LINE (320, 140,320, 340);

Floodfill(300,240,15);

Repeat;

Until keypressed;

Halt;

3:

Arc(320, 240, 90, 270, 100);

Arc(490, 240, 150, 210, 200);

Floodfill(285,240,15);

Repeat;

Until keypressed;

Halt;

Closegraph;

End.

 

 

{ 39 Построение треугольника по заданным координатам}

Uses crt,graph;

var gd,gm,x,y,a,c:integer;

Begin

Clrscr;

writeln('Введите координаты центра звезды X и Y ');

Readln(x);

Readln(y);

writeln('Введите длину луча звезды (не меньше 90)');

Readln(a);

initgraph(gd,gm,'c:\bp\bgi');

c:=round(3/4*a);

line(x,y-a,x+c,y+2*c);

line(x,y-a,x-c,y+2*c);

line(x+c,y+2*c,x-a-10,y-25);

line(x-c,y+2*c,x+a+10,y-25);

line(x+a+10,y-25,x-a-10,y-25);

Delay(3000);

Closegraph;

End.

 

 

{ 40. Построение кораблика}

Uses graph,crt;

var gd,gm:integer;

a,h:real;

Begin

initgraph(gd,gm,'c:\bp\bgi');

outtextxy (30,0,'Введите высоту и длину палубы (H и A через Enter)');

Readln(h);

Readln(a);

LINE (320 + round(a / 2), 240 - round(h / 2),320 + round(a/2), 240 + round(h/ 2));

LINE (320 + round(a / 2), 240 - round(h / 2),320 - round(a / 2), 240 - round(h / 2));

LINE (320 - round(a / 4), 240 + round(h / 2),320 + round(a / 2), 240 + round(h / 2));

LINE (320 - round(a / 4), 240 + round(h / 2),320 - round(a / 2), 240 - round(h / 2));

LINE (320, 240 - round(h / 2),320, 240 - round(h * 2));

LINE (320, 240 - round(h * 2),320 + round(a / 5), round(240 - h));

LINE (320, 240 - round(h),320 + round(a / 5),round(240 - h));

Repeat;

Until keypressed;

Closegraph;

End.

{ 41. }

Uses graph,crt;

var gd,gm,i:integer;

x,y:real;

c:char;

Label 0,1,2,3;

const aa=57.32484;

Begin

initgraph(gd,gm,'c:\bp\bgi');

0: outtextxy (1,1,'День(д), ночь(н) (используйте заглавные буквы)');

outtextxy(1,10,'Press Esc to exit');

1:

c:=readkey;

IF c = chr(27) THEN halt;

IF c = 'Д' THEN GOTO 2;

IF c = 'Н' THEN GOTO 3;

GOTO 1;

Clearviewport;

Setcolor(14);

CIRCLE (320, 240, 100);

Floodfill (320, 240, 14);

GOTO 0;

3:

Setcolor(15);

Clearviewport;

arc(320, 240, round(1.57*aa), round(4.71*aa),100);

GOTO 0;

End.

 

 

{ 42. Рожица}

Uses graph,crt;

var gd,gm:integer;

c:char;

Label 0,2,3;

Begin

initgraph(gd,gm,'c:\bp\bgi');

Circle(320, 240, 100);

Ellipse(320, 280, 180, 360, 60,50);

Ellipse(320, 240, 180, 360, 20,50);

Ellipse(280, 200,0,360, 40,5);

Ellipse(360, 200,0,360, 40,5);

outtextxy (1,1,'сон(с) утро(у)');

outtextxy (1,10,'Press Esc to exit');

0:

c:=readkey;

if c = chr(27) then halt;

IF c = 'у' THEN GOTO 2;

IF c = 'с' THEN GOTO 3;

GOTO 0;

2:

Setcolor(0);

Ellipse(280, 200,0,360, 40,5);

Ellipse(360, 200,0,360, 40,5);

Setcolor(14);

Ellipse (280, 200,360,0,30,10);

Ellipse (360, 200,360,0,30,10);

Circle (280, 200,10);

CIRCLE (360, 200, 10);

GOTO 0;

3:

Setcolor (0);

Ellipse (280, 200,360,0,30,10);

Ellipse (360, 200,360,0,30,10);

Circle (280, 200,10);

CIRCLE (360, 200, 10);

Setcolor(14);

Ellipse(280, 200,0,360, 40,5);

Ellipse(360, 200,0,360, 40,5);

GOTO 0;

Repeat;

Until keypressed;

Closegraph;

End.

 

{ 43. }

Uses graph,crt;

var gd,gm,a:integer;

c:char;

Label 0,1,2;

Begin

initgraph(gd,gm,'c:\bp\bgi');

Setcolor(12);

outtextxy(1,1,'Press Space key to change color of the fields');

outtextxy(1,10,'Press Esc to exit');

0:

c:=readkey;

if c = chr(27) then halt;

IF (c = ' ') AND (a = 1) THEN GOTO 2;

IF (c = ' ') AND (a = 0) THEN GOTO 1;

GOTO 0;

1:

Setcolor(11);

LINE (320, 0,320, 480);

Setfillstyle(1,15);

Floodfill(1, 1, 11);

Setfillstyle(1,8);

Floodfill(639, 1, 11);

Setcolor(12);

outtextxy(1,1,'Press Space key to change color of the fields');

outtextxy(1,10,'Press Esc to exit');

a:= 1;

GOTO 0;

2:

Setcolor(11);

LINE (320, 0,320, 480);

Setfillstyle(1,8);

Floodfill(1, 1, 11);

Setfillstyle(1,15);

Floodfill(639, 1, 11);

Setcolor(12);

outtextxy(1,1,'Press Space key to change color of the fields');

outtextxy(1,10,'Press Esc to exit');

a:= 0;

GOTO 0;

End.

 

 

{ 44. Изобразить термометр}

Uses graph,crt;

var gd,gm,y,x:integer;

pressedkey:char;

Label 0,1,2;

Begin

initgraph(gd,gm,'c:\bp\bgi');

Ellipse (320, 240, 360, 0, 28,200);

y:= 440;

outtext('Press up arrow key for moving up/down arrow key for moving down');

outtextxy(1,10,'Press Esc to exit');

0:

pressedkey:=readkey;

if pressedkey=chr(27) then halt;

if ord(pressedkey)=72 then goto 1;

if ord(pressedkey)=80 then goto 2;

Goto 0;

1:

x:= 320;

y:= y - 2;

IF y < 45 THEN y:= 47;

Putpixel (x, y, 13);

Goto 0;

2:

Putpixel (x, y, 0);

x:= 320;

y:= y + 2;

IF y > 440 THEN y:= 442;

Putpixel(x, y, 0);

Goto 0;

Repeat;

Until keypressed;

Closegraph;

End.

{ 45. Построение изображение заказанного четырехугольника}

Uses graph,crt;

var gd,gm,choice:integer;

Label 1,2,3,4;

Begin

writeln ('1-параллеограмм 2-прямоугольник 3-ромб 4-квадрат');

Readln(choice);

initgraph(gd,gm,'c:\bp\bgi');

IF choice = 1 THEN GOTO 1;

IF choice = 2 THEN GOTO 2;

IF choice = 3 THEN GOTO 3;

IF choice = 4 THEN GOTO 4;

1:

Clearviewport;

LINE (320, 240,400, 240);

LINE (350, 290,430, 290);

LINE (320, 240,350, 290);

LINE (400, 240,430, 290);

Repeat;

Until keypressed;

Halt;

2:

Clearviewport;

Rectangle(320, 240,400, 290);

Repeat;

Until keypressed;

Halt;

3:

Clearviewport;

LINE (320, 240,270, 290);

LINE (320, 240,370, 290);

LINE (320, 340,370, 290);

LINE (320, 340,270, 290);

Repeat;

Until keypressed;

Halt;

4:

Clearviewport;

Rectangle(320, 240,420, 340);

Repeat;

Until keypressed;

Halt;

Closegraph;

End.

{ 46. Построение многогранников}

Uses graph,crt;

var gd,gm,choice:integer;

Label 1,2,3;

Begin

writeln('1-тетраэдр 2-куб 3-четырехугольная пирамида');

Readln(choice);

initgraph(gd,gm,'c:\bp\bgi');

IF choice = 1 THEN GOTO 1;

IF choice = 2 THEN GOTO 2;

IF choice = 3 THEN GOTO 3;

1:

LINE (150, 100,67, 100);

LINE (67, 100,102, 68);

LINE (102, 68,150, 100);

LINE (150, 100,140, 50);

LINE (67, 100,140, 50);

LINE (102, 68,140, 50);

Repeat;

Until keypressed;

Halt;

2:

Rectangle (320, 240,220, 340);

Rectangle (300, 200,200, 300);

LINE (320, 240,300, 200);

LINE (220, 240,200, 200);

LINE (320, 340,300, 300);

LINE (220, 340,200, 300);

Repeat;

Until keypressed;

Halt;

3:

LINE (320, 240,400, 240);

LINE (350, 290,430, 290);

LINE (320, 240,350, 290);

LINE (400, 240,430, 290);

LINE (430, 290,350, 180);

LINE (350, 290,350, 180);

LINE (320, 240,350, 180);

LINE (400, 240,350, 180);

Repeat;

Until keypressed;

Halt;

Closegraph;

End.

 

 

{ 47. Управление точкой на экране}

Uses graph,crt;

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

c:char;

Label 0,1,2,3,4;

Begin

initgraph(gd,gm,'c:\bp\bgi');

y:= 50;

x:= 50;

outtext('Press up, down, left,right aroow keys for moving the point');

outtextxy(10,10,'Press Esc to Exit');

0:

c:=readkey;

if c=chr(27) then halt;

if ord(c)=72 then goto 1;

if ord(c)=80 then goto 2;

if ord(c)=75 then goto 3;

if ord(c)=77 then goto 4;

GOTO 0;

1:

y:= y - 1;

IF y < 1 THEN y:= 2;

Putpixel(x1, y1, 0);

Putpixel(x, y, 15);

x1:= x; y1:= y;

Goto 0;

2:

Putpixel(x, y, 0);

y:= y + 1;

IF y > 479 THEN y:= 478;

Putpixel (x1, y1, 0);

Putpixel (x, y, 15);

x1:= x; y1:= y;

Goto 0;

3:

x:= x - 1;

IF x < 1 THEN x:= 2;

Putpixel(x1, y1, 0);

Putpixel (x, y, 15);

x1:= x; y1:= y;

Goto 0;

4:

x:= x + 1;

IF x > 639 THEN x:= 638;

Putpixel (x1, y1, 0);

Putpixel (x, y, 15);

x1:= x; y1:= y;

Goto 0;

End.

{ 48. }

Uses graph,crt;

var gd,gm:integer;

c:char;

Label 0,1,2,3,4;

Begin

initgraph(gd,gm,'c:\bp\bgi');

0: outtext('прямоугольник(с) треугольник(к) два прямоугольника(о) - заглавные буквы');

outtextxy(1,10,'Press Esc to Exit');

1:c:=readkey;

if c=chr(27) then halt;

IF c = 'С' THEN GOTO 2;

IF c = 'К' THEN GOTO 3;

IF c = 'О' THEN GOTO 4;

GOTO 1;

2:

Rectangle(320, 240,420, 320);

GOTO 0;

3:

LINE (320, 240,370, 180);

LINE (370, 180,420, 240);

LINE (320, 240,420, 240);

GOTO 0;

4:

Rectangle (340, 250,370, 310);

Rectangle (385, 260,415, 290);

GOTO 0;

Closegraph;

End.

 

 

{ 49. Игра "Попади в центр мишени}

Uses graph,crt;

var gd,gm,x,y:integer;

C:CHAR;

Label 1;

Begin

initgraph(gd,gm,'c:\bp\bgi');

Setfillstyle(2,1);

Bar(220, 140,420, 340);

Setfillstyle(4,9);

Bar(270, 190,370, 290);

outtextxy (30,0,'введите координаты(x и y через ENTER)');

outtextxy(30,10,'Press Esc to Exit');

1:c:=readkey;

if c=chr(27) then halt;

Gotoxy(1,1);

Readln(x);

Gotoxy(1,2);

Readln(Y);

Putpixel(x, Y,12);

IF (x < 220) OR (x > 420) OR (Y < 140) OR (Y > 340) THEN

Begin

outtextxy(20,400, '0 очков');

GOTO 1;

End;

IF (x >= 220) AND (x < 420) AND (Y >= 140) AND (Y < 190) OR (x >= 220) AND (x < 420) AND (Y >= 290) AND (Y < 340) THEN

Begin

outtextxy(20,400, '5 очков');

Goto 1;

End;

IF (x >= 270) AND (x < 370) AND (Y >= 190) AND (Y < 290) THEN

outtextxy(20,400, '10 очков');

Begin

GOTO 1;

if c=chr(27) then halt;

End;

End.

{ 50. Закраска кругов разными цветами}

Uses graph,crt;

var gd,gm:integer;

c:char;

Label 0,2,3,4;

Begin

initgraph(gd,gm,'c:\bp\bgi');

Setcolor(15);

CIRCLE (320, 220,10);

CIRCLE (320, 240,10);

CIRCLE (320, 260,10);

outtextxy(10,10,'красный(к) желтый(ж) зеленый(з) - маленькие буквы');

outtextxy(10,20,'Выход - Esc');

0:

c:=readkey;

if c=chr(27) then halt;

IF c = 'к' THEN GOTO 2;

IF c = 'ж' THEN GOTO 3;

IF c = 'з' THEN GOTO 4;

GOTO 0;

2:

Setfillstyle(1,12);

Floodfill(320, 220, 15);

Setfillstyle(1,0);

Floodfill (320, 240, 15);

Floodfill (320, 260, 15);

GOTO 0;

3:

Setfillstyle(1,14);

Floodfill (320, 240,15);

Setfillstyle(1,0);

Floodfill (320, 260,15);

Floodfill (320, 220,15);

GOTO 0;

4:

Setfillstyle(1,10);

Floodfill(320, 260, 15);

Setfillstyle(1,0);

Floodfill (320, 220, 15);

Floodfill (320, 240, 15);

GOTO 0;

End.

 

 

{ 51. Заполнить массив случайными числами из отрезка (А,В)}

Uses crt;

var a,b,i:integer;

aa: array [1..10] of integer;

Begin

Clrscr;