program lab3;
uses crt,graph;
var i,
CB,TLX,TLY,BRX,BRY,WRX,WRY,n :integer;
Ax,Ay,Bx,By,
temp, xmin,xmax, ymin,ymax, t :real;
a,b: array[0..359] of real;
text : string;
procedure SetupGraphics;
var
grDriver, grMode :integer;
begin
grDriver := detect;
InitGraph(grDriver,grMode,'c:/bp/bgi');
end;
procedure Stop;
begin
repeat until keypressed;
end;
begin {main}
ClrScr;
write('Введите n ');
read(n);
for i:=0 to 359 do begin
a[i]:=cos(n*i)*cos(i);
b[i]:=cos(n*i)*sin(i);
end;
temp:=a[0];
for i:=0 to 359 do if a[i]<temp then temp:=a[i];
xmin:=temp;
for i:=0 to 359 do if a[i]>temp then temp:=a[i];
xmax:=temp;
temp:=b[0];
for i:=0 to 359 do if b[i]<temp then temp:=b[i];
ymin:=temp;
for i:=0 to 359 do if b[i]>temp then temp:=b[i];
ymax:=temp;
TLX := 60; TLY := 60;
BRX := 460; BRY := 360;
WRX := BRX - TLX; WRY := BRY - TLY;
Ax := WRX/(xmax-xmin); Ay := WRY/(ymax-ymin);
Bx := TLX - Ax*xmin; By := TLY - Ay*ymin;
SetupGraphics;
Rectangle(TLX,TLY, BRX,BRY);
SetColor(green);
i:=TLX+50;
while i<BRY do begin
line(TLX+1,i,BRX-1,i); i:=i+50;
end;
i:=TLY+50;
while i<BRX do begin
line(i,TLY+1,i,BRY-1); i:=i+50;
end;
SetColor(White);
i:=TLX;
while i<=BRY do begin
line(TLX-10,i,TLX,i); i:=i+50;
end;
i:=TLY;
while i<=BRX do begin
line(i,BRY+10,i,BRY); i:=i+50
end;
for i:=0 to 359 do PutPixel(trunc(Ax*a[i]+Bx),trunc(Ay*b[i]+By),red);
SetColor(white);
OutTextXY(TLX-10,TLY-20,'Y');
OutTextXY(BRX+10,BRY,'X');
t:=(ymax-ymin)/6;
i:=TLX-3;
while i<=BRY do begin
str(ymax:1:2,text); ymax:=ymax-t;
OutTextXY(0,i,text); i:=i+50;
end;
t:=(xmax-xmin)/8;
i:=TLY-20;
while i<=BRX do begin
str(xmax:1:2,text); xmax:=xmax-t;
OutTextXY(i,BRY+20,text); i:=i+50;
end;
Stop;
CloseGraph
end.
От n зависит количество лепестков