2007. február 22., csütörtök
Antialiased line drawer
Problem/Question/Abstract:
How do I draw smooth lines in my apps like photoshop?
Answer:
procedure AALine(x1, y1, x2, y2: single; color: tcolor; canvas: tcanvas);
function CrossFadeColor(FromColor, ToColor: TColor; Rate: Single): TColor;
var
r, g, b: byte;
begin
r := Round(GetRValue(FromColor) * Rate + GetRValue(ToColor) * (1 - Rate));
g := Round(GetGValue(FromColor) * Rate + GetGValue(ToColor) * (1 - Rate));
b := Round(GetBValue(FromColor) * Rate + GetBValue(ToColor) * (1 - Rate));
Result := RGB(r, g, b);
end;
procedure hpixel(x: single; y: integer);
var
FadeRate: single;
begin
FadeRate := x - trunc(x);
with canvas do
begin
pixels[trunc(x), y] := CrossFadeColor(Color, Pixels[Trunc(x), y], 1 - FadeRate);
pixels[trunc(x) + 1, y] := CrossFadeColor(Color, Pixels[Trunc(x) + 1, y],
FadeRate);
end;
end;
procedure vpixel(x: integer; y: single);
var
FadeRate: single;
begin
FadeRate := y - trunc(y);
with canvas do
begin
pixels[x, trunc(y)] := CrossFadeColor(Color, Pixels[x, Trunc(y)], 1 - FadeRate);
pixels[x, trunc(y) + 1] := CrossFadeColor(Color, Pixels[x, Trunc(y) + 1],
FadeRate);
end;
end;
var
i: integer;
ly, lx, currentx, currenty, deltax, deltay, l, skipl: single;
begin
if (x1 <> x2) or (y1 <> y2) then
begin
currentx := x1;
currenty := y1;
lx := abs(x2 - x1);
ly := abs(y2 - y1);
if lx > ly then
begin
l := trunc(lx);
deltay := (y2 - y1) / l;
if x1 > x2 then
begin
deltax := -1;
skipl := (currentx - trunc(currentx));
end
else
begin
deltax := 1;
skipl := 1 - (currentx - trunc(currentx));
end;
end
else
begin
l := trunc(ly);
deltax := (x2 - x1) / l;
if y1 > y2 then
begin
deltay := -1;
skipl := (currenty - trunc(currenty));
end
else
begin
deltay := 1;
skipl := 1 - (currenty - trunc(currenty));
end;
end;
currentx := currentx + deltax * skipl;
currenty := currenty + deltay * skipl; {}
for i := 1 to trunc(l) do
begin
if lx > ly then
vpixel(trunc(currentx), currenty)
else
hpixel(currentx, trunc(currenty));
currentx := currentx + deltax;
currenty := currenty + deltay;
end;
end;
end;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése