БЕСПЛАТНОЕ РЕШЕНИЕ ЗАДАЧ

Построение кривых второго порядка

Программа строит графики кривых второго порядка: параметрически заданный эллипс, астроиду, кардиоида, розу Гранди и ряд других.
program ellips_astroida_and_other;
uses crt,graph;
type
 func=function(x:real):real;
var
 x,y:real;
driver,mode:integer;
cx,cy,mx,my,ex,ey:integer;
procedure OXY;
 var i:integer;
 r:real;
 begin
 {Определение начала координат, GetMaxX, GetMaxY -
 константы, определяющие координаты точек экрана (пикселей).}
 cx:=trunc(GetMaxX/2); cy:=trunc(GetMaxY/2);
 {Оси X и Y}
 line(10,cy,630,cy); line(cx,10,cx,470);
 {Cтрелки на осях координат}
 line(620,cy-5,630,cy); line(620,cy+5,630,cy);
 line(cx-5,20,cx,10); line(cx+5,20,cx,10);
 outtextxy(cx+10,10,'y');
 outtextxy(GetMaxX-20,cy+10,'x');
 settextstyle(0,0,0);
 {Отметки единиц на осях координат}
 for i:=1 to 10 do
 begin
 line(cx+i*30,cy-5,cx+i*30,cy);
 line(cx-i*30,cy-5,cx-i*30,cy);
 {r - коэффициент сжатия изображения по оси ОY}
 r:=GetMaxY/GetMaxX;
 line(cx,trunc((cx+i*30)*r),cx+5,trunc((cx+i*30)*r));
 line(cx,trunc((cx-i*30)*r),cx+5,trunc((cx-i*30)*r));
 end;
end;
procedure ellips(a,b:real);
 var t:real;
begin
 OXY; t:=0; outtextxy(10,10,'Э Л Л И П С');
 repeat
 x:=a*cos(t); y:=b*sin(t);
 ex:=trunc(cx+x*mx);ey:=trunc(cy-y*my);
 putpixel(ex,ey,red);t:=t+pi/10000;
 until t>2*pi+pi/10000;
end;
{$F+}
function f1(x:real):real;
{Oписание функции от которой берется интеграл}
begin
 f1:=x*x
end;
function f2(x:real):real;
{Oписание функции от которой берется интеграл}
begin
 f2:=x*x*x
end;
{$F-}
procedure astroida(a,b:real);
 var t:real;
begin
 OXY; t:=0; outtextxy(10,10,' А С Т Р О И Д А');
 repeat
 x:=a*cos(t)*cos(t)*cos(t); y:=b*sin(t)*sin(t)*sin(t);
 ex:=trunc(cx+x*mx);
 ey:=trunc(cy-y*my);
 putpixel(ex,ey,red);
 t:=t+pi/10000;
 until t>2*pi+pi/10000;
end;
procedure kardioida(a,b:real);
 var t:real;
begin
 OXY; t:=0; outtextxy(10,10,'К А Р Д И О И Д А');
 repeat
 x:=a*(1+cos(t))*cos(t); y:=b*(1+cos(t))*sin(t);
 ex:=trunc(cx+x*mx); ey:=trunc(cy-y*my);
 putpixel(ex,ey,red);t:=t+pi/10000;
 until t>2*pi+pi/10000;
end;
procedure rose(a,b:real);
 var p:integer;t:real;
begin
 OXY;t:=0; outtextxy(10,10,' РOЗА Гранди');
 repeat
 x:=a*cos(t)*cos(t)*sin(t); y:=b*cos(t)*sin(t)*sin(t);
 ex:=trunc(cx+x*mx); ey:=trunc(cy-y*my);
 putpixel(ex,ey,red);t:=t+pi/10000;
 until t>2*pi+pi/10000;
end;
procedure experiment1(a,b:real);
 var p:integer;t:real;
begin
 OXY;t:=0; outtextxy(10,10,' Эксперимент 1 ');
 repeat
 x:=a*cos(t)*cos(t)*sin(t);
 {Изменённая формула для "розы" }
 y:=b*cos(t)*sin(t)*sin(t)*cos(x);
 ex:=trunc(cx+x*mx); ey:=trunc(cy-y*my);
 putpixel(ex,ey,red);t:=t+pi/10000;
 until t>2*pi+pi/10000;
end;
procedure experiment2(a,b:real);
 var p:integer;t:real;
begin
 OXY;t:=0; outtextxy(10,10,' Эксперимент 2');
 y:=0;
 repeat
 x:=a*cos(t)*cos(y); y:=b*sin(t)*sin(x);
 ex:=trunc(cx+x*mx); ey:=trunc(cy-y*my);
 putpixel(ex,ey,red);t:=t+pi/100000;
 until t>2*pi+pi/10000;
end;
BEGIN
 driver:=detect;
 initgraph(driver,mode,'d:\tp\bgi');
 setcolor (blue); setbkcolor(white);
 mx:=trunc((getmaxx-20)/20);
 my:=trunc((getmaxy-20)/20);
 ellips(9,6); readln; cleardevice;
 astroida(10,6); readln; cleardevice;
 kardioida(5,6); readln; cleardevice;
 rose(25,15); readln; cleardevice;
 experiment1(25,15); readln; cleardevice;
 experiment2(10,9); readln; cleardevice;
END.

Оставить комментарий

Вы должны быть авторизованы , чтобы оставить или оценить комментарий.

Онлайн всего: 3
Гостей: 3
Пользователей: 0

STUDLAB Сообщить про опечатку на сайте