Построение кривых второго порядка
Программа строит графики кривых второго порядка: параметрически заданный эллипс, астроиду, кардиоида, розу Гранди и ряд других.
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.
