Delphi 7的简单抗锯齿功能

Question

我需要一个非常简单的函数来绘制一堆具有抗锯齿功能的行.它必须遵循Delphi范式:自包含和SYSTEM INDEPENDENT(没有DLL地狱),快速,简单.有谁知道这样的图书馆？

到现在为止我尝试过:

WuLine
swissdelphicenter.ch/torry/showcode.php?id=1812
我不认为这段代码的作者曾经运行过它.画一条线需要一秒钟!这显然只是出于教育目的:)

来自TMetaFile
链接的抗锯齿图:blog.synopse.info/post/2010/04/02/Antialiased-drawing-from-TMetaFile
还没有真正尝试过这个(我可能很快就会这样做).它仅适用于TMetaFiles.它只加载EMF文件并使用抗锯齿功能绘制它.此外,该网站上的许多代码只是示范/教育.

Image32
非常好的图书馆 - 迄今为止最完整.我可能会用它,但它对于我需要的东西来说太过分了.
缺点:
- 添加到应用程序的足迹非常大.
- 真的很难用.
- 即使是简单的任务,你也需要深入了解其模糊的文档. - 提供的演示代码太复杂了.
- 越野车!
- 没有最近的更新(修复错误)

Anti-Grain Geometry库
该库需要一个不错的安装程序.该库的编写者是Linux/Mac用户.Windows实现看起来很奇怪.我不能对图书馆本身说些什么.

Xiaolin Wu的基础功能(由Andreas Rejbrand撰写)
刚看到以下几篇文章.Andreas Rejbrand提供了一个非常紧凑的解决方案.迄今为止的最佳解决方

---

看起来我必须解释为什么我不喜欢大型第三方库和VCL:

• 你必须安装它们
• 大型库意味着大量的错误
• 你必须检查更新(并再次安装)
• 当你重新安装Delphi时,你必须再次安装它们(是的,我讨厌安装VCL)
• 对于VCL,这意味着你必须在已经拥挤的调色板中加载一些额外的图标.
• (有时)没有支持
• 大量的足迹增加了您的应用程序大小
• 大型图书馆意味着(并非总是但在大多数情况下)难以使用 - 比您需要的更难.
• (对于外部DLL和API)您的应用程序依赖于系统 - 非常讨厌!

Answer 1

在Delphi中实现Xiaolin Wu的抗锯齿线渲染算法并不是很难.当我编写以下过程时,我使用维基百科文章作为参考(实际上,我只是将伪代码翻译成Delphi并更正了一个错误,并添加了对彩色背景的支持):

procedure DrawAntialisedLine(Canvas: TCanvas; const AX1, AY1, AX2, AY2: real; const LineColor: TColor);

var
  swapped: boolean;

  procedure plot(const x, y, c: real);
  var
    resclr: TColor;
  begin
    if swapped then
      resclr := Canvas.Pixels[round(y), round(x)]
    else
      resclr := Canvas.Pixels[round(x), round(y)];
    resclr := RGB(round(GetRValue(resclr) * (1-c) + GetRValue(LineColor) * c),
                  round(GetGValue(resclr) * (1-c) + GetGValue(LineColor) * c),
                  round(GetBValue(resclr) * (1-c) + GetBValue(LineColor) * c));
    if swapped then
      Canvas.Pixels[round(y), round(x)] := resclr
    else
      Canvas.Pixels[round(x), round(y)] := resclr;
  end;

  function rfrac(const x: real): real; inline;
  begin
    rfrac := 1 - frac(x);
  end;

  procedure swap(var a, b: real);
  var
    tmp: real;
  begin
    tmp := a;
    a := b;
    b := tmp;
  end;

var
  x1, x2, y1, y2, dx, dy, gradient, xend, yend, xgap, xpxl1, ypxl1,
  xpxl2, ypxl2, intery: real;
  x: integer;

