unit ultsTextBlock; {$mode objfpc}{$H+} interface uses Classes, SysUtils, utsTextSuite, ultsTypes; function ltsTextBlockGetRect (aHandle: TltsTextBlockHandle; var aValue: TtsRect): TltsErrorCode; stdcall; function ltsTextBlockGetWidth (aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; function ltsTextBlockGetHeight (aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; function ltsTextBlockGetFlags (aHandle: TltsTextBlockHandle; var aValue: TtsBlockFlags): TltsErrorCode; stdcall; function ltsTextBlockGetTop (aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; function ltsTextBlockGetLeft (aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; function ltsTextBlockGetVertAlign (aHandle: TltsTextBlockHandle; var aValue: TtsVertAlignment): TltsErrorCode; stdcall; function ltsTextBlockGetHorzAlign (aHandle: TltsTextBlockHandle; var aValue: TtsHorzAlignment): TltsErrorCode; stdcall; function ltsTextBlockGetClipping (aHandle: TltsTextBlockHandle; var aValue: TtsClipping): TltsErrorCode; stdcall; function ltsTextBlockGetColor (aHandle: TltsTextBlockHandle; var aValue: TtsColor4f): TltsErrorCode; stdcall; function ltsTextBlockGetFont (aHandle: TltsTextBlockHandle; var aValue: TltsFontHandle): TltsErrorCode; stdcall; function ltsTextBlockSetTop (aHandle: TltsTextBlockHandle; aValue: Integer): TltsErrorCode; stdcall; function ltsTextBlockSetLeft (aHandle: TltsTextBlockHandle; aValue: Integer): TltsErrorCode; stdcall; function ltsTextBlockSetVertAlign (aHandle: TltsTextBlockHandle; aValue: TtsVertAlignment): TltsErrorCode; stdcall; function ltsTextBlockSetHorzAlign (aHandle: TltsTextBlockHandle; aValue: TtsHorzAlignment): TltsErrorCode; stdcall; function ltsTextBlockSetClipping (aHandle: TltsTextBlockHandle; aValue: TtsClipping): TltsErrorCode; stdcall; function ltsTextBlockSetColor (aHandle: TltsTextBlockHandle; aValue: TtsColor4f): TltsErrorCode; stdcall; function ltsTextBlockSetFont (aHandle: TltsTextBlockHandle; aValue: TltsFontHandle): TltsErrorCode; stdcall; function ltsTextBlockGetActualHeight(aHandle: TltsTextBlockHandle): Integer; stdcall; function ltsTextBlockGetTextWidthA (aHandle: TltsTextBlockHandle; aText: PAnsiChar): Integer; stdcall; function ltsTextBlockGetTextWidthW (aHandle: TltsTextBlockHandle; aText: PWideChar): Integer; stdcall; function ltsTextBlockTextOutA (aHandle: TltsTextBlockHandle; aText: PAnsiChar): TltsErrorCode; stdcall; function ltsTextBlockTextOutW (aHandle: TltsTextBlockHandle; aText: PWideChar): TltsErrorCode; stdcall; function ltsTextBlockDestroy (aHandle: TltsTextBlockHandle): TltsErrorCode; stdcall; implementation uses ultsUtils; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TextBlock///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetRect(aHandle: TltsTextBlockHandle; var aValue: TtsRect): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then aValue := b.Rect else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetWidth(aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then aValue := b.Width else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetHeight(aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then aValue := b.Height else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetFlags(aHandle: TltsTextBlockHandle; var aValue: TtsBlockFlags): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then aValue := b.Flags else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetTop(aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then aValue := b.Top else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetLeft(aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then aValue := b.Left else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetVertAlign(aHandle: TltsTextBlockHandle; var aValue: TtsVertAlignment): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then aValue := b.VertAlign else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetHorzAlign(aHandle: TltsTextBlockHandle; var aValue: TtsHorzAlignment): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then aValue := b.HorzAlign else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetClipping(aHandle: TltsTextBlockHandle; var aValue: TtsClipping): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then aValue := b.Clipping else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetColor(aHandle: TltsTextBlockHandle; var aValue: TtsColor4f): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then aValue := b.CurrentColor else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetFont(aHandle: TltsTextBlockHandle; var aValue: TltsFontHandle): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then aValue := b.CurrentFont else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockSetTop(aHandle: TltsTextBlockHandle; aValue: Integer): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then b.Top := aValue else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockSetLeft(aHandle: TltsTextBlockHandle; aValue: Integer): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then b.Left := aValue else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockSetVertAlign(aHandle: TltsTextBlockHandle; aValue: TtsVertAlignment): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then b.VertAlign := aValue else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockSetHorzAlign(aHandle: TltsTextBlockHandle; aValue: TtsHorzAlignment): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then b.HorzAlign := aValue else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockSetClipping(aHandle: TltsTextBlockHandle; aValue: TtsClipping): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then b.Clipping := aValue else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockSetColor(aHandle: TltsTextBlockHandle; aValue: TtsColor4f): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then b.CurrentColor := aValue else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockSetFont(aHandle: TltsTextBlockHandle; aValue: TltsFontHandle): TltsErrorCode; stdcall; var b: TtsTextBlock; f: TtsFont; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) and CheckFontHandle(aValue, f) then b.CurrentFont := f else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetActualHeight(aHandle: TltsTextBlockHandle): Integer; stdcall; var b: TtsTextBlock; begin try if CheckTextBlockHandle(aHandle, b) then result := b.GetActualBlockHeight else result := -1; except on ex: Exception do begin SetLastError(ex); result := -1; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetTextWidthA(aHandle: TltsTextBlockHandle; aText: PAnsiChar): Integer; stdcall; var b: TtsTextBlock; begin try if CheckTextBlockHandle(aHandle, b) then result := b.GetTextWidthA(aText) else result := -1; except on ex: Exception do begin SetLastError(ex); result := -1; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockGetTextWidthW(aHandle: TltsTextBlockHandle; aText: PWideChar): Integer; stdcall; var b: TtsTextBlock; begin try if CheckTextBlockHandle(aHandle, b) then result := b.GetTextWidthW(aText) else result := -1; except on ex: Exception do begin SetLastError(ex); result := -1; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockTextOutA(aHandle: TltsTextBlockHandle; aText: PAnsiChar): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then b.TextOutA(aText) else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockTextOutW(aHandle: TltsTextBlockHandle; aText: PWideChar): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then b.TextOutW(aText) else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function ltsTextBlockDestroy(aHandle: TltsTextBlockHandle): TltsErrorCode; stdcall; var b: TtsTextBlock; begin try result := ltsErrNone; if CheckTextBlockHandle(aHandle, b) then begin DelReference(ltsObjTypeTextBlock, b); FreeAndNil(b); end else result := LastErrorCode; except on ex: Exception do begin SetLastError(ex); result := LastErrorCode; end; end; end; end.