Линия со сглаженными краями

[dmitriegorovih]

А та процедура совсем не подошла чтоль?

Пытался но не в какую не хочет работать.

в последней ссылке подписи

А можете у казать именно какую, а то я у вас насчитал аш 10.

[DomiNick]

Пытался но не в какую не хочет работать.

Как так? о__О

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.Button1Click(Sender: TObject);
begin
Image1.Picture.Bitmap.PixelFormat:=pf24bit; //
WuLine(Image1.Picture.Bitmap, Point(10, 20), Point(200, 330), clRed);
Image1.Refresh;
end;

[dmitriegorovih]

Как так? о__О

Вот мой проект может я чёта не так делаю у меня Delphi 7?

[BOBAH13]

какой ужас, ну все как обычно в принципе, даешь ответ, тебя игнорируют и решают что аргументированный ответ типа "нелестные отзывы, но я не пробовал" вполне удовлетворительны. Ну и изобретайте велосипед дальше. Что я могу сказать.

[dmitriegorovih]

Как так? о__О

Всё равно не чего не показывает у меня Delphi 7 может из за этого?

[DomiNick]

Ну и изобретайте велосипед дальше. Что я могу сказать.

А вы сравнивали что лучше? Готовое-то конечно проще взять...

Всё равно не чего не показывает у меня Delphi 7 может из за этого?

У меня тоже D7...

Хм...
У вас же в Image1.Picture вообще нет битмапа... На чём вы рисуете-то? )

Как-то так:

procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered:=True;
Image1.Picture.Bitmap:=TBitmap.Create;
Image1.Picture.Bitmap.PixelFormat:=pf24bit;
Image1.Picture.Bitmap.Width:=256;
Image1.Picture.Bitmap.Height:=256;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
WuLine(Image1.Picture.Bitmap, Point(10, 20), Point(200, 330), clRed);
Image1.Refresh;
end;

[BOBAH13]

Вы прикалываетесь? Что лучше? Мда... Алгоритм один и тот же, нарисовать линию с зубцами, а потом антиалиасинг наложить, тобишь искать среднее между цветом линии и фоном и накладывать на границу между ними. ЧТо тут сравнивать? Тогда может не будем использовать DirectX или OpenGL, может лучше вообще свои дрова написать?
Ну детский сад честное слово.

У GDI+ есть только один серьезный недостаток, в остальном он вполне хорош. GDI+ очень тормознутый, обычному GDI уступает как минимум раз в 10 по скорости

Вот ведь не задача, видимо мои 2 года работы с GDI+ и приобретенный опыт все в пустую и не верно А вы не задумывались, что дело вовсе не в технологии, а в "умелых ручках"? Странно ведь, технология вышедшая на замену GDI хуже и тормознутей, странно как то, тогда наверное Windows 7 тормознутей чем Windows 95.

[Alex Cones]

А можете у казать именно какую, а то я у вас насчитал аш 10.

https://sourceforge.net/projects/fvfl/

[Ins]

У GDI+ есть только один серьезный недостаток, в остальном он вполне хорош. GDI+ очень тормознутый, обычному GDI уступает как минимум раз в 10 по скорости

[dmitriegorovih]

Всем Спасибо кто откликнулся и помог.
Вот как я сделал линию с изменением ширины

unit Unit1;

interface

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

type
   TRGBTripleArray = array[0..1000] of TRGBTriple;
   PRGBTripleArray = ^TRGBTripleArray;
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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 ; razmer:integer; AColor : TColor);
 var
   deltax, deltay, loop, start, finish, i: 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
     for i:=1 to razmer do begin
       AlphaBlendPixel(ABitmap, loop, trunc(dy) +(i-1), LR, LG, LB, 1 - frac(dy));
       AlphaBlendPixel(ABitmap, loop, trunc(dy) + i, LR, LG, LB, frac(dy));
       end;
       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
     for i:=1 to razmer do begin
       AlphaBlendPixel(ABitmap, trunc(dx)+(i-1), loop, LR, LG, LB, 1 - frac(dx));
       AlphaBlendPixel(ABitmap, trunc(dx) + i, loop, LR, LG, LB, frac(dx));
       end;
       dx := dx + dydx; // next point
    end;
   end;
 end;


procedure TForm1.Button1Click(Sender: TObject);
begin
WuLine(Image1.Picture.Bitmap, Point(0, 0), Point(10, 150),4, clRed); // где 4 размер линии
Image1.Refresh;
image1.Transparent:=true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered:=True;
Image1.Picture.Bitmap:=TBitmap.Create;
Image1.Picture.Bitmap.PixelFormat:=pf24bit;
Image1.Picture.Bitmap.Width:=256;
Image1.Picture.Bitmap.Height:=256;
end;