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;