How to anti-alias text (Views: 100)


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?


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);
  LogFont: TLogFont;
  GetObject(Canvas.Font.Handle, SizeOf(LogFont), Addr(LogFont));
  with LogFont do
    lfEscapement := Angle;
    lfOrientation := Angle;
    lfOutPrecision := OUT_TT_ONLY_PRECIS;
  Canvas.Font.Handle := CreateFontIndirect(LogFont);

Solve 2:

Here is another way of doing this:

procedure TForm1.Button1Click(Sender: TObject);
  LogFont: TLogFont;
  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');

Solve 3:

procedure DrawAAText(Dest: TBitmap; DX, DY: Integer; Text: string);
  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);
    R := Color and $FF0000 shr 16;
    G := Color and $00FF00 shr 8;
    B := Color and $0000FF;

  TempBitmap: TBitmap;
  x, y: Integer;
  totr, totg, totb: Integer;
  j, i: Integer;
  Line: pRGBLine;
  TempLine: array[0..1] of pRGBLine;
  {Creates a temporary bitmap do work with supersampling}
  TempBitmap := TBitmap.Create;
  with TempBitmap do
    PixelFormat := pf24bit;
    {Copy attributes from previous bitmap}
    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
      Canvas.Draw(-DX, -DY, Dest);
      Canvas.Stretchdraw(Rect(0, 0, Width * 2, Height * 2), TempBitmap);
    {Draws the text using double size}
    Canvas.TextOut(0, 0, Text);
  {Draws the antialiased image}
  for y := 0 to ((TempBitmap.Height) div 2) - 1 do
    {If the y pixel is outside the clipping region, do the proper action}
    if dy + y < 0 then
    else if Dy + y > Dest.Height - 1 then
    {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
      {If the x pixel is outside the clipping region, do the proper action}
      if dx + x < 0 then
      else if Dx + x > Dest.Width - 1 then
      {Compute the value of the output pixel (x, y) }
      TotR := 0;
      TotG := 0;
      TotB := 0;
      for j := 0 to 1 do
        for i := 0 to 1 do
          with TempLine[j][2 * x + i] do
            inc(TotR, rgbtRed);
            inc(TotG, rgbtGreen);
            inc(TotB, rgbtBlue);
      {Set the pixel values thru scanline}
      with Line[DX + x] do
        rgbtRed := TotR div 4;
        rgbtGreen := TotG div 4;
        rgbtBlue := TotB div 4;
  {Free the temporary bitmap}

<< Back to main page