Drawing text as a path. Problem with Bahnschrift fonts

426 views Asked by At

My application allows users to create text objects on a canvas. This object can be saved to a project file to be loaded later.

In order that the objects look the same after loading on various platforms I have implemented the text object as a path. This also allows users to use downloaded fonts and then open the project file on a different device without that font - without the text changing appearance.

The path is created using TTextLayout.ConvertToPath and drawn using TCanvas.FillPath. This works fine for most fonts, but has an issue with some others.

The image below shows the result (top) with the Bahnschrift font. Bottom shows how it should look using MS Paint. This font seems to have intersecting paths and I think the issue is that FillPath is using an alternate fill mode, which doesn't seem to be an option to change.

I have also tested the same font in Inkscape as an SVG by creating the text and converting it to a path, but it's drawn correctly. The path data created by Delphi and Inkscape are essentially the same (the t consists of 2 closed regions that cross each other), so it's the way they're drawn that must be different.

Can anyone suggest a fix for this?

enter image description here

Here's the code

procedure TMainForm.Button1Click(Sender: TObject);
Var
  LPath : TPathData;
  LLayout : TTextLayout;
begin
  LLayout := TTextLayoutManager.DefaultTextLayout.Create;
  LLayout.Text := 'test';
  LLayout.Font.Family := 'Bahnschrift';

  LPath := TPathData.Create;
  LLayout.ConvertToPath(LPath);

  // Draw the path to a bitmap
  SavePathBitmap(LPath, 'Path_test');

  LLayout.Free;
  LPath.Free;
end;

procedure TMainForm.SavePathBitmap(APath : TPathData ; AFileName : String);
var
  bmp : TBitmap;
  rect : TRectF;
begin
  APath.Scale(10, 10); // Enlarge
  rect := APath.GetBounds;
  APath.Translate(-rect.Left + 5, -rect.Top + 5); // offset onto bitmap
  bmp := TBitmap.Create(Trunc(rect.Width)+10, Trunc(rect.Height)+10);
  with bmp.Canvas do if BeginScene then begin
    Clear(TAlphaColorRec.White);
    Fill.Color := TAlphaColorRec.Black;
    FillPath(APath, 1);
    EndScene;
    bmp.SaveToFile(AFileName + '.png');
  end;
  bmp.Free;
end;
0

There are 0 answers