Delphi World - Рисование звёзд и многоугольников
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Рисование звёзд и многоугольников

Автор: Fenik
WEB-сайт: http://delphibase.endimus.com

{ **** 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;

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

DrawStar(FBitmap.Canvas, Point(FBitmap.Width div 2, FBitmap.Height div 2),
  Point(FBitmap.Width div 2, 0), 20, 12, False); 
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования