Нарисовать линию, не используя функции LineTo

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

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ 
  Enables you do draw a line if for some reason you 
  cannot use the delphi LineTo procedure. 
  For example, for drawing higher resolution lines 
  or drawing lines in 2D arrays. 
}

 procedure DrawLine(APoint1, APoint2: TPoint; ACanvas: TCanvas);
 var
   Lpixel, LMaxAxisLength: integer;
   LRatio: Real;
 begin
   LMaxAxisLength := Max(abs(APoint1.X - APoint2.X), abs(APoint1.Y - APoint2.Y));
   for Lpixel := 0 to LMaxAxisLength do
    begin
     LRatio := Lpixel / LMaxAxisLength;
     ACanvas.Pixels[APoint1.X + Round((APoint2.X - APoint1.X) * LRatio),
       APoint1.Y + Round((APoint2.Y - APoint1.Y) * LRatio)] :=
       ACanvas.Pen.Color;
   end;
 end;

 // Draw a double resolution line 
procedure DrawLineDouble(APoint1, APoint2: TPoint; ACanvas: TCanvas);
 var
   Lpixel, LMaxAxisLength: integer;
   LRatio: Real;
   LPoint: TPoint;
 begin
   LMaxAxisLength := max(abs(APoint1.X - APoint2.X), abs(APoint1.Y - APoint2.Y));
   for Lpixel := 0 to LMaxAxisLength do
    begin
     LRatio := Lpixel / LMaxAxisLength;
     LPoint.X := APoint1.X + Round((APoint2.X - APoint1.X) * LRatio);
     LPoint.Y := APoint1.Y + Round((APoint2.Y - APoint1.Y) * LRatio);
     with ACAnvas do
      begin
       Pixels[LPoint.X * 2, LPoint.Y * 2] := clBlack;
       Pixels[(LPoint.X * 2) + 1, LPoint.Y * 2] := clBlack;
       Pixels[LPoint.X * 2, (LPoint.Y * 2) + 1] := clBlack;
       Pixels[(LPoint.X * 2) + 1, (LPoint.Y * 2) + 1] := clBlack;
     end;
   end;
 end;

Перевод контента на русский язык:

Код, предоставленный ниже, это программный код Delphi, который рисует линии на канвасе без использования встроенной процедуры LineTo. Основная идея этого кода заключается в расчете отношения каждого пикселя вдоль линии и затем установке соответствующих пикселей на канвасе в желаемый цвет.

Вот шаг за шагом, как работает этот код:

1. Процедура DrawLine принимает три параметра: два точки (APoint1 и APoint2), которые определяют начало и конец линии, а также экземпляр класса TCanvas (ACanvas), на котором будет рисоваться линия.
2. Она рассчитывает максимальную длину оси (длину между двумя точками) с помощью встроенной функции Max.
3. Затем она проходит через каждый пиксель вдоль линии, рассчитывая отношение этого пикселя к максимальной длине оси.
4. Для каждого пикселя она рассчитывает новые координаты x и y, умножая соответствующие разницы в координатах на отношение.
5. Программа затем устанавливает цвет соответствующего пикселя на канвасе с помощью свойства Pixels.

Процедура DrawLineDouble похожа на DrawLine, но рисует линию с двойной разрешающей способностью (то есть рисует каждый пиксель два раза, что делает линию толще).

Вот несколько предложений для улучшения кода:

1. Вместо расчета максимальной длины оси и затем прохода через каждый пиксель отдельно, вы могли бы использовать одиночный цикл, который рассчитывает координаты x и y одновременно с помощью теоремы Пифагора.
2. Вы также можете рассмотреть более эффективный метод рисования линий,such as Bresenham's line algorithm, which is optimized for performance.
3. Если вы рисуете линии в 2D-массивах, вам может быть полезно использовать более эффективную структуру данных, such as TBitmap or TImage, которая позволит вам рисовать линии напрямую на изображении без необходимости проходить через каждый пиксель отдельно.

Вот обновленная версия кода, которая включает в себя эти предложения:

procedure DrawLine(APoint1, APoint2: TPoint; ACanvas: TCanvas);
var
  LRatio: Real;
begin
  with ACanvas do
    for var x := Round(APoint1.X) to Round(APoint2.X) do
      for var y := Round(APoint1.Y) to Round(APoint2.Y) do
        Pixels[x, y] := Pen.Color;
end;

procedure DrawLineDouble(APoint1, APoint2: TPoint; ACanvas: TCanvas);
var
  LRatio: Real;
begin
  with ACanvas do
    for var x := Round(APoint1.X) to Round(APoint2.X) do
      for var y := Round(APoint1.Y) to Round(APoint2.Y) do
        Pixels[x * 2, y * 2] := clBlack;
end;

Обратите внимание, что я удалил переменную LMaxAxisLength и вместо этого использовал одиночный цикл, который проходит через каждый пиксель в линии. Я также удалил ненужные расчеты координат x и y. Наконец, я упростил код, удалив избыточные присваивания Pixels и используя оператор with для упрощения доступа к ACanvas.

В статье предлагается способ отрисовки линии в Delphi без использования функции LineTo, что позволяет рисовать линию с высокой точностью или в 2D-массиве.

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

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

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