procedure SLineTo(Canvas : TCanvas; X2,Y2 : Integer);
// Zeichnet eine geglättete Linie. Berechnet eine (gute) Näherung zu einer perfekt geglätteten Linie (max 4% Fehler).
Var
dx, dy, X, Y, E, R, L, dT,
dB, X1, Y1 : Integer;
MainColor : TColor;
S : Boolean;
procedure Swap(
var A, B : Integer);
Var T : Integer;
begin
T := A; A := B; B := T;
end;
function Blend(
const Color : TColor; I : Integer) : TColor;
// Farbe Mischen
Type
RGB =
record
R, G, B, A : byte;
end;
begin
RGB(Result).R := (
RGB(MainColor).R*I+
RGB(Color).R*(2*L-I))
div 2
div L;
RGB(Result).G := (
RGB(MainColor).G*I+
RGB(Color).G*(2*L-I))
div 2
div L;
RGB(Result).B := (
RGB(MainColor).B*I+
RGB(Color).B*(2*L-I))
div 2
div L;
RGB(Result).A := 0;
end;
begin
with Canvas
do
begin
X1 := PenPos.X;
Y1 := PenPos.Y;
dx := X2 - X1;
dy := Y2 - Y1;
if (dx=0)
or (dy=0)
then // horiz./vert. Linie bzw. Punkt
begin
LineTo(X2,Y2);
// (Endpunkt selbst wird nicht mitgezeichnet)
exit;
end;
MoveTo(X2,Y2);
// Endpunkt
if abs(dy) > abs(dx)
then // Fallunterscheidung für alle 4 Quadranten
begin
Swap(dx,dy);
Swap(X1,Y1);
Swap(X2,Y2);
S := True;
end else
S := False;
if dx < 0
then
begin
Swap(X1,X2);
Swap(Y1,Y2);
dx := -dx;
dy := -dy;
end;
if dy < 0
then
begin
R := -1;
dy := -dy;
end else
R := 1;
Y := Y1;
E := 0;
L := Round(Sqrt(dx*dx+dy*dy));
MainColor := Pen.Color;
For X := X1
to X2
do
begin
dT := L-2*E;
dB := L+2*E;
if dT > L
then
begin
if S
then Pixels[Y-R,X] := Blend(Pixels[Y-R,X],dT-L)
else // Glättung oben bzw. links
Pixels[X,Y-R] := Blend(Pixels[X,Y-R],dT-L);
dT := L;
end;
if dB > L
then
begin
if S
then Pixels[Y+R,X] := Blend(Pixels[Y+R,X],
dB-L)
else // Glättung unten bzw. rechts
Pixels[X,Y+R] := Blend(Pixels[X,Y+R],
dB-L);
dB := L;
end;
if (dT >= 0)
and (
dB >= 0)
then
if S
then Pixels[Y,X] := Blend(Pixels[Y,X],dT+
dB)
else // normale Linie
Pixels[X,Y] := Blend(Pixels[X,Y],dT+
dB);
inc(E, dy);
if E*2 >= dx
then
begin
Y := Y + R;
dec(E, dx);
end;
end;
end;
end;