libTextSuite/ultsFont.pas

unit ultsFont;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  utsTextSuite,
  ultsTypes;

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

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

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

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

implementation

uses
  ultsUtils;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Font//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontGetPostProcessor(const 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(const aHandle: TltsFontHandle; var 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(const aHandle: TltsFontHandle; var 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(const aHandle: TltsFontHandle; var 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(const aHandle: TltsFontHandle; var 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(const 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(const 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(const 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(const 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(const 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(const aHandle: TltsFontHandle; const 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(const aHandle: TltsFontHandle; const 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(const aHandle: TltsFontHandle; const 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(const aHandle: TltsFontHandle; const 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(const 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.