Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "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
3-1088626960
zokzok
2004-07-01 00:22
2004.07.25
Убывающий индекс


6-1084312860
BiBle
2004-05-12 02:01
2004.07.25
HTTP- запрос в Delphi, его проведение и обработка !


3-1088758637
white
2004-07-02 12:57
2004.07.25
Скажите где взять последнюю версию IBX


14-1089275950
inic
2004-07-08 12:39
2004.07.25
Об EGGах


1-1089290665
Oleg_
2004-07-08 16:44
2004.07.25
Как узнать версию IE





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский