libTextSuite/ultsFontCreator.pas

unit ultsFontCreator;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  utsTextSuite,
  ultsTypes;

function ltsFontCreatorCreate         (aHandle: TltsContextHandle; aType: TltsFontCreatorType):               TltsFontCreatorHandle; stdcall;
function ltsFontCreatorGetFontByName  (aHandle: TltsFontCreatorHandle; aFontname: PAnsiChar; aSize: Integer;
                                       aStyle: TtsFontStyles; aAntiAliasing: TtsAntiAliasing):                TltsFontHandle;        stdcall;
function ltsFontCreatorGetFontByFile  (aHandle: TltsFontCreatorHandle; aFilename: PAnsiChar; aSize: Integer;
                                       aStyle: TtsFontStyles; aAntiAliasing: TtsAntiAliasing):                TltsFontHandle;        stdcall;
function ltsFontCreatorGetFontByStream(aHandle: TltsFontCreatorHandle; aStream: PltsStream; aSize: Integer;
                                       aStyle: TtsFontStyles; aAntiAliasing: TtsAntiAliasing):                TltsFontHandle;        stdcall;
function ltsFontCreatorDestroy        (aHandle: TltsFontCreatorHandle):                                       TltsErrorCode;         stdcall;

implementation

uses
  utsUtils,
  ultsUtils;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TltsFontCreatorFreeType = class(TtsFontCreatorFreeType)
  public
    procedure DelSlave(const aSlave: TtsRefManager); override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TltsFontCreatorGDI = class(TtsFontCreatorGDI)
  public
    procedure DelSlave(const aSlave: TtsRefManager); override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TltsFontCreatorFreeType///////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TltsFontCreatorFreeType.DelSlave(const aSlave: TtsRefManager);
begin
  DelReference(aSlave);
  inherited DelSlave(aSlave);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TltsFontCreatorGDI////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TltsFontCreatorGDI.DelSlave(const aSlave: TtsRefManager);
begin
  DelReference(aSlave);
  inherited DelSlave(aSlave);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//FontCreato///////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontCreatorCreate(aHandle: TltsContextHandle; aType: TltsFontCreatorType): TltsFontCreatorHandle; stdcall;
var
  c: TtsContext;
  fc: TtsFontCreator;
begin
  try
    result := nil;
    if not CheckContextHandle(aHandle, c) then
      exit;

    case aType of
      ltsFontCreatorFreeType:   fc := TltsFontCreatorFreeType.Create(c);
      ltsFontCreatorGDI:        fc := TltsFontCreatorGDI.Create(c);
      // TODO ltsRendererCustom:    r := TltsRendererCustom.Create(c, aFormat);
    else
      SetLastError(ltsErrInvalidEnum, Format('%d is not a valid font creator type', [aType]));
      exit;
    end;
    AddReference(ltsObjTypeFontCreator, fc);
    result := fc;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontCreatorGetFontByName(aHandle: TltsFontCreatorHandle; aFontname: PAnsiChar;
  aSize: Integer; aStyle: TtsFontStyles; aAntiAliasing: TtsAntiAliasing): TltsFontHandle; stdcall;
var
  fc: TtsFontCreator;
  f: TtsFont;
begin
  try
    result := nil;
    if not CheckFontCreatorHandle(aHandle, fc) then
      exit;
    f := fc.GetFontByName(aFontname, aSize, aStyle, aAntiAliasing);
    if not Assigned(f) then begin
      SetLastError(ltsErrInvalidOperation, 'GetFontByName is not supported by this font creator');
      exit;
    end;
    AddReference(ltsObjTypeFont, f);
    result := f;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontCreatorGetFontByFile(aHandle: TltsFontCreatorHandle; aFilename: PAnsiChar;
  aSize: Integer; aStyle: TtsFontStyles; aAntiAliasing: TtsAntiAliasing): TltsFontHandle; stdcall;
var
  fc: TtsFontCreator;
  f: TtsFont;
begin
  try
    result := nil;
    if not CheckFontCreatorHandle(aHandle, fc) then
      exit;
    f := fc.GetFontByFile(aFilename, aSize, aStyle, aAntiAliasing);
    if not Assigned(f) then begin
      SetLastError(ltsErrInvalidOperation, 'GetFontByFile is not supported by this font creator');
      exit;
    end;
    AddReference(ltsObjTypeFont, f);
    result := f;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontCreatorGetFontByStream(aHandle: TltsFontCreatorHandle; aStream: PltsStream;
  aSize: Integer; aStyle: TtsFontStyles; aAntiAliasing: TtsAntiAliasing): TltsFontHandle; stdcall;
var
  fc: TtsFontCreator;
  f: TtsFont;
  s: TStream;
begin
  try
    result := nil;
    if not CheckFontCreatorHandle(aHandle, fc) then
      exit;

    s := TltsStreamImpl.Create(aStream);
    try
      f := fc.GetFontByStream(s, aSize, aStyle, aAntiAliasing);
    finally
      FreeAndNil(s);
    end;

    if not Assigned(f) then begin
      SetLastError(ltsErrInvalidOperation, 'GetFontByStream is not supported by this font creator');
      exit;
    end;
    AddReference(ltsObjTypeFont, f);
    result := f;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontCreatorDestroy(aHandle: TltsFontCreatorHandle): TltsErrorCode; stdcall;
var
  fc: TtsFontCreator;
begin
  try
    result := ltsErrNone;
    if CheckFontCreatorHandle(aHandle, fc) then begin
      DelReference(ltsObjTypeFontCreator, fc);
      FreeAndNil(fc);
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

end.