Text Layout class doesn't work with printer

Question

I'm using Delphi 11, Firemonkey. I tried to do some printing (text, shapes, bitmaps) using only TPrinter.Canvas methods. Everything worked fine.

But there is also this thing called TTextLayout, which is very useful for formatting text. However, when I tried printing using this class, I couldn't see any text. On the other hand, drawing onto regular canvases, like TPaintBox.Canvas or TBitmap.Canvas using TTextLayout works fine.

---

This is my code (TButton (×3), TPaintBox, TPrintDialog, TSaveDialog):

uses
  FMX.TextLayout;

procedure TForm1.Button1Click(Sender: TObject);
begin
  PaintBox1.Repaint;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DoPrint;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  DrawToFile;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
begin
  DrawSomething(Canvas);
end;

procedure TForm1.DoPrint;
begin
  if PrintDialog1.Execute then begin
    Printer.ActivePrinter.SelectDPI(1200, 1200);
    Printer.Orientation := TPrinterOrientation.poLandscape;
    Printer.BeginDoc;
    try
      if Printer.Canvas.BeginScene() then try
        DrawSomething(Printer.Canvas);
      finally
        Printer.Canvas.EndScene;
      end;
    finally
      Printer.EndDoc;
    end;
  end;
end;

procedure TForm1.DrawToFile;
var
  Bmp: TBitmap;
begin
  if SaveDialog1.Execute then begin
    Bmp := TBitmap.Create(300, 300);
    try
      Bmp.Clear(TAlphaColors.White);
      if Bmp.Canvas.BeginScene() then try
        DrawSomething(Bmp.Canvas);
      finally
        Bmp.Canvas.EndScene;
      end;
      Bmp.SaveToFile(SaveDialog1.FileName);
    finally
      Bmp.Free;
    end;
  end;
end;

procedure TForm1.DrawSomething(Canvas: TCanvas);
var
  tl: TTextLayout;
  BoldFont: TFont;
  StrokeBrush: TStrokeBrush;
begin
  tl := nil;
  BoldFont := nil;
  StrokeBrush := nil;
  try
    tl := TTextLayoutManager.DefaultTextLayout.Create();
    BoldFont := TFont.Create;
    StrokeBrush := TStrokeBrush.Create(TBrushKind.Solid, TAlphaColors.Blue);

    BoldFont.SetSettings('Arial', 96, TFontStyleExt.Create([TFontStyle.fsBold]));

    StrokeBrush.Thickness := 10.0;

    tl.BeginUpdate;
    try
      tl.TopLeft := TPointF.Create(0,0);
      tl.MaxSize := TPointF.Create(300, 300);
      tl.Text := 'Lorem'#$0A'ipsum';
      tl.WordWrap := True;
      tl.HorizontalAlign := TTextAlign.Leading;
      tl.VerticalAlign := TTextAlign.Leading;
      tl.Color := TAlphaColors.Black;
      tl.Font.SetSettings('Arial', 96, TFontStyleExt.Create([]));
      tl.Opacity := 1.0;
      tl.AddAttribute(TTextRange.Create(3, 5), TTextAttribute.Create(BoldFont, TAlphaColors.Black));
    finally
      tl.EndUpdate;
    end;
    tl.RenderLayout(Canvas);
    Canvas.DrawLine(TPointF.Create(10, 20), TPointF.Create(110, 120), 1.0, StrokeBrush);
  finally
    StrokeBrush.Free;
    BoldFont.Free;
    tl.Free;
  end;
end;

Button1 repaints TPaintBox, Button2 prints, Button3 creates an image file. Here are my results:

Application: Application screenshot

Microsoft Print to PDF (got the same result from an actual printer): PDF screenshot

Image file: Image file

As you can see, both TControl.Canvas and TBitmap.Canvas have no problem with rendering the text layout. Only the printer's canvas doesn't show the text. Am I doing something wrong?

Answer 1

It's not working because TTextLayout.RenderLayout(Canvas) calls TTextLayoutD2D.DoDrawLayout which expects a TCanvasD2D canvas, which presumably the printer canvas is not:

  if (ACanvas = nil) or not (ACanvas is TCanvasD2D) or Text.IsEmpty or (FLayout = nil) then
    Exit;

This might warrant a bug report with Embarcadero, but in the meantime, one way around this is to draw the text to a TBitMap (as you already do with Button3), and draw that bitmap to the printer canvas:

procedure TForm1.DoPrint;
var Bmp: TBitmap;
begin
  if PrintDialog1.Execute then begin
    Bmp:=TBitmap.Create(300,300);
    try
      Bmp.Clear(TAlphaColors.White);
      if Bmp.Canvas.BeginScene() then try
    DrawSomething(Bmp.Canvas);
      finally
    Bmp.Canvas.EndScene;
      end;
    finally
      Printer.ActivePrinter.SelectDPI(1200, 1200);
      Printer.Orientation := TPrinterOrientation.poLandscape;
      Printer.BeginDoc;
      try
        if Printer.Canvas.BeginScene() then try
          Printer.Canvas.DrawBitmap(Bmp,Bmp.Bounds,Bmp.Bounds,1)
        finally
          Printer.Canvas.EndScene;
        end;
      finally
        Printer.EndDoc;
      end;
      Bmp.Free;
    end;
  end;
end;

NB: Not being a regular user of try...finally, I don't know if I have the best arrangement of those.