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