begin

  x1 := AX1;
  x2 := AX2;
  y1 := AY1;
  y2 := AY2;

  dx := x2 - x1;
  dy := y2 - y1;
  swapped := abs(dx) < abs(dy);
  if swapped then
  begin
    swap(x1, y1);
    swap(x2, y2);
    swap(dx, dy);
  end;
  if x2 < x1 then
  begin
    swap(x1, x2);
    swap(y1, y2);
  end;

  gradient := dy / dx;

  xend := round(x1);
  yend := y1 + gradient * (xend - x1);
  xgap := rfrac(x1 + 0.5);
  xpxl1 := xend;
  ypxl1 := floor(yend);
  plot(xpxl1, ypxl1, rfrac(yend) * xgap);
  plot(xpxl1, ypxl1 + 1, frac(yend) * xgap);
  intery := yend + gradient;

  xend := round(x2);
  yend := y2 + gradient * (xend - x2);
  xgap := frac(x2 + 0.5);
  xpxl2 := xend;
  ypxl2 := floor(yend);
  plot(xpxl2, ypxl2, rfrac(yend) * xgap);
  plot(xpxl2, ypxl2 + 1, frac(yend) * xgap);

  for x := round(xpxl1) + 1 to round(xpxl2) - 1 do
  begin
    plot(x, floor(intery), rfrac(intery));
    plot(x, floor(intery) + 1, frac(intery));
    intery := intery + gradient;
  end;

end;

要使用此功能,只需提供要绘制的画布(以类似于需要设备上下文(DC)的Windows GDI函数的方式),并指定行上的初始点和最终点.请注意,上面的代码绘制了一条黑线,背景必须是白色.将其概括为任何情况并不困难,甚至不是透明的透明图纸.只需调整plot功能,其中像素c \in [0, 1]的不透明度为(x, y).

用法示例:

创建一个新的VCL项目并添加

procedure TForm1.FormCreate(Sender: TObject);
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clWhite;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Canvas.FillRect(ClientRect);
  DrawAntialisedLine(Canvas, Width div 2, Height div 2, X, Y, clBlack);
end;

(放大)

OpenGL的

如果您需要2D或3D的高性能和高质量渲染,并且您自己完成所有绘图,那么OpenGL通常是最佳选择.在Delphi中编写OpenGL应用程序非常容易.请参阅http://privat.rejbrand.se/smooth.exe以获取我在十分钟内制作的示例.使用鼠标右键在填充的多边形和轮廓之间切换,然后单击并按住鼠标左键进行拍摄!

更新

我只是让代码在彩色背景上工作(例如,照片).

(放大)

更新 - 超快速方法

上面的代码相当慢,因为Bitmap.Pixels属性非常慢.当我使用图形时,我总是使用二维颜色值数组来表示位图,这种颜色值要快得多.当我完成图像后,我将其转换为GDI位图.我还有一个从GDI位图创建pixmap数组的函数.

我修改了上面的代码来绘制数组而不是GDI位图,结果很有希望:

• 渲染100行所需的时间
• GDI位图:2.86秒
• 像素阵列:0.01秒

如果我们让

type
  TPixmap = array of packed array of RGBQUAD;

并定义

procedure TForm3.DrawAntialisedLineOnPixmap(var Pixmap: TPixmap; const AX1, AY1, AX2, AY2: real; const LineColor: TColor);
var
  swapped: boolean;

  procedure plot(const x, y, c: real);
  var
    resclr: TRGBQuad;
  begin
    if swapped then
    begin
      if (x < 0) or (y < 0) or (x >= ClientWidth) or (y >= ClientHeight) then
        Exit;
      resclr := Pixmap[round(y), round(x)]
    end
    else
    begin
      if (y < 0) or (x < 0) or (y >= ClientWidth) or (x >= ClientHeight) then
        Exit;
      resclr := Pixmap[round(x), round(y)];
    end;
    resclr.rgbRed := round(resclr.rgbRed * (1-c) + GetRValue(LineColor) * c);
    resclr.rgbGreen := round(resclr.rgbGreen * (1-c) + GetGValue(LineColor) * c);
    resclr.rgbBlue := round(resclr.rgbBlue * (1-c) + GetBValue(LineColor) * c);
    if swapped then
      Pixmap[round(y), round(x)] := resclr
    else
      Pixmap[round(x), round(y)] := resclr;
  end;

  function rfrac(const x: real): real; inline;
  begin
    rfrac := 1 - frac(x);
  end;

  procedure swap(var a, b: real);
  var
    tmp: real;
  begin
    tmp := a;
    a := b;
    b := tmp;
  end;

