Delphi – Simple anti-aliasing function for Delphi 7

delphi

I need a very simple function to draw a bunch of lines with anti-aliasing. It has to follow Delphi paradigm: self contained and SYSTEM INDEPENDENT (no DLL hell), fast, simple.
Anybody knows such a library?

Until now I have tried:

WuLine
swissdelphicenter.ch/torry/showcode.php?id=1812
I don't think that the author of this code ever run it. It takes one second to draw a single line! It is obviously only for educational purposes 🙂

Anti aliased drawing from TMetaFile
Link: blog.synopse.info/post/2010/04/02/Antialiased-drawing-from-TMetaFile
Haven't really tried this yet (I may do it soon). It works only with TMetaFiles. It only loads an EMF file and draw it using anti aliasing functions. Plus, much code on that web site is only demonstrational/educational.

Image32
Very nice library – most complete until now. I might use it but it is overkill for what I need.
Disadvantages:
– The footprint added to application is pretty big.
– Really difficult to use.
– You need to go really deep in its obscure documentation even for simple tasks.
– Demo code provided is way too complex.
– Buggy!
– No recent updates (to fix the bugs)

Anti-Grain Geometry library
The library needs a decent installer. The writers of the library are Linux/Mac users. The Windows implementation looks weird. I cannot say something else about the library itself.

Xiaolin Wu's based function (by Andreas Rejbrand)
Just see few posts below. Andreas Rejbrand provided a very compact solution. Best solution until now.

It looks like I have to explain why I don't like large 3rd party libraries and VCL's:

you have to install them
large library means large number of bugs which means
you have to check for updates (and install them again)
when you reinstall Delphi, you have to install them one more time (yes I hate installing VCLs)
for VCLs, it means you have to load some extra icons in your already crowded palette.
(sometimes) no support
LARGE footprint added to your application size
large library means (well not always but in most cases) difficult to use – more difficult than you need.
(for external DLLs and API) your application becomes system-dependent – really nasty!

Best Answer

It is not very hard to implement Xiaolin Wu's anti-aliasing line-rendering algorithm in Delphi. I used the Wikipedia article as a reference when I wrote the following procedure (actually, I just translated the pseudo-code to Delphi and corrected a bug, and added support for a coloured background):

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;

To use this function, simply provide the canvas to draw to (in a manner rather similar to the Windows GDI functions that require a device context (DC)), and specify the initial and final points on the line. Notice that the code above draws a black line, and that the background has to be white. It is not difficult to generalize this to any situation, not even alpha-transparent drawings. Simply adjust the plot function, in which c \in [0, 1] is the opacity of the pixel at (x, y).

Example usage:

Create a new VCL project and add

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;

Click to magnify
(Magnify)

OpenGL

If you need high-performance and high-quality rendering in 2D or 3D, and you do all the drawing yourself, then OpenGL is generally the best choice. It is very easy to write an OpenGL application in Delphi. See http://privat.rejbrand.se/smooth.exe for an example I made in just ten minutes. Use the right mouse button to toggle between filled polygons and outlines, and click and hold the left mouse button to shoot!

Update

I just made the code work on a coloured background (for instance, a photograph).

Click to magnify
(Magnify)

Update - The Ultra-Fast Method

The above code is rather slow because the Bitmap.Pixels property is amazingly slow. When I work with graphics, I always represent a bitmap using a two-dimensional array of colour values, which is much, much, much faster. And when I am done with the image, I convert it to a GDI bitmap. I also have a function that creates a pixmap array from a GDI bitmap.

I modified the code above to draw on an array instead of a GDI bitmap, and the result is promising:

Time required to render 100 lines
GDI Bitmap: 2.86 s
Pixel array: 0.01 s

If we let

type
  TPixmap = array of packed array of RGBQUAD;

and define

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;

and the conversion functions

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;

then we can write

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;

which will render 100 anti-aliased lines on the form, in less than one hundredth of a second.

There seems to be a small bug in the code, though, probably in the Canvas -> Pixmap function. But right now I am way too tired to debug (just got home from work).

Related Solutions

Delphi – EProgrammerNotFound exception in Delphi

It is just the result of a long day and we had gotten a little giddy. For many, many years (ever since I'd been on the team), we'd always joked about replacing some error message in the compiler for one of the most common errors with a similar message. Internally we've always joked and poked fun at different things and people (mostly on the team itself). If you don't have a sense of humor, you're destined to an early grave.

It was a simple conversation;

"Oh, you should have raised the EProgrammerNotFound exception in that function."
"LOL! We should add that exception and see who notices."
"I wonder how much speculation there will be about why it is there?"

So, I guess all I can say is, "You've all played right into our hands ;-)... Buwahahaha! pwned!"

Delphi – Simple Thread Sample Delphi

Yup, you declare a new type which inherits from TThread:

TMyWorkerThread = class(TThread)
end;

Then you add a function override for Execute():

TMyWorkerThread = class(TThread)
public
  procedure Execute; override;
end;

That procedure will be called when you start your thread. It will be executed in parallel with your main program. Let's write it.

procedure TMyWorkerThread.Execute;
begin
  //Here we do work
   DoSomeWork();
   DoMoreWork();
  //When we exit the procedure, the thread ends.
  //So we don't exit until we're done.
end;

How to use this? Let's say you want to start doing work when the user clicks button. You write an OnClick handler:

procedure TMainForm.Button1Click(Sender: TObject);
begin
  TMyWorkerThread.Create(false);
end;

That's it. After the user clicks button, your thread starts and proceeds with doing whatever it is that you wrote in Execute. If the user clicks the button again, another thread will start, and then another - one every click. They will all run in parallel, each doing all what's written in Execute() and then ending.

Let's say you want to check if the work is over. For that, you'll have to store the reference to your thread somewhere:

TMainForm = class(TForm)
{...skipped...}
public
  MyWorkerThread: TThread;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  //This time we make sure only one thread can be started.
  //If one thread have been started already, we don't start another.
  if MyWorkerThread<>nil then
    raise Exception.Create('One thread have already been started!');
  MyWorkerThread := TMyWorkerThread.Create(false);
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
  //If the work is not over yet, we display message informing the user we're still working
  if (MyWorkerThread<>nil) and (WaitForSingleObject(MyWorkerThread.Handle, 0)<>WAIT_OBJECT_0) then
    MessageBox(Self.Handle, pchar("The work is not yet done!"), pchar("Still running"), MB_OK);
end;

As you see, we're checking if a thread is still running by calling a Windows function called WaitForSingleObject. This function waits until the thread is done working, or the timeout is elapsed, and as we specify the timeout of 0, it just exists immediately if the thread is not over yet.