procedure AntiAliasLine(dc: HDC; x1, y1, x2, y2: integer; clr: TColor);
var
i, lz: integer;
ly, lx, cx, cy, dx, dy, skp: single;
function mix(frmc, toc: TColor; w: Single): TColor;
begin
Result := RGB(Round(GetRValue(frmc) * w + GetRValue(toc) * (1 - w)),
Round(GetGValue(frmc) * w + GetGValue(toc) * (1 - w)),
Round(GetBValue(frmc) * w + GetBValue(toc) * (1 - w)));
end;
procedure vert(x: integer; y: single);
var w: single;
begin
w := frac(y);
setpixel(dc, x, trunc(y), mix(clr, getpixel(dc, x, trunc(y)),
1 - w));
setpixel(dc, x, trunc(y) + 1, mix(clr, getpixel(dc, x,
trunc(y) + 1), w));
end;
procedure horz(x: single; y: integer);
var w: single;
begin
w := frac(x);
setpixel(dc, trunc(x), y, mix(clr, getpixel(dc, trunc(x),
y), 1 - w));
setpixel(dc, trunc(x) + 1, y, mix(clr, getpixel(dc, trunc(x)
+ 1, y), w));
end;
begin
if (x1 <> x2) or (y1 <> y2) then
begin
lx := abs(x2 - x1);
ly := abs(y2 - y1);
if lx > ly then
begin
lz := trunc(lx);
dy := (y2 - y1) / lz;
i := ord(x1 <= x2);
skp := i;
dx := i * 2 - 1;
end else
begin
lz := trunc(ly);
dx := (x2 - x1) / lz;
i := ord(y1 <= y2);
skp := i;
dy := i * 2 - 1;
end;
cx := x1 + dx * skp;
cy := y1 + dy * skp;
for i := 1 to lz do
begin
if lx > ly then vert(trunc(cx), cy) else
horz(cx, trunc(cy));
cx := cx + dx;
cy := cy + dy;
end;
end;
end;
// Beispiel
procedure TForm1.Button1Click(Sender: TObject);
begin
with canvas do begin
pen.color := clred;
moveto(10, 5);
lineto(200, 95);
end;
AntiAliasLine(canvas.handle, 10, 10, 200, 100, clred);
end;