Сглаживание Anti-aliasing

← →
Leos (2004-05-06 18:22) [0]

Как сделать чтобы можно было рисовать линии сглаженными?

← →
free2 (2004-05-06 20:25) [1]

так что-ли

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin Canvas.LineTo(x,y); end;

← →
Mihey © (2004-05-06 20:42) [2]

Теория:
http://freespace.virgin.net/hugo.elias/graphics/x_wuline.htm
(дан алгоритм, который при желании можно реализовать на Delphi)

Готовая реализация:
http://www.swissdelphicenter.ch/torry/showcode.php?id=1812

← →
miek © (2004-05-06 21:11) [3]

Можно рисовать обычные, а потом - сглаживать (типа Blur в фотошопе). Так проще...

← →
Mihey © (2004-05-06 22:51) [4]

2 miek:

М-м? Сглаживать рисунок весь или линии. Во втором случае тяжеловато придётся, ну а в первом случае можно обратиться к:

http://www.swissdelphicenter.ch/torry/showcode.php?id=1484

Или увеличивать изображение, например, в 3 раза используя билинейные или другие фильтры, а затем увеличенное уменьшать до прежних размеров.

← →
Original (2004-05-07 17:14) [5]

защёл как было вышеописано Мигелем!

> Mihey © (06.05.04 20:42) [2]
> Теория:
> http://freespace.virgin.net/hugo.elias/graphics/x_wuline.htm
> (дан алгоритм, который при желании можно реализовать на Delphi)

> Готовая реализация:
> http://www.swissdelphicenter.ch/torry/showcode.php?id=1812

И по этому примеру сделал свой.. слушайте! может это у меня в генах? :) но почему то не получается рисовать то сглажено!

З.ы.: На форме только button и Image1

-----------КОД---------------
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
pt1, pt2: TPoint;

implementation

{$R *.dfm}

type
TRGBTripleArray = array[0..1000] of TRGBTriple;
PRGBTripleArray = ^TRGBTripleArray;

// 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;

// 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;

procedure TForm1.FormCreate(Sender: TObject);
var
Bitmap: TBitmap;
begin
Bitmap := nil;
try
Bitmap := TBitmap.Create;
Bitmap.Width := 200;
Bitmap.Height := 200;
Image1.Picture.Graphic := Bitmap;
finally
Bitmap.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
pt1 := Point(10, 34);
pt2 := Point(1000, 1000);
WuLine(Image1.Picture.Bitmap,pt1,pt2,clred);
end;

end.

Может кто поможет исправить ошибку? Буду признателен!
Заранее Сенькс!

← →
Mihey © (2004-05-07 20:39) [6]

Реализация верная, проблема в AlphaBlendPixel. Попробую разобраться.

← →
Mihey © (2004-05-07 20:50) [7]

2 Original:

В общем, не знаю, в чём проблема - в предложенном мной решении или в тебе. Нужно явно указать PixelFormat битмапа, типа, там где размеры задаёшь (до размеров):

Bitmap.PixelFormat := pf24bit;

Либо в WuLine это добавь.

← →
Mihey © (2004-05-07 20:51) [8]

Если ещё сложности возникнут, то вот код мой, который стопудов работает, ибо я даже проверил:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TformMain = class(TForm)
buttonDraw: TButton;
procedure buttonDrawClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

type
TRGBTripleArray = array[0..1000] of TRGBTriple;
PRGBTripleArray = ^TRGBTripleArray;

procedure WuLine(var ABitmap : TBitmap ; Point1, Point2 : TPoint ; AColor : TColor);
procedure AlphaBlendPixel(var ABitmap : TBitmap ; X, Y : integer ; R, G, B : byte ; ARatio : Real);

var
formMain: TformMain;

implementation

{$R *.DFM}

// anti-aliased line
procedure WuLine(var 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
ABitmap.PixelFormat := pf24bit;
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
// ABitmap.Canvas.Pixels[loop, trunc(dy)] := clRed;
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
// ABitmap.Canvas.Pixels[trunc(dx), loop] := clRed;
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(var 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;

procedure TformMain.buttonDrawClick(Sender: TObject);
var a: TBitmap;
begin
a := TBitmap.Create;
a.Width := 200;
a.Height := 200;
WuLine(a, Point(2, 2), Point(156, 158), clRed);
BitBlt(Canvas.Handle, 0, 0, 200, 200, a.Canvas.Handle, 0, 0, SrcCopy);
a.Free;
end;

end.

← →
Plesh (2004-05-08 13:55) [9]

Ой! Клёва :) у меня получилось :)
А скажите, в магазине тоже можно так же стеночку отодвинуть? (с)

А, хе :)
Ну вот тут пример линии, а как Элипс рисовать???

