libTextSuite/ultsFont.pas

unit ultsFont;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  utsTextSuite,
  ultsTypes;

function ltsFontGetPostProcessor        (aHandle: TltsFontHandle):                                  TltsPostProcessorHandle;  stdcall;
function ltsFontGetTabWidth             (aHandle: TltsFontHandle; out aValue: Integer):             TltsErrorCode;            stdcall;
function ltsFontGetCharSpacing          (aHandle: TltsFontHandle; out aValue: Integer):             TltsErrorCode;            stdcall;
function ltsFontGetLineSpacing          (aHandle: TltsFontHandle; out aValue: Single):              TltsErrorCode;            stdcall;
function ltsFontGetMetric               (aHandle: TltsFontHandle; out aValue: TtsFontMetric):       TltsErrorCode;            stdcall;

function ltsFontGetFontname             (aHandle: TltsFontHandle):                                  PAnsiChar;                stdcall;
function ltsFontGetFacename             (aHandle: TltsFontHandle):                                  PAnsiChar;                stdcall;
function ltsFontGetStylename            (aHandle: TltsFontHandle):                                  PAnsiChar;                stdcall;
function ltsFontGetFullname             (aHandle: TltsFontHandle):                                  PAnsiChar;                stdcall;
function ltsFontGetCopyright            (aHandle: TltsFontHandle):                                  PAnsiChar;                stdcall;

function ltsFontSetPostProcessor        (aHandle: TltsFontHandle; aValue: TltsPostProcessorHandle): TltsErrorCode;            stdcall;
function ltsFontSetTabWidth             (aHandle: TltsFontHandle; aValue: Integer):                 TltsErrorCode;            stdcall;
function ltsFontSetCharSpacing          (aHandle: TltsFontHandle; aValue: Integer):                 TltsErrorCode;            stdcall;
function ltsFontSetLineSpacing          (aHandle: TltsFontHandle; aValue: Single):                  TltsErrorCode;            stdcall;

function ltsFontDestroy                 (aHandle: TltsFontHandle):                                  TltsErrorCode;            stdcall;

implementation

uses
  ultsUtils;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Font//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontGetPostProcessor(aHandle: TltsFontHandle): TltsPostProcessorHandle; stdcall;
var
  f: TtsFont;
begin
  try
    if CheckFontHandle(aHandle, f)
      then result := f.PostProcessor
      else result := nil;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontGetTabWidth(aHandle: TltsFontHandle; out aValue: Integer): TltsErrorCode; stdcall;
var
  f: TtsFont;
begin
  try
    result := ltsErrNone;
    if CheckFontHandle(aHandle, f)
      then aValue := f.TabWidth
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontGetCharSpacing(aHandle: TltsFontHandle; out aValue: Integer): TltsErrorCode; stdcall;
var
  f: TtsFont;
begin
  try
    result := ltsErrNone;
    if CheckFontHandle(aHandle, f)
      then aValue := f.CharSpacing
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontGetLineSpacing(aHandle: TltsFontHandle; out aValue: Single): TltsErrorCode; stdcall;
var
  f: TtsFont;
begin
  try
    result := ltsErrNone;
    if CheckFontHandle(aHandle, f)
      then aValue := f.LineSpacing
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontGetMetric(aHandle: TltsFontHandle; out aValue: TtsFontMetric): TltsErrorCode; stdcall;
var
  f: TtsFont;
begin
  try
    result := ltsErrNone;
    if CheckFontHandle(aHandle, f)
      then aValue := f.Metric
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontGetFontname(aHandle: TltsFontHandle): PAnsiChar; stdcall;
var
  f: TtsFont;
begin
  try
    if CheckFontHandle(aHandle, f)
      then result := PAnsiChar(f.Names.Fontname)
      else result := nil;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontGetFacename(aHandle: TltsFontHandle): PAnsiChar; stdcall;
var
  f: TtsFont;
begin
  try
    if CheckFontHandle(aHandle, f)
      then result := PAnsiChar(f.Names.FaceName)
      else result := nil;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontGetStylename(aHandle: TltsFontHandle): PAnsiChar; stdcall;
var
  f: TtsFont;
begin
  try
    if CheckFontHandle(aHandle, f)
      then result := PAnsiChar(f.Names.StyleName)
      else result := nil;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontGetFullname(aHandle: TltsFontHandle): PAnsiChar; stdcall;
var
  f: TtsFont;
begin
  try
    if CheckFontHandle(aHandle, f)
      then result := PAnsiChar(f.Names.FullName)
      else result := nil;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontGetCopyright(aHandle: TltsFontHandle): PAnsiChar; stdcall;
var
  f: TtsFont;
begin
  try
    if CheckFontHandle(aHandle, f)
      then result := PAnsiChar(f.Names.Copyright)
      else result := nil;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontSetPostProcessor(aHandle: TltsFontHandle; aValue: TltsPostProcessorHandle): TltsErrorCode; stdcall;
var
  f: TtsFont;
  p: TtsPostProcessor;
begin
  try
    result := ltsErrNone;
    if CheckFontHandle(aHandle, f) and CheckPostProcessorHandle(aValue, TtsPostProcessor, p)
      then f.PostProcessor := p
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontSetTabWidth(aHandle: TltsFontHandle; aValue: Integer): TltsErrorCode; stdcall;
var
  f: TtsFont;
begin
  try
    result := ltsErrNone;
    if CheckFontHandle(aHandle, f)
      then f.TabWidth := aValue
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontSetCharSpacing(aHandle: TltsFontHandle; aValue: Integer): TltsErrorCode; stdcall;
var
  f: TtsFont;
begin
  try
    result := ltsErrNone;
    if CheckFontHandle(aHandle, f)
      then f.CharSpacing := aValue
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontSetLineSpacing(aHandle: TltsFontHandle; aValue: Single): TltsErrorCode; stdcall;
var
  f: TtsFont;
begin
  try
    result := ltsErrNone;
    if CheckFontHandle(aHandle, f)
      then f.LineSpacing := aValue
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontDestroy(aHandle: TltsFontHandle): TltsErrorCode; stdcall;
var
  f: TtsFont;
begin
  try
    result := ltsErrNone;
    if CheckFontHandle(aHandle, f) then begin
      DelReference(ltsObjTypeFont, f);
      FreeAndNil(f);
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

end.