Нарисовать линию, не используя функции LineTo
Оформил: 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;
|