unit ultsContext; {$mode objfpc}{$H+} interface uses Classes, SysUtils, utsTextSuite, utsUtils, ultsTypes; type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TltsContext = class(TtsContext) public function DelSlave(const aSlave: TtsRefManager): Boolean; 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 {$IFDEF DEBUG}, uutlLogger{$ENDIF}; var WideStringBuffer: WideString; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TltsContext/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TltsContext.DelSlave(const aSlave: TtsRefManager): Boolean; begin DelReference(aSlave); result := 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; {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextCreate=%p', [result]);{$ENDIF} end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsContextGetCodePage(const aHandle: TltsContextHandle; out aCodePage: TtsCodePage): TltsErrorCode; stdcall; var c: TtsContext; begin try {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextGetCodePage(Handle=%p; aCodePage=%p)', [aHandle, @aCodePage]);{$ENDIF} 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; {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextGetCodePage=%d', [Integer(result)]);{$ENDIF} end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsContextGetDefaultChar(const aHandle: TltsContextHandle; out aValue: WideChar): TltsErrorCode; stdcall; var c: TtsContext; begin try {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextGetDefaultChar(Handle=%p; aValue=%p)', [aHandle, @aValue]);{$ENDIF} 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; {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextGetDefaultChar=%d', [Integer(result)]);{$ENDIF} end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsContextSetCodePage(const aHandle: TltsContextHandle; aCodePage: TtsCodePage): TltsErrorCode; stdcall; var c: TtsContext; begin try {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextSetCodePage(Handle=%p; aCodePage=%d)', [aHandle, Integer(aCodePage)]);{$ENDIF} 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; {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextSetCodePage=%d', [Integer(result)]);{$ENDIF} end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsContextSetDefaultChar(const aHandle: TltsContextHandle; aValue: WideChar): TltsErrorCode; stdcall; var c: TtsContext; begin try {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextSetDefaultChar(Handle=%p; aValue=%d)', [aHandle, Integer(aValue)]);{$ENDIF} 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; {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextSetDefaultChar=%d', [Integer(result)]);{$ENDIF} end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsContextAnsiToWide(const aHandle: TltsContextHandle; aText: PAnsiChar): PWideChar; stdcall; var c: TtsContext; w: PWideChar; begin try {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextAnsiToWide(Handle=%p; aText=%p)', [aHandle, aText]);{$ENDIF} 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; {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextAnsiToWide=%p', [result]);{$ENDIF} end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsContextDestroy(const aHandle: TltsContextHandle): TltsErrorCode; stdcall; var c: TtsContext; begin try {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextDestroy(Handle=%p)', [aHandle]);{$ENDIF} 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; {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsContextDestroy=%d', [Integer(result)]);{$ENDIF} end; end.