Убрать зазубринки при рисовании линий

При рисовании линии, особенно под маленьким углом, хорошо различимы отдельные точки. Для устранения этого недостатка я использую уменьшение изображения.
procedure TForm1.Button1Click(Sender: TObject);
var
 x, y: Integer;
 i, j: Integer;
 r, g, b: Integer;
begin
 Form1.Canvas.Pen.Width := 10;
 Form1.Canvas.MoveTo(10, 10);
 Form1.Canvas.LineTo(90, 20);
 for y := 0 to 10 do
 begin
 for x := 0 to 25 do
 begin
 r := 0;
 for i := 0 to 3 do
 for j := 0 to 3 do
 r := r + GetRValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]);
 r := Round(r / 16);
 g := 0;
 for i := 0 to 3 do
 for j := 0 to 3 do
 g := g + GetGValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]);
 g := Round(g / 16);
 b := 0;
 for i := 0 to 3 do
 for j := 0 to 3 do
 b := b + GetBValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]);
 b := Round(b / 16);
 Form1.Canvas.Pixels[x, y+50] := RGB(r, g, b);
 end;
 Application.ProcessMessages;
 end;
end;
Author: Даниил Карапетян
Author: Алексей Денисов
ID: 03725
ID: 03734
----
{
 This code draws an anti-aliased line on a bitmap
 This means that the line is not jagged like the
 lines drawn using the LineTo() function
}
uses
 Graphics, Windows;
type
 TRGBTripleArray = array[0..1000] of TRGBTriple;
 PRGBTripleArray = ^TRGBTripleArray;
// anti-aliased line
procedure WuLine(ABitmap: TBitmap; Point1, Point2: TPoint; AColor: TColor);
var
 deltax, deltay, loop, start, finish: Integer;
 dx, dy, dydx: Single; // fractional parts
 LR, LG, LB: Byte;
 x1, x2, y1, y2: Integer;
begin
 x1 := Point1.X; y1 := Point1.Y;
 x2 := Point2.X; y2 := Point2.Y;
 deltax := abs(x2 - x1); // Calculate deltax and deltay for initialisation
 deltay := abs(y2 - y1);
 if (deltax = 0) or (deltay = 0) then
 begin // straight lines
 ABitmap.Canvas.Pen.Color := AColor;
 ABitmap.Canvas.MoveTo(x1, y1);
 ABitmap.Canvas.LineTo(x2, y2);
 exit;
 end;
 LR := (AColor and $000000FF);
 LG := (AColor and $0000FF00) shr 8;
 LB := (AColor and $00FF0000) shr 16;
 if deltax > deltay then
 begin // horizontal or vertical
 if y2 > y1 then // determine rise and run
 dydx := -(deltay / deltax)
 else
 dydx := deltay / deltax;
 if x2 < x1 then
 begin
 start := x2; // right to left
 finish := x1;
 dy := y2;
 end
 else
 begin
 start := x1; // left to right
 finish := x2;
 dy := y1;
 dydx := -dydx; // inverse slope
 end;
 for loop := start to finish do
 begin
 AlphaBlendPixel(ABitmap, loop, Trunc(dy), LR, LG, LB, 1 - frac(dy));
 AlphaBlendPixel(ABitmap, loop, Trunc(dy) + 1, LR, LG, LB, frac(dy));
 dy := dy + dydx; // next point
 end;
 end
 else
 begin
 if x2 > x1 then // determine rise and run
 dydx := -(deltax / deltay)
 else
 dydx := deltax / deltay;
 if y2 < y1 then
 begin
 start := y2; // right to left
 finish := y1;
 dx := x2;
 end
 else
 begin
 start := y1; // left to right
 finish := y2;
 dx := x1;
 dydx := -dydx; // inverse slope
 end;
 for loop := start to finish do
 begin
 AlphaBlendPixel(ABitmap, trunc(dx), loop, LR, LG, LB, 1 - frac(dx));
 AlphaBlendPixel(ABitmap, trunc(dx) + 1, loop, LR, LG, LB, frac(dx));
 dx := dx + dydx; // next point
 end;
 end;
end;
// blend a pixel with the current colour
procedure AlphaBlendPixel(ABitmap: TBitmap; X, Y: Integer; R, G, B: Byte; ARatio: Real);
var
 LBack, LNew: TRGBTriple;
 LMinusRatio: Real;
 LScan: PRGBTripleArray;
begin
 if (X < 0) or (X > ABitmap.Width - 1) or (Y < 0) or (Y > ABitmap.Height - 1) then
 Exit; // clipping
 LScan := ABitmap.Scanline[Y];
 LMinusRatio := 1 - ARatio;
 LBack := LScan[X];
 LNew.rgbtBlue := Round(B * ARatio + LBack.rgbtBlue * LMinusRatio);
 LNew.rgbtGreen := Round(G * ARatio + LBack.rgbtGreen * LMinusRatio);
 LNew.rgbtRed := Round(R * ARatio + LBack.rgbtRed * LMinusRatio);
 LScan[X] := LNew;
end;
ID: 03735
Category:Графика
Category:Рисование