delphi - Delphi 7 的简单抗锯齿功能

Question

我需要一个非常简单的函数来绘制一堆具有抗锯齿功能的线条。它必须遵循 Delphi 范例:自包含且独立于系统(无 DLL hell )、快速、简单。有人知道这样的库吗？

到目前为止我已经尝试过:

无线
swissdelphicenter.ch/terry/showcode.php?id=1812
我认为这段代码的作者从未运行过它。画一条线需要一秒钟!这显然仅用于教育目的:)

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

图片32
非常好的图书馆——迄今为止最完整的。我可能会使用它，但它对于我的需要来说太过分了。
缺点:
- 添加到应用程序的占用空间相当大。
- 真的很难使用。
- 即使对于简单的任务，您也需要深入研究其晦涩的文档。 - 提供的演示代码太复杂。
- buggy !
- 最近没有更新(修复错误)

反颗粒几何库
该库需要一个像样的安装程序。该库的作者是 Linux/Mac 用户。 Windows 的实现看起来很奇怪。关于图书馆本身，我无法再说什么。

吴晓林的基础函数(作者:Andreas Rejbrand)
看看下面几篇帖子就知道了。 Andreas Rejbrand 提供了一个非常紧凑的解决方案。到目前为止最好的解决方案。

<小时/>

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

• 你必须安装它们
• 大型库意味着大量错误，这意味着
• 您必须检查更新(并再次安装)
• 当你重新安装 Delphi 时，你必须再安装一次(是的，我讨厌安装 VCL)
• 对于 VCL，这意味着您必须在已经拥挤的调色板中加载一些额外的图标。
• (有时)不支持
• 增加了应用程序大小的占用空间
• 大型库意味着(虽然并非总是如此，但在大多数情况下)难以使用 - 比您需要的更困难。
• (对于外部 DLL 和 API)您的应用程序变得依赖于系统 - 真的很讨厌!

Answer 1

在Delphi中实现吴晓林的抗锯齿线条渲染算法并不难。我用过the Wikipedia article作为我编写以下过程时的引用(实际上，我只是将伪代码翻译为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;

要使用此函数，只需提供要绘制的 Canvas (其方式与需要设备上下文 (DC) 的 Windows GDI 函数非常相似)，并指定线条上的起始点和终止点。请注意，上面的代码绘制了一条黑色线，并且背景必须是白色。将此推广到任何情况并不困难，甚至是 alpha 透明的绘图。只需调整 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;

(Magnify)

OpenGL

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

更新

我刚刚让代码在彩色背景(例如照片)上运行。

(Magnify)

更新 - 超快速方法

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

我修改了上面的代码以在数组而不是 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 函数中。但现在我太累了，无法调试(刚下类回家)。