Рисование звёзд и многоугольников

Previous  Top  Next

    
 

 

Code:

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Рисование звёзд и многоугольников

 

Зависимости: Windows, Graphics

Автор:       Fenik, chook_nu@uraltc.ru, Новоуральск

Copyright:   Автор Федоровских Николай

Дата:        3 июня 2002 г.

***************************************************** }

 

procedure DrawStar(Canvas: TCanvas; Center, Pos: TPoint;

R2inPercent, Ends: Byte; DrawCircle: Boolean);

{

Рисование звёзд и многоугольников

 

Center - центр фигуры;

Pos - точка, лежащая на внешнем радиусе;

R2inPercent - сколько процентов от внешнего радиуса составляет внутренний;

Ends - число концов (внешних углов) фигуры;

DrawCircle - описывать или нет возле фигуры окружность;

 

R2inPercent рекомендую брать в промежутке [0; 100].

Если R2inPercent = 100, то рисуется правильный многоугольник,

число углов которого равно Ends.

Все точки лежат на двух окружностях, чередуясь.

}

 

function Max(A, B: Integer): Integer;

begin

   if A > B then

     Result := A

   else

     Result := B;

end;

 

function ArcTan2(Y, X: Extended): Extended;

asm

   FLD Y

   FLD X

   FPATAN

   FWAIT

end;

 

const

Rad = Pi / 180;

var

R, r2, rd, len: Word;

i: Integer;

MemBS: TBrushStyle;

p: array of TPoint;

MemC: TColor;

a, ad: Double;

begin

if Ends < 2 then

   Exit;

{начальный угол:}

a := ArcTan2(Center.y - Pos.y, Pos.x - Center.x) * (180 / Pi);

R := Max(Abs(Center.x - Pos.x), Abs(Center.y - Pos.y));

r2 := Round(R / 100 * R2inPercent); {внутренний радиус}

if R2inPercent <> 100 then

   len := Ends * 2

else

   len := Ends;

SetLength(p, len); {устанавливаем длину массива точек}

ad := 360 / len; {угол между рядом стоящими точками}

for i := 0 to len - 1 do

begin

   {если i нечетный, то радиус внутренний, иначе - внешний}

   if Odd(i) then

     rd := r2

   else

     rd := R;

   p[i].x := Trunc(Cos(a * Rad) * rd) + Center.x;

   p[i].y := Trunc(Sin(a * Rad) * rd) + Center.y;

   a := a + ad; {увеличиваем угол}

end;

{рисуем многоугольник}

Canvas.Polygon(p);

if DrawCircle then

begin

   {Рисуем окружность}

   MemC := Canvas.Brush.Color;

   MemBS := Canvas.Brush.Style;

   Canvas.Brush.Style := bsClear;

   Canvas.Ellipse(Center.x - R, Center.y - R, Center.x + R, Center.y + R);

   Canvas.Brush.Color := MemC;

   Canvas.Brush.Style := MemBS;

end;

end;

 

 

 

Пример использования:

Code:

DrawStar(FBitmap.Canvas, Point(FBitmap.Width div 2, FBitmap.Height div 2),

Point(FBitmap.Width div 2, 0), 20, 12, False);

 

 

 

 

©Drkb::03755