Можно задавать разное количество вершин и коэффициент...
{$N+}
Uses Graph;
Type
TPoint =
Record
X, Y: Integer;
End;
PArrPoint = ^arrPoint;
arrPoint =
Array[1 .. maxInt Div SizeOf(TPoint)] Of TPoint;
TFigure =
Object
nPoints: Byte;
arr: PArrPoint;
p: Integer;
a: Double;
Constructor Init(np: Integer;
pVal: Integer; aVal: Double);
Destructor Done;
Procedure Run;
Private
Procedure InitPoints;
Function Recalc: Boolean;
Procedure Draw;
End;
Constructor TFigure.Init(np: Integer;
pVal: Integer; aVal: Double);
Begin
nPoints := np;
a := aVal; p := pVal;
GetMem(arr, nPoints * SizeOf(TPoint));
InitPoints
End;
Destructor TFigure.Done;
Begin
FreeMem(arr, nPoints * SizeOf(TPoint));
End;
Procedure TFigure.InitPoints;
Const
RadToGrad = (180 / Pi);
Procedure GetPoint(Var P: TPoint;
Len: Integer; phi: Integer);
Var fPhi: Double;
Begin
fPhi := phi / RadToGrad;
P.X := (GetMaXX div 2) + Trunc(Len * Sin(fPhi));
P.Y := (GetMaxY div 2) - Trunc(Len * Cos(fPhi));
End;
Var
i, Len, phi: Integer;
x: Double;
Begin
phi := 360 div nPoints;
x := Cos(phi / RadToGrad);
Len := Trunc(p / Sqrt(2* (1 - x)));
For i := 1 To nPoints Do
GetPoint(arr^[i], Len, Pred(i) * phi);
End;
Function TFigure.Recalc: Boolean;
Var
T: PArrPoint;
i, next: Integer;
Begin
GetMem(T, nPoints * SizeOf(TPoint));
For i := 1 To nPoints Do
Begin
If i = nPoints Then next := 1 Else next := Succ(i);
T^[i].x := Trunc((arr^[i].x + a*arr^[next].x) / (1 + a));
T^[i].y := Trunc((arr^[i].y + a*arr^[next].y) / (1 + a));
End;
Recalc := (T^[1].x <> arr^[1].x);
Move(T^, arr^, nPoints * SizeOf(TPoint));
FreeMem(T, nPoints * SizeOf(TPoint))
End;
Procedure TFigure.Draw;
Procedure DrawLine( p1, p2: TPoint );
Begin
Line( p1.X, p1.Y, p2.X, p2.Y )
End;
Var
i, next: Integer;
Begin
For i := 1 To nPoints Do
Begin
next := Succ(i);
If i = nPoints Then next := 1;
DrawLine( arr^[i], arr^[next] );
End;
End;
Procedure TFigure.Run;
Begin
Repeat
Draw
Until not ReCalc;
ReadLn
End;
Var
f: TFigure;
grDriver, grMode, ErrCode: Integer;
Begin
grDriver := Detect;
InitGraph(grDriver, grMode, '');
ErrCode := GraphResult;
If ErrCode <> grOk Then
Begin
WriteLn('Graphic Error: ', GraphErrorMsg(ErrCode));
Halt(100)
End;
{ 7 вершин, длина каждой стороны = 140, коэффициент = 0.05 }
f.Init( 7, 140, 0.05 );
f.Run;
f.Done;
CloseGraph;
End.
Скачать исходник:
poly.pas ( 2.75 килобайт )
Кол-во скачиваний: 1819