libTextSuite/ultsContext.pas

unit ultsContext;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  utsTextSuite, utsUtils,
  ultsTypes;

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

  function ltsContextCreate         ():                                                               TltsContextHandle;  stdcall;
  function ltsContextGetCodePage    (const aHandle: TltsContextHandle; out aCodePage: TtsCodePage):   TltsErrorCode;      stdcall;
  function ltsContextGetDefaultChar (const aHandle: TltsContextHandle; out aValue: WideChar):         TltsErrorCode;      stdcall;
  function ltsContextSetCodePage    (const aHandle: TltsContextHandle; aCodePage: TtsCodePage):       TltsErrorCode;      stdcall;
  function ltsContextSetDefaultChar (const aHandle: TltsContextHandle; aValue: WideChar):             TltsErrorCode;      stdcall;
  function ltsContextAnsiToWide     (const aHandle: TltsContextHandle; aText: PAnsiChar):             PWideChar;          stdcall;
  function ltsContextDestroy        (const aHandle: TltsContextHandle):                               TltsErrorCode;      stdcall;

implementation

uses
  ultsUtils;

var
  WideStringBuffer: WideString;

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Context///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextCreate: TltsContextHandle; stdcall;
var
  c: TltsContext;
begin
  try
    result := nil;
    if not CheckIfInitialized then
      exit;
    c := TltsContext.Create;
    AddReference(ltsObjTypeContext, c);
    result := c;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextGetCodePage(const aHandle: TltsContextHandle; out aCodePage: TtsCodePage): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then aCodePage := c.CodePage
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextGetDefaultChar(const aHandle: TltsContextHandle; out aValue: WideChar): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then aValue := c.DefaultChar
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextSetCodePage(const aHandle: TltsContextHandle; aCodePage: TtsCodePage): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c) then begin
      if not ValidateCodePage(aCodePage) then begin
        SetLastError(ltsErrInvalidEnum, Format('%d is not a valid enum value for CodePage', [aCodePage]));
        result := LastErrorCode;
      end else
        c.CodePage := aCodePage;
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextSetDefaultChar(const aHandle: TltsContextHandle; aValue: WideChar): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then c.DefaultChar := aValue
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextAnsiToWide(const aHandle: TltsContextHandle; aText: PAnsiChar): PWideChar; stdcall;
var
  c: TtsContext;
  w: PWideChar;
begin
  try
    result := nil;
    if CheckContextHandle(aHandle, c) then begin
      w := c.AnsiToWide(aText);
      if not Assigned(w) then
        exit;
      WideStringBuffer := w;
      tsStrDispose(w);
      result := PWideChar(WideStringBuffer);
    end else
      result := nil;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextDestroy(const aHandle: TltsContextHandle): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then DelReference(ltsObjTypeContext, c)
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

end.