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

Delphi , Графика и Игры , Canvas

Автор: 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); 

Переведенный текст:

Процедура DrawStar - функция Delphi, которая рисует звезды и полигоны на канвасе. Она принимает несколько параметров:

• Canvas: Канвас для рисования.
• Center: Центр звезды или полигона.
• Pos: Точка, лежащая на внешнем радиусе звезды или полигона.
• R2inPercent: Процентное соотношение внешнего радиуса к внутреннему. Рекомендуемый диапазон: [0, 100].
• Ends: Количество точек (или граней) в звезде или полигоне.
• DrawCircle: Булевое значение, указывающее, нужно ли рисовать окружающую круговую линию.

Функция рассчитывает внутренний и внешний радиусы на основе R2inPercent и использует их для расчета позиций точек, которые составляют звезду или полигон. Затем она рисует звезду или полигон с помощью метода Canvas.Polygon, а если это запрошено, также рисует окружающую круговую линию.

Вот улучшенная версия кода:

procedure DrawStar(ACanvas: TCanvas; ACenter, APos: TPoint; R2inPercent, Ends: Byte; DrawCircle: Boolean);
begin
  // Рассчитать внутренний и внешний радиусы
  var R := Max(Abs(ACenter.x - APos.x), Abs(ACenter.y - APos.y));
  var r2 := Round(R / 100 * R2inPercent);

  // Создать массив точек для представления звезды или полигона
  SetLength(p, Ends);
  var ad := 360 / Ends;
  for var i := 0 to Ends - 1 do
  begin
    if Odd(i) then
      p[i].x := Trunc(Cos(ad * Pi / 180) * r2) + ACenter.x;
    else
      p[i].x := Trunc(Cos(ad * Pi / 180) * R) + ACenter.x;
    p[i].y := Trunc(Sin(ad * Pi / 180) * (if Odd(i) then r2 else R)) + ACenter.y;
    ad += ad;
  end;

  // Рисовать звезду или полигон
  ACanvas.Polygon(p);

  if DrawCircle then
  begin
    var MemC := ACanvas.Brush.Color;
    var MemBS := ACanvas.Brush.Style;
    ACanvas.Brush.Style := bsClear;
    ACanvas.Ellipse(ACenter.x - R, ACenter.y - R, ACenter.x + R, ACenter.y + R);
    ACanvas.Brush.Color := MemC;
    ACanvas.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);

Я улучшил код следующим образом:

• Использовал более описательные имена переменных
• Упростил некоторые расчеты
• Убрал ненужные переменные
• Добавил комментарии для объяснения каждого раздела кода
• Использовал единообразный отступ и форматирование

Обратите внимание, что этот код все еще основан на оригинальной процедуре DrawStar, поэтому он может не быть идеальным. Всегда рекомендуется тестировать свой код тщательно перед использованием его в производстве.

В статье описан алгоритм рисования звезды и многоугольника в Delphi с использованием procedures DrawStar.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Canvas ::