Can I generate an anti-aliased font size larger than 149?

Question

I have noticed, in Delphi XE6 (and in other tools/languages that produce applications that run on Windows, and use native GDI font rendering) that the Win32 TextOut API does not seem to smooth any font larger than 149, that is, the Font.Size>149. Here is a screenshot showing two SpeedButtons, both with Font.Quality set to fqClearType, the one on the left Font.Size is set to 149, the one on the right is set with Font.Size is 150. That's one point difference. The height values are -199 and -200 respectively. This is simply to demonstrate with a Delphi component and form, what could also be demonstrated in a TPaintBox, with use of a Canvas.Font and a call to Win32 API DrawText, or with a pure Win32 API application that creates a window, and draws to a device context using DrawText.

The limitation of GDI is shown clearly here; Note that ClearType looks mediocre (horizontal anti-aliasing but no vertical) at size=149 , and ClearType turns off completely at 150:

My question is, is there any way to circumvent this limitation in the Win32 API GDI, using some raw Win32 function available on Windows 7 and up, to draw the text and always anti-alias? I assume here that logical font handling is being done properly, inside the VCL, because the same limit occurs in a C# application (using WinForms, which runs atop GDI) as I see when I try this in Delphi.

I would like to draw an anti-aliased character with a font size greater than 149, to a GDI canvas, either with Clear Type or with classic Anti-Aliasing. How would I do that?

Note that I have already set Font.Quality explicitly to both AntiAliased and ClearType modes, and that Win32 GDI api calls ignore these logical font properties about a certain size, apparently by design. Certain applications like Microsoft Word, however clearly have font-rendering capability to draw a 155 point font or larger, and still anti-alias in this case.

Update: I answered my own question showing how easy DirectWrite+GDI interop is. On windows 7 and windows 8, and later, DirectWrite actually provides both horizontal and vertical anti-aliasing, and I believe this is high quality on-screen font rendering mode is what apps like MS Word 2013 are using. I believe that someone could easily answer my question showing a GDI+ sample, and that would also fit my requirements above (as GDI+ is included in Windows 7 and 8).

Answer 1

A working approach that I have found that interoperates with GDI better than GDI+ does is to use DirectWrite, BUT THIS WORKS ONLY in Windows 7 and 8, and the sample code I present here has a simple GDI fallback mode (plain GDI, no anti-aliasing) that covers XP and Vista, to provide at least a graceful degradation; it still paints text on pre-Win7 operating systems, using GDI.

The original demo app is here, but it was using TForm which I changed to TWinControl, and it had no GDI fallback, just an exception.

http://cc.embarcadero.com/item/27491

The discussion/blog post by Pawel Glowacki who wrote the above demo is here:

http://blogs.embarcadero.com/pawelglowacki/2009/12/14/38872

A code snippet including a modified D2DUtils.pas from Pawel's demo with addition of a GDI fall-back feature (instead of blowing up with an exception) is shown here.

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  Winapi.D2D1,
  Vcl.Direct2D;


type
   TCanvasD2D = class(TWinControl) // a base class, using TWinControl instead of TForm.
   private
      FInitFlag: Boolean;
      FGDIMode: Boolean; { Fallback }
      FD2DCanvas: TDirect2DCanvas; { Used When D2D is available and GDIMode=False }
      FGDICanvas: TCanvas; { Fallback canvas, used when FGDIMode=True }
      procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
   protected
      procedure Resize; override;

      procedure DoPaint(AHDC: HDC); virtual;

      procedure CreateD2DResources; virtual;

      procedure PaintD2D; virtual;
      procedure PaintGDI; virtual;

      function RenderTarget: ID2D1RenderTarget; // convenience function used during D2D Paints.

      procedure PaintWindow(DC: HDC); override;

   public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;

      procedure Init;
      property D2DCanvas: TDirect2DCanvas read FD2DCanvas;
      property GDICanvas: TCanvas read FGDICanvas;

      property GDIMode: Boolean read FGDIMode write FGDIMode;
      { Set to true to force GDI fallback, will automatically set true if D2D is not available, also }
   end;


TCanvasD2DSample = class(TCanvasD2D) // subclass of TCanvasD2D that is a primitive "TLabel"
    private
    FFontBrush: ID2D1SolidColorBrush;// Brush generated from current value of FFontColor
    FBackgroundColor:TColor; // clWhite
    FFontColor:TColor; //clBlack;
    FTextFormat: IDWriteTextFormat;
    FFontName: string;
    FFontSize: Integer;  { Units?}
    FDisplayText: String;
    FLocale: String;


    procedure SetFontName(const Value: String);
    procedure SetFontSize(const Value: Integer);
    procedure SetDisplayText(const Value: String);

  protected
    procedure PaintD2D; override;
    procedure PaintGDI; override;
    procedure CreateD2DResources; override;

    function FontSizeToDip(FontSize:Integer ):Double;

  public
    constructor Create(AOwner: TComponent); override;

    property TextFormat:IDWriteTextFormat read FTextFormat;
    property FontSize:Integer read FFontSize write SetFontSize;
    property FontName:String read FFontName write SetFontName;
    property DisplayText: String read FDisplayText write SetDisplayText;

    property BackgroundColor:TColor read FBackgroundColor write FBackgroundColor;
    property FontColor:TColor read FFontColor write FFontColor; //clBlack;


    property Locale: String read FLocale write FLocale; // string like 'en-us'

  end;

