Форум: "Media";
Текущий архив: 2004.07.25;
Скачать: [xml.tar.bz2];
ВнизСглаживание 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;
----------- КОД --------------
← →
Mihey © (2004-05-08 19:34) [10]Этот кусок кода рисует только прямые линии, когда лучшее сглаживание - отсутсвие оного.
Про эллипс. В предыдущем коде линия рисовалась вручную и каждый пиксель риосвался через AlphaBlendPixel. Следовательно, нужно то же самое проделать для эллипса. Можно поискать алгоритм рисования эллипса (например, по Брэнзехэму) и изменить код. Я так с ходу не нашёл.
← →
Mihey © (2004-05-08 19:49) [11]И всё же тем не менее... Вот код из примочки для 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? или откудова-то его можно скачать?!
← →
Mihey © (2004-05-08 23:12) [13]Graphic32 - это дополнительная быстрая библиотека для работы с графикой. Я имел ввиду, что принцип один и тот же, можно переделывать и под Canvas. А Graphic32 можешь попробовать, бесплатна, вот официальный сайт:
http://www.g32.org
Антиалиасинг линии там изначально реализован, через дополнительные модули - эллипсы, кривые и всё прочее.
Страницы: 1 вся ветка
Форум: "Media";
Текущий архив: 2004.07.25;
Скачать: [xml.tar.bz2];
Память: 0.51 MB
Время: 0.036 c