|
- 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.
-
|