Font engine > Custom HTML canvas example

Example of HTML canvas which use library font class for text measurement and rendering (only API used from DX is FillGeomatry).

type
  THtFontOTF = class(THtFont)
  private
    procedure FreePathCache;
  protected
    procedure GetMetrics;
  public
    Font: TOTFFont;
    PathCache: array of THtPath;
    constructor Create(const AOwner: THtFontCollection; const AFamily: string; const AHeight: single; AStyle: THtFontStyles); override;
  end;

  THtCanvasOTF = class(THtCanvasDX)
  public
    class function FontClass: THtFontClass; override;
    class function MeasureString(const s: string; const AFont: THtFont; const TextStyle: THtTextStyle;
      const Scale: single = 0; AFirstChar: integer = 1; ALength: integer = -1): single; override;
    procedure DrawString(const s: string; const R: TRectF; {$IFDEF AUTOREFCOUNT}[unsafe]{$ENDIF} const Font: THtFont;
      const TextStyle: THtTextStyle;  AFirstChar: integer = 1; ALength: integer = -1); override;
    class function GetFlags: THtCanvasFlags; override;
  end;

constructor THtFontOTF.Create(const AOwner: THtFontCollection;
  const AFamily: string; const AHeight: single; AStyle: THtFontStyles);
begin
  inherited;
  GetMetrics;
end;

procedure THtFontOTF.GetMetrics;
var B: VCL.Graphics.TBitmap;
    T: TBytes;
    n: integer;
    ST: TBytesStream;
begin
  B := VCL.Graphics.TBitmap.Create;
  try
    B.Width := 1;
    B.Height := 1;
    FreeandNil(Font);
    B.Canvas.Font.Name := Family;
    if hfsItalic in Style then
      B.Canvas.Font.Style := B.Canvas.Font.Style + [fsItalic];
    if hfsBold in Style then
      B.Canvas.Font.Style := B.Canvas.Font.Style + [fsBold];
    B.Canvas.Font.Size := 10;
    n := GetFontData(B.Canvas.Handle, 0, 0, nil, 0);
    if n = -1 then
      RaiseLastOsError;
    SetLength(T, n);
    n := GetFontData(B.Canvas.Handle, 0, 0, pointer(T), n);
    ST := TBytesStream.Create(T);
    try
      Font := TOTFFont.Create;
      Font.LoadfromStream(ST);
    finally
      ST.Free
    end;
    Self.MinCharWidth := Font.MeasureString('i', Height);
    Self.Ascent := Font.Ascent(Height);
    Self.Descent := Font.Descent(Height);
    Self.LineHeight := Self.Ascent + Self.Descent;
    Self.SpaceWidth := Font.MeasureString(' ', Height);
    FreePathCache;
    SetLength(PathCache, Font.GlyphTable.Count);
    FillChar(pointer(PathCache)^, Length(PathCache) * sizeof(THtPath), 0);
  finally
    B.Free
  end;
end;

procedure THtFontOTF.FreePathCache;
var i: integer;
begin
  for i := 0 to High(PathCache) do
    if PathCache[i] <> nil then
      PathCache[i].Free;
  SetLength(PathCache, 0);
end;

procedure THtCanvasOTF.DrawString(const s: string; const R: TRectF;
  const Font: THtFont; const TextStyle: THtTextStyle; AFirstChar,
  ALength: integer);
var L: THtLayout;
    Scale: single;
    X, W: single;
    i, Offs: integer;
    B: THtBrush;
    F: THtFontOTF;
    M: THtMatrixData;
begin
  if ALength < 0 then
    ALength := Length(s);
  F := THtFontOTF(Font);
  F.Font.CreateLayout(copy(s, AFirstChar, ALength), Font.Height, L);
  F.Font.PrepareLayout(L);
  SaveState;
  M.Init(1, 0, 0, 1, R.Left, R.Top + round(F.Font.Ascent(F.Height) - F.Font.Ascent(F.Height)));
  FCurrentMatrix.Multiply(M);
  FContext.SetTransform(TD2D_MATRIX_3X2_F(FCurrentMatrix.Data));
  B := GetBrush(TextStyle.Color);
  Scale := Font.Height / F.Font.FontHeader.Header.UnitsPerEM;
  for i := 0 to High(L.Glyphs) do
  begin
    if F.PathCache[L.Glyphs[i].GID] = nil then
    begin
      F.PathCache[L.Glyphs[i].GID] := PathClass.Create;
      F.Font.GlyphTable.Glyphs[L.Glyphs[i].GID].AsPath(
       F.Font.GlyphTable, 0, 0, F.PathCache[L.Glyphs[i].GID], Scale);
    end;
  end;

  W := L.Width;
  if L.RTL then
  begin
    M.Init(1, 0, 0, 1, W, 0);
    FCurrentMatrix.Multiply(M);
    for i := 0 to High(L.Glyphs) do
    begin
      Offs := L.Glyphs[i].DX + L.Glyphs[i].Width;
      M.Init(1, 0, 0, 1, -Offs * Scale, 0);
      FCurrentMatrix.Multiply(M);
      FContext.SetTransform(TD2D_MATRIX_3X2_F(FCurrentMatrix.Data));
      FillPath(B, F.PathCache[L.Glyphs[i].GID]);
    end;
  end else
  begin
    for i := 0 to High(L.Glyphs) do
    begin
      Offs := L.Glyphs[i].DX;
      if i > 0 then
        Offs := Offs + L.Glyphs[i-1].Width;
      M.Init(1, 0, 0, 1, Offs * Scale, 0);
      FCurrentMatrix.Multiply(M);
      FContext.SetTransform(TD2D_MATRIX_3X2_F(FCurrentMatrix.Data));
      FillPath(B, F.PathCache[L.Glyphs[i].GID]);
      end;
  end;
  RestoreState;
  if hfsUnderline in F.Style then
    DrawLine(P, R.Left, R.Top + F.Font.Underline(F.Height), R.Right, R.Top + F.Font.Underline(F.Height));
end;

class function THtCanvasOTF.FontClass: THtFontClass;
begin
  Result := THtFontOTF;
end;

class function THtCanvasOTF.MeasureString(const s: string; const AFont: THtFont;
  const TextStyle: THtTextStyle; const Scale: single; AFirstChar,
  ALength: integer): single;
begin
  if ALength < 0 then
    ALength := Length(s);
  Result := THtFontOTF(AFont).Font.MeasureString(copy(s, AFirstChar, ALength), AFont.Height);
end;

class function THtCanvasOTF.GetFlags: THtCanvasFlags;
begin
  Result := [hcfScaleCanvasDrawing, hcfCacheTextWidth, hcfSupportsSimpleLayouts, hcfFullRepaint];
end;