2011. május 9., hétfő
How to anti-alias text
Problem/Question/Abstract:
Are there any anti-alias effect in the TEXT GDI functions? For example, when I do a TextOut or DrawText, how can I make the text anti-alias?
Answer:
Solve 1:
Yes. The quality is a property of the font. You need to setup the font. Some time ago I was implementing a function to rotate text and you can use the same routine:
procedure SetTextAngle(Canvas: TCanvas; Angle: Integer);
var
LogFont: TLogFont;
begin
GetObject(Canvas.Font.Handle, SizeOf(LogFont), Addr(LogFont));
with LogFont do
begin
lfEscapement := Angle;
lfOrientation := Angle;
lfQuality := ANTIALIASED_QUALITY;
lfOutPrecision := OUT_TT_ONLY_PRECIS;
end;
Canvas.Font.Handle := CreateFontIndirect(LogFont);
end;
Solve 2:
Here is another way of doing this:
procedure TForm1.Button1Click(Sender: TObject);
var
LogFont: TLogFont;
begin
Font.Name := 'Arial'; { make sure it is a true type font }
Font.Size := 48; { sometimes small fonts are not antialiased }
GetObject(Font.Handle, SizeOf(LogFont), @LogFont);
LogFont.lfQuality := ANTIALIASED_QUALITY;
Canvas.Font.Handle := CreateFontIndirect(LogFont);
Repaint; { just to make sure our text is not erased immediately }
Canvas.TextOut(50, 50, 'Antialiased Text');
end;
Solve 3:
procedure DrawAAText(Dest: TBitmap; DX, DY: Integer; Text: string);
type
pRGBLine = ^TRGBLine;
TRGBLine = array[Word] of TRGBTriple;
{Separate R, G and B values from the color}
procedure SeparateColor(Color: TColor; var r: Byte; var g: byte; var b: byte);
begin
R := Color and $FF0000 shr 16;
G := Color and $00FF00 shr 8;
B := Color and $0000FF;
end;
var
TempBitmap: TBitmap;
x, y: Integer;
totr, totg, totb: Integer;
j, i: Integer;
Line: pRGBLine;
TempLine: array[0..1] of pRGBLine;
begin
{Creates a temporary bitmap do work with supersampling}
TempBitmap := TBitmap.Create;
with TempBitmap do
begin
PixelFormat := pf24bit;
{Copy attributes from previous bitmap}
Canvas.Font.Assign(Dest.Canvas.Font);
Canvas.Brush.Assign(Dest.Canvas.Brush);
Canvas.Pen.Assign(Dest.Canvas.Pen);
Canvas.Font.Size := Canvas.Font.Size * 2;
{Make it twice larger to apply supersampling later}
Width := Canvas.TextWidth(Text);
Height := Canvas.TextHeight(Text);
{To prevent unexpected junk}
if (Width div 2) + DX > Dest.Width then
Width := (Dest.Width - DX) * 2;
if (Height div 2) + DY > Dest.Height then
Height := (Dest.Height - DY) * 2;
{If the brush style is clear, then copy the image from the previous
image to create the propher effect}
if Canvas.Brush.Style = bsClear then
begin
Canvas.Draw(-DX, -DY, Dest);
Canvas.Stretchdraw(Rect(0, 0, Width * 2, Height * 2), TempBitmap);
end;
{Draws the text using double size}
Canvas.TextOut(0, 0, Text);
end;
{Draws the antialiased image}
for y := 0 to ((TempBitmap.Height) div 2) - 1 do
begin
{If the y pixel is outside the clipping region, do the proper action}
if dy + y < 0 then
Continue
else if Dy + y > Dest.Height - 1 then
Break;
{Scanline for faster access}
Line := Dest.ScanLine[DY + y];
TempLine[0] := TempBitmap.Scanline[2 * y];
TempLine[1] := TempBitmap.Scanline[(2 * y) + 1];
for x := 0 to ((TempBitmap.Width) div 2) - 1 do
begin
{If the x pixel is outside the clipping region, do the proper action}
if dx + x < 0 then
Continue
else if Dx + x > Dest.Width - 1 then
Break;
{Compute the value of the output pixel (x, y) }
TotR := 0;
TotG := 0;
TotB := 0;
for j := 0 to 1 do
begin
for i := 0 to 1 do
with TempLine[j][2 * x + i] do
begin
inc(TotR, rgbtRed);
inc(TotG, rgbtGreen);
inc(TotB, rgbtBlue);
end;
end;
{Set the pixel values thru scanline}
with Line[DX + x] do
begin
rgbtRed := TotR div 4;
rgbtGreen := TotG div 4;
rgbtBlue := TotB div 4;
end;
end;
end;
{Free the temporary bitmap}
TempBitmap.Free;
end;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése