libTextSuite/ultsTextBlock.pas

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.