Title: Draw Text Antialiased (Revised)
Question: This routine will draw a text antialiased on a canvas of a bitmap.
Antialiased text is prettier than plain text.
Answer:
This object will antialiase text written on a bitmap using scanline.
The way the object works:
- Destination bitmap is copied and doubled in size.
- The text is written on the doubled bitmap
in a font twice the size of the original font.
- The whole bitmap is shrinked in half,
and the image is antialiased in the process.
With this approach the antialiasing routine aliases all edges of the font compared to the bitmap surrounding it.
Everything is converted into 24 bit colors and is drawn with Scanline, which is approximately 5 times faster than using Pixel[].
Remember to set the font property of the destination bitmap to the font type you wish to antialiase. The font will be printed with transparent background.
unit aliasing;
{ -------------------------------------------------------------------------- }
interface
{ -------------------------------------------------------------------------- }
uses
graphics, windows, classes, sysutils;
const
PIXELCOUNTMAX = 32768;
type
pRGBArray = ^TRGBArray;
TRGBArray = array[0..PIXELCOUNTMAX] of TRGBTriple;
TAliasing = class
private
procedure CopyBitmap( ASrc : graphics.TBitmap;
ADest : graphics.TBitmap );
public
constructor Create;
procedure AAliasText( ADest : graphics.TBitmap;
AX, AY : integer; AText : string );
end;
{ -------------------------------------------------------------------------- }
implementation
{ -------------------------------------------------------------------------- }
constructor TAliasing.Create;
begin
inherited Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAliasing.CopyBitmap( ASrc : graphics.TBitmap;
ADest : graphics.TBitmap );
var
SrcRect : TRect;
DestRect : TRect;
begin
SrcRect := Bounds( 0,0, ASrc.Width, ASrc.Height );
DestRect := Bounds( 0,0, ADest.Width, ADest.Height );
ADest.Canvas.CopyRect( DestRect, ASrc.Canvas, SrcRect );
end;
{ -------------------------------------------------------------------------- }
procedure TAliasing.AAliasText( ADest : graphics.TBitmap;
AX, AY : integer; AText : string );
var
x, y, i, j : integer;
totr, totg, totb : Integer;
BigBitmap : graphics.TBitmap;
DestScan : pRGBArray;
BigScan : pRGBArray;
begin
BigBitmap := graphics.TBitmap.Create;
try
BigBitmap.PixelFormat := pf24bit;
ADest.PixelFormat := pf24bit;
BigBitmap.Width := ADest.Width * 2;
BigBitmap.Height := ADest.Height * 2;
CopyBitmap( ADest, BigBitmap );
BigBitmap.Canvas.Font := ADest.Canvas.Font;
BigBitmap.Canvas.Font.Size := 2 * ADest.Canvas.Font.Size;
BigBitmap.Canvas.Brush.Style := bsClear;
BigBitmap.Canvas.TextOut( AX, AY, AText );
// The "- 3" keeps us from falling off the edge
// of BigBox. Over the edge the Pixel value returns
// -1 and messes up the colors.
for y := 0 to (BigBitmap.Height - 3) Div 2 do
begin
DestScan := pRGBArray( ADest.ScanLine[y] );
for x := 0 to (BigBitmap.Width - 3) Div 2 do
begin
// Compute the value of output pixel (x, y).
totr := 0;
totg := 0;
totb := 0;
for j := 0 to 1 do
begin
BigScan := pRGBArray( BigBitmap.ScanLine[2*y+j] );
for i := 0 to 1 do
begin
totr := totr + BigScan[2*x+i].rgbtRed;
totg := totg + BigScan[2*x+i].rgbtGreen;
totb := totb + BigScan[2*x+i].rgbtBlue;
end;
end;
DestScan[x].rgbtBlue := totb shr 2;
DestScan[x].rgbtGreen := totg shr 2;
DestScan[x].rgbtRed := totr shr 2;
end;
end;
finally
BigBitmap.Free;
end;
end;
end.