Tips (1541)

Tip Bewertung (28):

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