Simple anti-aliasing function for Delphi 7
You can try TAgg2D. It is a simplified API for 2D drawing over AggPas. So you can use simple functions like:
- Line (x1, y1, x2, y2 )
- Rectangle (x1, y1, x2, y2 )
- RoundedRect (x1, y1, x2, y2, r )
Easy!
I believe GDI+ does anti-aliased drawing (by default), I don't know if recent Delphi versions have a GdiPlus.pas, but there are copies available online.
Give a try to Anti-Grain Geometry library
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;
(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).
(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).