var
  x1, x2, y1, y2, dx, dy, gradient, xend, yend, xgap, xpxl1, ypxl1,
  xpxl2, ypxl2, intery: real;
  x: integer;

begin

  x1 := AX1;
  x2 := AX2;
  y1 := AY1;
  y2 := AY2;

  dx := x2 - x1;
  dy := y2 - y1;
  swapped := abs(dx) < abs(dy);
  if swapped then
  begin
    swap(x1, y1);
    swap(x2, y2);
    swap(dx, dy);
  end;
  if x2 < x1 then
  begin
    swap(x1, x2);
    swap(y1, y2);
  end;

  gradient := dy / dx;

  xend := round(x1);
  yend := y1 + gradient * (xend - x1);
  xgap := rfrac(x1 + 0.5);
  xpxl1 := xend;
  ypxl1 := floor(yend);
  plot(xpxl1, ypxl1, rfrac(yend) * xgap);
  plot(xpxl1, ypxl1 + 1, frac(yend) * xgap);
  intery := yend + gradient;

  xend := round(x2);
  yend := y2 + gradient * (xend - x2);
  xgap := frac(x2 + 0.5);
  xpxl2 := xend;
  ypxl2 := floor(yend);
  plot(xpxl2, ypxl2, rfrac(yend) * xgap);
  plot(xpxl2, ypxl2 + 1, frac(yend) * xgap);

  for x := round(xpxl1) + 1 to round(xpxl2) - 1 do
  begin
    plot(x, floor(intery), rfrac(intery));
    plot(x, floor(intery) + 1, frac(intery));
    intery := intery + gradient;
  end;

end;

和转换功能

var
  pixmap: TPixmap;

procedure TForm3.CanvasToPixmap;
var
  y: Integer;
  Bitmap: TBitmap;
begin

  Bitmap := TBitmap.Create;
  try
    Bitmap.SetSize(ClientWidth, ClientHeight);
    Bitmap.PixelFormat := pf32bit;

    BitBlt(Bitmap.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, Canvas.Handle, 0, 0, SRCCOPY);

    SetLength(pixmap, ClientHeight, ClientWidth);
    for y := 0 to ClientHeight - 1 do
      CopyMemory(@(pixmap[y][0]), Bitmap.ScanLine[y], ClientWidth * sizeof(RGBQUAD));

  finally
    Bitmap.Free;
  end;

end;

procedure TForm3.PixmapToCanvas;
var
  y: Integer;
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;

  try
    Bitmap.PixelFormat := pf32bit;
    Bitmap.SetSize(ClientWidth, ClientHeight);

    for y := 0 to Bitmap.Height - 1 do
      CopyMemory(Bitmap.ScanLine[y], @(Pixmap[y][0]), ClientWidth * sizeof(RGBQUAD));

    Canvas.Draw(0, 0, Bitmap);

  finally
    Bitmap.Free;
  end;

end;

那我们就可以写了

procedure TForm3.FormPaint(Sender: TObject);
begin

  // Get the canvas as a bitmap, and convert this to a pixmap
  CanvasToPixmap;

  // Draw on this pixmap (very fast!)
  for i := 0 to 99 do
    DrawAntialisedLineOnPixmap(pixmap, Random(ClientWidth), Random(ClientHeight), Random(ClientWidth), Random(ClientHeight), clRed);

  // Convert the pixmap to a bitmap, and draw on the canvas
  PixmapToCanvas;

end;

这将在不到百分之一秒的时间内在表格上呈现100条抗锯齿线.

但是,代码中似乎存在一个小错误,可能是在Canvas - > Pixmap函数中.但是现在我太累了,无法调试(刚下班回家).

Answer 2

我相信GDI +会进行抗锯齿绘制(默认情况下),我不知道最近的Delphi版本是否有GdiPlus.pas,但是有在线可用的副本.