Думал, вот этот кусок кода отвечает за прорисовску, оказалось не так, а как тогда?

----------- КОД --------------

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;
----------- КОД --------------

Этот кусок кода рисует только прямые линии, когда лучшее сглаживание - отсутсвие оного.

Про эллипс. В предыдущем коде линия рисовалась вручную и каждый пиксель риосвался через AlphaBlendPixel. Следовательно, нужно то же самое проделать для эллипса. Можно поискать алгоритм рисования эллипса (например, по Брэнзехэму) и изменить код. Я так с ходу не нашёл.

И всё же тем не менее... Вот код из примочки для Graphic32, который можно переделать на нужды очень легко. Я закомментировал отдельные части, чтобы было легче понять, что делается при помощи Graphic32:

procedure Ellipse(aBMP: TBitmap32; // почти то же, что и TBitmap Rect: TRect; // область эллипса AA: Boolean; // использовать сглаживание clLine: TColor32); // почти то же, что и TColor var t1,t2,t3,t4,t5,t6,t7,t8,t9: integer; d1,d2,x,y: integer; center_x,center_y,rx,ry: integer; e: single; begin center_x := (Rect.Right+Rect.Left) shr 1; center_y := (Rect.Bottom+Rect.Top) shr 1; rx := (Rect.Right-Rect.Left) shr 1; ry := (Rect.Bottom-Rect.Top) shr 1; t1 := rx*rx; t2 := t1 shl 1; t3 := t2 shl 1; t4 := ry*ry; t5 := t4 shl 1; t6 := t5 shl 1; t7 := rx*t5; t8 := t7 shl 1; t9 := 0; d1 := t2 - t7 + (t4 shr 1); d2 :=(t1 shr 1) - t8 + t5; x := rx; y := 0; e := rx; while (d2<0) do begin if not AA then //no antialias begin { TBitmap32.SetPixelT можно сказать просто ставит точку заданного цвета. } aBMP.SetPixelT(center_x+x, center_y+y, clLine); aBMP.SetPixelT(center_x+x, center_y-y, clLine); aBMP.SetPixelT(center_x-x, center_y+y, clLine); aBMP.SetPixelT(center_x-x, center_y-y, clLine); end else begin //with antialias { TBitmap32.SetPixelF является аналогом AlphaBlendPixel,н о использует несколько иной подход: координаты задаются дробными числами и в зависимости от коордиант рисуется пиксель со сглаживанием в ту или иную сторону. } aBMP.SetPixelF(center_x+e-1, center_y+y, clLine); aBMP.SetPixelF(center_x+e-1, center_y-y, clLine); aBMP.SetPixelF(center_x-e+1, center_y+y, clLine); aBMP.SetPixelF(center_x-e+1, center_y-y, clLine); e:=sqrt((t1*t4-t1*y*y)/t4); end; t9:=t9+t3; inc(y); if d1<0 then begin d1:=d1+t9+t2; d2:=d2+t9; end else begin dec(x); t8:=t8-t6; d1:=d1+t9+t2-t8; d2:=d2+t9+t5-t8; end; end; while (x>=0) do begin if not AA then begin aBMP.SetPixelT(center_x+x, center_y+y, clLine); aBMP.SetPixelT(center_x+x, center_y-y, clLine); aBMP.SetPixelT(center_x-x, center_y+y, clLine); aBMP.SetPixelT(center_x-x, center_y-y, clLine); end else begin e:=sqrt((t1*t4-t4*x*x)/t1); { SetPixelFS означает SetPixelF, только с проверкой (S = Safe), лежит ли точка в области битмапа, не вышла ли за границы. } aBMP.SetPixelFS(center_x+x, center_y+e, clLine); aBMP.SetPixelFS(center_x+x, center_y-e, clLine); aBMP.SetPixelFS(center_x-x, center_y+e, clLine); aBMP.SetPixelFS(center_x-x, center_y-e, clLine); end; dec(x); t8:=t8-t6; if (d2<0) then begin inc(y); t9:=t9+t3; d2:=d2+t9+t5-t8; end else begin d2:=d2+t5-t8; end; end; end;

← →
Plesh (2004-05-08 22:28) [12]

Тут же возникаеи вопрос, а graphic32 это стандартный модуль delphi? или откудова-то его можно скачать?!

Graphic32 - это дополнительная быстрая библиотека для работы с графикой. Я имел ввиду, что принцип один и тот же, можно переделывать и под Canvas. А Graphic32 можешь попробовать, бесплатна, вот официальный сайт:

http://www.g32.org

Антиалиасинг линии там изначально реализован, через дополнительные модули - эллипсы, кривые и всё прочее.

Сглаживание Anti-aliasing Найти похожие ветки