implementation

constructor TCanvasD2D.Create(AOwner: TComponent);
begin
   inherited;

end;

destructor TCanvasD2D.Destroy;
begin
   FD2DCanvas.Free;
   FD2DCanvas := nil;
   FGDICanvas.Free;
   FGDICanvas := nil;

   inherited;
end;

procedure TCanvasD2D.Init;
begin
   if not FInitFlag then
   begin
      FInitFlag := True;

      if (not FGDIMode) and (TDirect2DCanvas.Supported) then
      begin
         if Assigned(FD2DCanvas) then
            FD2DCanvas.Free;
         FD2DCanvas := TDirect2DCanvas.Create(Handle);
         CreateD2DResources;
      end
      else
      begin
         FGDIMode := True;
         if Assigned(FGDICanvas) then
            FGDICanvas.Free;
         FGDICanvas := TCanvas.Create;
         FGDICanvas.Handle := GetDC(Self.Handle);
      end;
   end;
end;

procedure TCanvasD2D.CreateD2DResources;
begin
   // create Direct2D resources in descendant class
end;

function TCanvasD2D.RenderTarget: ID2D1RenderTarget;
begin
   Result := D2DCanvas.RenderTarget;
end;

procedure TCanvasD2D.Resize;
var
   HwndTarget: ID2D1HwndRenderTarget;
   ASize: TD2D1SizeU;
begin
   inherited;

   if Assigned(D2DCanvas) then
      if Supports(RenderTarget, ID2D1HwndRenderTarget, HwndTarget) then
      begin
         ASize := D2D1SizeU(ClientWidth, ClientHeight);
         HwndTarget.Resize(ASize);
      end;

   Invalidate;
end;

procedure TCanvasD2D.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
   if (not FGDIMode) then
      // avoid flicker as described here:
      // http://chrisbensen.blogspot.com/2009/09/touch-demo-part-i.html
      Message.Result := 1
   else
      inherited;
end;

procedure TCanvasD2D.DoPaint(AHDC: HDC);
begin
   Init;
   if FGDIMode then
   begin
      FGDICanvas.Handle := AHDC;
      PaintGDI;
   end
   else
   begin
      D2DCanvas.BeginDraw;
      try
         PaintD2D;
      finally
         D2DCanvas.EndDraw;
      end;
   end;
end;

procedure TCanvasD2D.PaintD2D;
begin
   // implement painting code in descendant class
end;

procedure TCanvasD2D.PaintGDI;
begin
   // implement in descendant.
end;

procedure TCanvasD2D.PaintWindow(DC: HDC);
begin
   DoPaint(DC);
   inherited;

end;




{ Custom Control Subclass }
procedure TCanvasD2DSample.CreateD2DResources;

begin
  inherited;

  D2DCanvas.RenderTarget.CreateSolidColorBrush(
    D2D1ColorF(FFontColor, 1),
    nil,
    FFontBrush
    );

  DWriteFactory.CreateTextFormat(
    PWideChar(FontName),
    nil,
    DWRITE_FONT_WEIGHT_REGULAR,
    DWRITE_FONT_STYLE_NORMAL,
    DWRITE_FONT_STRETCH_NORMAL,
    FontSizeToDip( FontSize),
    PWideChar(FLocale),
    FTextFormat
   );

   FTextFormat.SetTextAlignment(DWRITE_TEXT_ALIGNMENT_CENTER);
   FTextFormat.SetParagraphAlignment(DWRITE_PARAGRAPH_ALIGNMENT_CENTER);
end;



function TCanvasD2DSample.FontSizeToDip(FontSize: Integer): Double;
begin
   result := FontSize * (96.0 / 72.0); { TODO: 96.0 should not be hard coded? }
end;

procedure TCanvasD2DSample.PaintD2D;
var
  aRect: TD2D1RectF;
//  ASize:D2D_SIZE_F;
begin

  // fill with white color the whole window
  RenderTarget.Clear(D2D1ColorF(FBackgroundColor));



  RenderTarget.DrawText(
    PWideChar(FDisplayText),
    Length(FDisplayText),
    FTextFormat,
    D2D1RectF(0, 0, ClientWidth, ClientHeight),
    FFontBrush
    );

  //  RenderTarget.GetSize(ASize);
end;

procedure TCanvasD2DSample.PaintGDI;
begin
  { FALLBACK PAINT MODE}
  GDICanvas.Lock;
  GDICanvas.Font.Name := FFontName;
  GDICanvas.Font.Size := FFontSize;
  GDICanvas.Font.Color := FFontColor;
  GDICanvas.Brush.Style := bsSolid;
  GDICanvas.Brush.Color := FBackgroundColor;
  GDICanvas.Rectangle(Self.ClientRect);


  GDICanvas.TextOut(0,0, FDisplayText);
GDICanvas.Unlock;
end;

procedure TCanvasD2DSample.SetDisplayText(const Value: String);
begin
   if Value<>FDisplayText then
   begin
    FDisplayText := Value;
    Invalidate;
   end;
end;

procedure TCanvasD2DSample.SetFontName(const Value: String);
begin
  FFontName := Value;
end;

procedure TCanvasD2DSample.SetFontSize(const Value: Integer);
begin
  FFontSize := Value;
end;