|
- unit ulibTextSuite;
-
- {$IFDEF fpc}
- {$mode objfpc}{$H+}
- {$ENDIF}
-
- interface
-
- uses
- Classes, SysUtils, contnrs;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Enums/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- {$Z4}
- TltsErrorCode = (
- ltsErrUnknown = -1,
- ltsErrNone = 0,
-
- // misc
- ltsErrNotInitialized = 1,
- ltsErrInvalidEnum = 2,
- ltsErrInvalidValue = 3,
- ltsErrInvalidOperation = 4,
- ltsErrInvalidType = 5,
-
- // invalid handles
- ltsErrInvalidContextHandle = 100,
- ltsErrInvalidRendererHandle = 101,
- ltsErrInvalidTextBlockHandle = 102,
- ltsErrInvalidFontHandle = 103,
- ltsErrInvalidFontCreatorHandle = 104,
- ltsErrInvalidImageHandle = 105,
- ltsErrInvalidPostProcHandle = 106
- );
-
- {$Z4}
- TltsObjectType = (
- ltsObjTypeUnknown,
- ltsObjTypeContext,
- ltsObjTypeRenderer,
- ltsObjTypeFontCreator,
- ltsObjTypeFont,
- ltsObjTypeTextBlock,
- ltsObjTypeImage,
- ltsObjTypePostProcessor
- );
-
- {$Z4}
- TltsRendererType = (
- ltsRendererUnknown,
- ltsRendererOpenGL,
- ltsRendererOpenGLES
- );
-
- {$Z4}
- TltsFontCreatorType = (
- ltsFontCreatorUnknown,
- ltsFontCreatorFreeType,
- ltsFontCreatorGDI,
- ltsFontCreatorCustom
- );
-
- {$Z4}
- TltsCodePage = (
- ltsUTF8,
- ltsISO_8859_1,
- ltsISO_8859_2,
- ltsISO_8859_3,
- ltsISO_8859_4,
- ltsISO_8859_5,
- ltsISO_8859_6,
- ltsISO_8859_7,
- ltsISO_8859_8,
- ltsISO_8859_9,
- ltsISO_8859_10,
- ltsISO_8859_11,
- ltsISO_8859_13,
- ltsISO_8859_14,
- ltsISO_8859_15,
- ltsISO_8859_16,
- ltsISO_037,
- ltsISO_437,
- ltsISO_500,
- ltsISO_737,
- ltsISO_775,
- ltsISO_850,
- ltsISO_852,
- ltsISO_855,
- ltsISO_857,
- ltsISO_860,
- ltsISO_861,
- ltsISO_862,
- ltsISO_863,
- ltsISO_864,
- ltsISO_865,
- ltsISO_866,
- ltsISO_869,
- ltsISO_874,
- ltsISO_875,
- ltsISO_1026,
- ltsISO_1250,
- ltsISO_1251,
- ltsISO_1252,
- ltsISO_1253,
- ltsISO_1254,
- ltsISO_1255,
- ltsISO_1256,
- ltsISO_1257,
- ltsISO_1258);
-
- TltsFormat = (
- ltsFormatEmpty,
- ltsFormatRGBA8,
- ltsFormatLumAlpha8,
- ltsFormatAlpha8,
- ltsFormatLum8);
-
- TltsVertAlignment = (
- ltsVertAlignTop,
- ltsVertAlignCenter,
- ltsVertAlignBottom);
-
- TltsHorzAlignment = (
- ltsHorzAlignLeft,
- ltsHorzAlignCenter,
- ltsHorzAlignRight,
- ltsHorzAlignJustify);
-
- TltsClipping = (
- ltsClipNone,
- ltsClipWordBorder,
- ltsClipCharBorder,
- ltsClipWordComplete,
- ltsClipCharComplete
- );
-
- TltsAntiAliasing = (
- ltsAANone,
- ltsAANormal);
-
- TltsCharRangeUsage = (
- ltsUsageInclude,
- ltsUsageExclude);
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Flags/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- type
- TltsBlockFlag = (
- ltsBlockFlagWordWrap
- );
- TltsBlockFlags = set of TltsBlockFlag;
-
- TltsFontStyle = (
- ltsStyleBold,
- ltsStyleItalic,
- ltsStyleUnderline,
- ltsStyleStrikeout);
- TltsFontStyles = set of TltsFontStyle;
-
- TltsColorChannel = (
- ltsChannelRed,
- ltsChannelGreen,
- ltsChannelBlue,
- ltsChannelAlpha);
- TltsColorChannels = set of TltsColorChannel;
-
- TltsImageMode = (
- ltsModeIgnore,
- ltsModeReplace,
- ltsModeModulate);
- TltsImageModes = array[TltsColorChannel] of TltsImageMode;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Structures////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- type
- PltsColor4f = ^TltsColor4f;
- TltsColor4f = packed record
- case Boolean of
- true: (r, g, b, a: Single);
- false: (arr: array[0..3] of Single);
- end;
-
- PltsPosition = ^TltsPosition;
- TltsPosition = packed record
- x, y: Integer;
- end;
-
- PltsRect = ^TltsRect;
- TltsRect = packed record
- case Byte of
- 0: (TopLeft: TltsPosition; BottomRight: TltsPosition);
- 1: (Left, Top, Right, Bottom: Integer);
- end;
-
- TltsVector4f = array[0..3] of Single;
- TltsMatrix4f = array[0..3] of TltsVector4f;
-
- TltsGlyphMetric = packed record
- GlyphOrigin: TltsPosition;
- GlyphRect: TltsRect;
- Advance: Integer;
- end;
-
- TltsTextMetric = packed record
- Ascent: Integer;
- Descent: Integer;
- ExternalLeading: Integer;
- BaseLineOffset: Integer;
- CharSpacing: Integer;
- LineHeight: Integer;
- LineSpacing: Integer;
- end;
-
- TltsFontNames = packed record
- Fontname: String;
- Copyright: String;
- Facename: String;
- Stylename: String;
- Fullname: String;
- end;
-
- TltsFontMetric = packed record
- Size: Integer;
- Style: TltsFontStyles;
- AntiAliasing: TltsAntiAliasing;
- DefaultChar: WideChar;
- __reserved: SmallInt;
-
- Ascent: Integer;
- Descent: Integer;
- ExternalLeading: Integer;
- BaseLineOffset: Integer;
-
- UnderlinePos: Integer;
- UnderlineSize: Integer;
- StrikeoutPos: Integer;
- StrikeoutSize: Integer;
- end;
-
- const
- LTS_IMAGE_MODES_REPLACE_ALL: TltsImageModes = (
- ltsModeReplace,
- ltsModeReplace,
- ltsModeReplace,
- ltsModeReplace);
- LTS_IMAGE_MODES_MODULATE_ALPHA: TltsImageModes = (
- ltsModeReplace,
- ltsModeReplace,
- ltsModeReplace,
- ltsModeModulate);
- LTS_IMAGE_MODES_MODULATE_ALL: TltsImageModes = (
- ltsModeModulate,
- ltsModeModulate,
- ltsModeModulate,
- ltsModeModulate);
-
- LTS_COLOR_CHANNELS_RGB: TltsColorChannels = [
- ltsChannelRed,
- ltsChannelGreen,
- ltsChannelBlue];
- LTS_COLOR_CHANNELS_RGBA: TltsColorChannels = [
- ltsChannelRed,
- ltsChannelGreen,
- ltsChannelBlue,
- ltsChannelAlpha];
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Library Functions/////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- type
- TltsHandle = Pointer;
- TltsContextHandle = TltsHandle;
- TltsRendererHandle = TltsHandle;
- TltsTextBlockHandle = TltsHandle;
- TltsFontCreatorHandle = TltsHandle;
- TltsFontHandle = TltsHandle;
- TltsPostProcessorHandle = TltsHandle;
- TltsImageHandle = TltsHandle;
- TltsCharHandle = TltsHandle;
-
- TltsStreamOrigin = (
- ltsStreamOriginBegin = Integer(soBeginning),
- ltsStreamOriginCurrent = Integer(soCurrent),
- ltsStreamOriginEnd = Integer(soEnd)
- );
-
- TltsStreamFuncRead = function(const aArgs: Pointer; const aBuffer: Pointer; const aSize: Integer): Integer; stdcall;
- TltsStreamFuncSeek = function(const aArgs: Pointer; const aOrigin: TltsStreamOrigin; const aPos: Integer): Integer; stdcall;
- PltsStream = ^TltsStream;
- TltsStream = packed record
- args: Pointer;
- read: TltsStreamFuncRead;
- seek: TltsStreamFuncSeek;
- end;
-
- TltsPostProcessorExecuteFunc = procedure(const aCharHandle: TltsCharHandle; const aImageHandle: TltsImageHandle; aArgs: Pointer); stdcall;
- PltsPostProcessorCustomData = ^TltsPostProcessorCustomData;
- TltsPostProcessorCustomData = packed record
- args: Pointer;
- execute: TltsPostProcessorExecuteFunc;
- end;
-
- TltsRendererCustomBeginRender = procedure(aArgs: Pointer); stdcall;
- TltsRendererCustomEndRender = procedure(aArgs: Pointer); stdcall;
- TltsRendererCustomGetDrawPos = function (aArgs: Pointer): TltsPosition; stdcall;
- TltsRendererCustomSetDrawPos = procedure(const aValue: TltsPosition; aArgs: Pointer); stdcall;
- TltsRendererCustomMoveDrawPos = procedure(const aOffset: TltsPosition; aArgs: Pointer); stdcall;
- TltsRendererCustomSetColor = procedure(const aValue: TltsColor4f; aArgs: Pointer); stdcall;
- TltsRendererCustomRender = procedure(const aRef: Pointer; const aForcedWidth: Integer; aArgs: Pointer); stdcall;
- TltsRendererCustomCreateRef = function (const aChar: TltsCharHandle; const aImage: TltsImageHandle; aArgs: Pointer): Pointer; stdcall;
- TltsRendererCustomFreeRef = procedure(const aRef: Pointer; aArgs: Pointer); stdcall;
- PltsRendererCustomData = ^TltsRendererCustomData;
- TltsRendererCustomData = packed record
- args: Pointer;
-
- BeginRender: TltsRendererCustomBeginRender;
- EndRender: TltsRendererCustomEndRender;
- GetDrawPos: TltsRendererCustomGetDrawPos;
- SetDrawPos: TltsRendererCustomSetDrawPos;
- MoveDrawPos: TltsRendererCustomMoveDrawPos;
- SetColor: TltsRendererCustomSetColor;
- Render: TltsRendererCustomRender;
-
- CreatRef: TltsRendererCustomCreateRef;
- FreeRef: TltsRendererCustomFreeRef;
- end;
-
- TltsImage = class;
- TltsImageLoadFunc = procedure(aImage: TltsImage; X, Y: Integer; var aPixel: TltsColor4f; aArgs: Pointer);
- TltsImageBlendFunc = function (aSrc, aDst: TltsColor4f; aArgs: Pointer): TltsColor4f;
-
- TltsImageLoadInternFunc = procedure(aHandle: TltsImageHandle; X, Y: Integer; var aPixel: TltsColor4f; aArgs: Pointer); stdcall;
- TltsImageBlendInternFunc = procedure(aHandle: TltsImageHandle; aSrc, aDst: TltsColor4f; out aResult: TltsColor4f; aArgs: Pointer); stdcall;
-
- TltsContextCreate = function(): TltsContextHandle; stdcall;
- TltsContextGetCodePage = function(aHandle: TltsContextHandle; out aCodePage: TltsCodePage): TltsErrorCode; stdcall;
- TltsContextGetDefaultChar = function(aHandle: TltsContextHandle; out aValue: WideChar): TltsErrorCode; stdcall;
- TltsContextSetCodePage = function(aHandle: TltsContextHandle; aCodePage: TltsCodePage): TltsErrorCode; stdcall;
- TltsContextSetDefaultChar = function(aHandle: TltsContextHandle; aValue: WideChar): TltsErrorCode; stdcall;
- TltsContextAnsiToWide = function(aHandle: TltsContextHandle; aText: PAnsiChar): PWideChar; stdcall;
- TltsContextDestroy = function(aHandle: TltsContextHandle): TltsErrorCode; stdcall;
-
- TltsRendererCreate = function(aHandle: TltsContextHandle; aType: TltsRendererType; aFormat: TltsFormat): TltsRendererHandle; stdcall;
- TltsRendererCustomCreate = function(aHandle: TltsContextHandle; aFormat: TltsFormat; constref aData: TltsRendererCustomData): TltsRendererHandle; stdcall;
- TltsRendererBeginBlock = function(aHandle: TltsRendererHandle; aTop, aLeft, aWidth, aHeight: Integer; aFlags: TltsBlockFlags): TltsTextBlockHandle; stdcall;
- TltsRendererEndBlock = function(aHandle: TltsRendererHandle; aBlock: TltsTextBlockHandle): TltsErrorCode; stdcall;
- TltsRendererAbortBlock = function(aHandle: TltsRendererHandle; aBlock: TltsTextBlockHandle): TltsErrorCode; stdcall;
- TltsRendererGetTextWidthA = function(aHandle: TltsRendererHandle; aFont: TltsFontHandle; aText: PAnsiChar): Integer; stdcall;
- TltsRendererGetTextWidthW = function(aHandle: TltsRendererHandle; aFont: TltsFontHandle; aText: PWideChar): Integer; stdcall;
- TltsRendererDestroy = function(aHandle: TltsRendererHandle): TltsErrorCode; stdcall;
-
- TltsFontCreatorCreate = function(aHandle: TltsContextHandle; aType: TltsFontCreatorType): TltsFontCreatorHandle; stdcall;
- TltsFontCreatorGetFontByName = function(aHandle: TltsFontCreatorHandle; aFontname: PAnsiChar; aSize: Integer; aStyle: TltsFontStyles; aAntiAliasing: TltsAntiAliasing): TltsFontHandle; stdcall;
- TltsFontCreatorGetFontByFile = function(aHandle: TltsFontCreatorHandle; aFilename: PAnsiChar; aSize: Integer; aStyle: TltsFontStyles; aAntiAliasing: TltsAntiAliasing): TltsFontHandle; stdcall;
- TltsFontCreatorGetFontByStream = function(aHandle: TltsFontCreatorHandle; aStream: PltsStream; aSize: Integer; aStyle: TltsFontStyles; aAntiAliasing: TltsAntiAliasing): TltsFontHandle; stdcall;
- TltsFontCreatorDestroy = function(aHandle: TltsFontCreatorHandle): TltsErrorCode; stdcall;
-
- TltsFontGetPostProcessor = function(aHandle: TltsFontHandle): TltsPostProcessorHandle; stdcall;
- TltsFontGetTabWidth = function(aHandle: TltsFontHandle; out aValue: Integer): TltsErrorCode; stdcall;
- TltsFontGetCharSpacing = function(aHandle: TltsFontHandle; out aValue: Integer): TltsErrorCode; stdcall;
- TltsFontGetLineSpacing = function(aHandle: TltsFontHandle; out aValue: Single): TltsErrorCode; stdcall;
- TltsFontGetMetric = function(aHandle: TltsFontHandle; out aValue: TltsFontMetric): TltsErrorCode; stdcall;
- TltsFontGetFontname = function(aHandle: TltsFontHandle): PAnsiChar; stdcall;
- TltsFontGetFacename = function(aHandle: TltsFontHandle): PAnsiChar; stdcall;
- TltsFontGetStylename = function(aHandle: TltsFontHandle): PAnsiChar; stdcall;
- TltsFontGetFullname = function(aHandle: TltsFontHandle): PAnsiChar; stdcall;
- TltsFontGetCopyright = function(aHandle: TltsFontHandle): PAnsiChar; stdcall;
- TltsFontSetPostProcessor = function(aHandle: TltsFontHandle; aValue: TltsPostProcessorHandle): TltsErrorCode; stdcall;
- TltsFontSetTabWidth = function(aHandle: TltsFontHandle; aValue: Integer): TltsErrorCode; stdcall;
- TltsFontSetCharSpacing = function(aHandle: TltsFontHandle; aValue: Integer): TltsErrorCode; stdcall;
- TltsFontSetLineSpacing = function(aHandle: TltsFontHandle; aValue: Single): TltsErrorCode; stdcall;
- TltsFontDestroy = function(aHandle: TltsFontHandle): TltsErrorCode; stdcall;
-
- TltsTextBlockGetRect = function(aHandle: TltsTextBlockHandle; out aValue: TltsRect): TltsErrorCode; stdcall;
- TltsTextBlockGetWidth = function(aHandle: TltsTextBlockHandle; out aValue: Integer): TltsErrorCode; stdcall;
- TltsTextBlockGetHeight = function(aHandle: TltsTextBlockHandle; out aValue: Integer): TltsErrorCode; stdcall;
- TltsTextBlockGetFlags = function(aHandle: TltsTextBlockHandle; out aValue: TltsBlockFlags): TltsErrorCode; stdcall;
- TltsTextBlockGetTop = function(aHandle: TltsTextBlockHandle; out aValue: Integer): TltsErrorCode; stdcall;
- TltsTextBlockGetLeft = function(aHandle: TltsTextBlockHandle; out aValue: Integer): TltsErrorCode; stdcall;
- TltsTextBlockGetVertAlign = function(aHandle: TltsTextBlockHandle; out aValue: TltsVertAlignment): TltsErrorCode; stdcall;
- TltsTextBlockGetHorzAlign = function(aHandle: TltsTextBlockHandle; out aValue: TltsHorzAlignment): TltsErrorCode; stdcall;
- TltsTextBlockGetClipping = function(aHandle: TltsTextBlockHandle; out aValue: TltsClipping): TltsErrorCode; stdcall;
- TltsTextBlockGetColor = function(aHandle: TltsTextBlockHandle; out aValue: TltsColor4f): TltsErrorCode; stdcall;
- TltsTextBlockGetFont = function(aHandle: TltsTextBlockHandle; out aValue: TltsFontHandle): TltsErrorCode; stdcall;
- TltsTextBlockSetTop = function(aHandle: TltsTextBlockHandle; aValue: Integer): TltsErrorCode; stdcall;
- TltsTextBlockSetLeft = function(aHandle: TltsTextBlockHandle; aValue: Integer): TltsErrorCode; stdcall;
- TltsTextBlockSetVertAlign = function(aHandle: TltsTextBlockHandle; aValue: TltsVertAlignment): TltsErrorCode; stdcall;
- TltsTextBlockSetHorzAlign = function(aHandle: TltsTextBlockHandle; aValue: TltsHorzAlignment): TltsErrorCode; stdcall;
- TltsTextBlockSetClipping = function(aHandle: TltsTextBlockHandle; aValue: TltsClipping): TltsErrorCode; stdcall;
- TltsTextBlockSetColor = function(aHandle: TltsTextBlockHandle; aValue: TltsColor4f): TltsErrorCode; stdcall;
- TltsTextBlockSetFont = function(aHandle: TltsTextBlockHandle; aValue: TltsFontHandle): TltsErrorCode; stdcall;
- TltsTextBlockGetActualHeight = function(aHandle: TltsTextBlockHandle): Integer; stdcall;
- TltsTextBlockGetTextWidthA = function(aHandle: TltsTextBlockHandle; aText: PAnsiChar): Integer; stdcall;
- TltsTextBlockGetTextWidthW = function(aHandle: TltsTextBlockHandle; aText: PWideChar): Integer; stdcall;
- TltsTextBlockTextOutA = function(aHandle: TltsTextBlockHandle; aText: PAnsiChar): TltsErrorCode; stdcall;
- TltsTextBlockTextOutW = function(aHandle: TltsTextBlockHandle; aText: PWideChar): TltsErrorCode; stdcall;
- TltsTextBlockDestroy = function(aHandle: TltsTextBlockHandle): TltsErrorCode; stdcall;
-
- TltsImageCreate = function(aContext: TltsContextHandle): TltsImageHandle; stdcall;
- TltsImageIsEmpty = function(aHandle: TltsImageHandle; out aValue: Boolean): TltsErrorCode; stdcall;
- TltsImageGetWidth = function(aHandle: TltsImageHandle): Integer; stdcall;
- TltsImageGetHeight = function(aHandle: TltsImageHandle): Integer; stdcall;
- TltsImageGetLineSize = function(aHandle: TltsImageHandle): Integer; stdcall;
- TltsImageGetDataSize = function(aHandle: TltsImageHandle): Integer; stdcall;
- TltsImageGetFormat = function(aHandle: TltsImageHandle; out aValue: TltsFormat): TltsErrorCode; stdcall;
- TltsImageGetData = function(aHandle: TltsImageHandle): Pointer; stdcall;
- TltsImageGetScanline = function(aHandle: TltsImageHandle; aIndex: Integer): Pointer; stdcall;
- TltsImageGetPixelAt = function(aHandle: TltsImageHandle; aX, aY: Integer; out aColor: TltsColor4f): TltsErrorCode; stdcall;
- TltsImageAssign = function(aHandle, aSource: TltsImageHandle): TltsErrorCode; stdcall;
- TltsImageCreateEmpty = function(aHandle: TltsImageHandle; aFormat: TltsFormat; aWidth, aHeight: Integer): TltsErrorCode; stdcall;
- TltsImageLoadFromFunc = function(aHandle: TltsImageHandle; aCallback: TltsImageLoadInternFunc; aArgs: Pointer): TltsErrorCode; stdcall;
- TltsImageResize = function(aHandle: TltsImageHandle; aWidth, aHeight, aX, aY: Integer): TltsErrorCode; stdcall;
- TltsImageFillColor = function(aHandle: TltsImageHandle; aColor: TltsColor4f; aMask: TltsColorChannels; aModes: TltsImageModes): TltsErrorCode; stdcall;
- TltsImageFillPattern = function(aHandle, aPattern: TltsImageHandle; aX, aY: Integer; aMask: TltsColorChannels; aModes: TltsImageModes): TltsErrorCode; stdcall;
- TltsImageBlend = function(aHandle, aSource: TltsImageHandle; aX, aY: Integer; aBlendFunc: TltsImageBlendInternFunc; aArgs: Pointer): TltsErrorCode; stdcall;
- TltsImageBlur = function(aHandle: TltsImageHandle; aHorzRad, aHorzStr, aVertRad, aVertStr: Single; aMask: TltsColorChannels): TltsErrorCode; stdcall;
- TltsImageDestroy = function(aHandle: TltsImageHandle): TltsErrorCode; stdcall;
-
- TltsPostProcessorAddRange = function(aHandle: TltsPostProcessorHandle; aUsage: TltsCharRangeUsage; aStart, aStop: WideChar): TltsErrorCode; stdcall;
- TltsPostProcessorAddChars = function(aHandle: TltsPostProcessorHandle; aUsage: TltsCharRangeUsage; aChars: PWideChar): TltsErrorCode; stdcall;
- TltsPostProcessorClearRanges = function(aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall;
- TltsPostProcessorExecute = function(aHandle: TltsPostProcessorHandle; aChar: TltsCharHandle; aImage: TltsImageHandle): TltsErrorCode; stdcall;
- TltsPostProcessorFillColorCreate = function(aContext: TltsContextHandle; aColor: TltsColor4f; aModes: TltsImageModes; aChannels: TltsColorChannels): TltsPostProcessorHandle; stdcall;
- TltsPostProcessorFillPatterCreate = function(aContext: TltsContextHandle; aPattern: TltsImageHandle; aOwnsPatter: Boolean; aPosition: TltsPosition; aModes: TltsImageModes; aChannels: TltsColorChannels): TltsPostProcessorHandle; stdcall;
- TltsPostProcessorBorderCreate = function(aContext: TltsContextHandle; aWidth, aStrength: Single; aColor: TltsColor4f; aKeepSize: Boolean): TltsPostProcessorHandle; stdcall;
- TltsPostProcessorShadowCreate = function(aContext: TltsContextHandle; aRadius, aStrength: Single; aOffset: TltsPosition; aColor: TltsColor4f): TltsPostProcessorHandle; stdcall;
- TltsPostProcessorCustomCreate = function(aContext: TltsContextHandle; constref aData: TltsPostProcessorCustomData): TltsPostProcessorHandle; stdcall;
- TltsPostProcessorDestroy = function(aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall;
-
- TltsCharGetCharCode = function(aHandle: TltsCharHandle; out aValue: WideChar): TltsErrorCode; stdcall;
- TltsCharGetGlyphMetric = function(aHandle: TltsCharHandle; out aValue: TltsGlyphMetric): TltsErrorCode; stdcall;
- TltsCharSetGlyphMetric = function(aHandle: TltsCharHandle; constref aValue: TltsGlyphMetric): TltsErrorCode; stdcall;
-
- TltsInitialize = function(): TltsErrorCode; stdcall;
- TltsGetVersion = function(): PAnsiChar; stdcall;
- TltsGetLastErrorCode = function(): TltsErrorCode; stdcall;
- TltsGetLastErrorMsg = function(): PAnsiChar; stdcall;
- TltsFinalize = function(): TltsErrorCode; stdcall;
-
- var
- ltsContextCreate: TltsContextCreate;
- ltsContextGetCodePage: TltsContextGetCodePage;
- ltsContextGetDefaultChar: TltsContextGetDefaultChar;
- ltsContextSetCodePage: TltsContextSetCodePage;
- ltsContextSetDefaultChar: TltsContextSetDefaultChar;
- ltsContextAnsiToWide: TltsContextAnsiToWide;
- ltsContextDestroy: TltsContextDestroy;
-
- ltsRendererCreate: TltsRendererCreate;
- ltsRendererCustomCreate: TltsRendererCustomCreate;
- ltsRendererBeginBlock: TltsRendererBeginBlock;
- ltsRendererEndBlock: TltsRendererEndBlock;
- ltsRendererAbortBlock: TltsRendererAbortBlock;
- ltsRendererGetTextWidthA: TltsRendererGetTextWidthA;
- ltsRendererGetTextWidthW: TltsRendererGetTextWidthW;
- ltsRendererDestroy: TltsRendererDestroy;
-
- ltsFontCreatorCreate: TltsFontCreatorCreate;
- ltsFontCreatorGetFontByName: TltsFontCreatorGetFontByName;
- ltsFontCreatorGetFontByFile: TltsFontCreatorGetFontByFile;
- ltsFontCreatorGetFontByStream: TltsFontCreatorGetFontByStream;
- ltsFontCreatorDestroy: TltsFontCreatorDestroy;
-
- ltsFontGetPostProcessor: TltsFontGetPostProcessor;
- ltsFontGetTabWidth: TltsFontGetTabWidth;
- ltsFontGetCharSpacing: TltsFontGetCharSpacing;
- ltsFontGetLineSpacing: TltsFontGetLineSpacing;
- ltsFontGetMetric: TltsFontGetMetric;
- ltsFontGetFontname: TltsFontGetFontname;
- ltsFontGetFacename: TltsFontGetFacename;
- ltsFontGetStylename: TltsFontGetStylename;
- ltsFontGetFullname: TltsFontGetFullname;
- ltsFontGetCopyright: TltsFontGetCopyright;
- ltsFontSetPostProcessor: TltsFontSetPostProcessor;
- ltsFontSetTabWidth: TltsFontSetTabWidth;
- ltsFontSetCharSpacing: TltsFontSetCharSpacing;
- ltsFontSetLineSpacing: TltsFontSetLineSpacing;
- ltsFontDestroy: TltsFontDestroy;
-
- ltsTextBlockGetRect: TltsTextBlockGetRect;
- ltsTextBlockGetWidth: TltsTextBlockGetWidth;
- ltsTextBlockGetHeight: TltsTextBlockGetHeight;
- ltsTextBlockGetFlags: TltsTextBlockGetFlags;
- ltsTextBlockGetTop: TltsTextBlockGetTop;
- ltsTextBlockGetLeft: TltsTextBlockGetLeft;
- ltsTextBlockGetVertAlign: TltsTextBlockGetVertAlign;
- ltsTextBlockGetHorzAlign: TltsTextBlockGetHorzAlign;
- ltsTextBlockGetClipping: TltsTextBlockGetClipping;
- ltsTextBlockGetColor: TltsTextBlockGetColor;
- ltsTextBlockGetFont: TltsTextBlockGetFont;
- ltsTextBlockSetTop: TltsTextBlockSetTop;
- ltsTextBlockSetLeft: TltsTextBlockSetLeft;
- ltsTextBlockSetVertAlign: TltsTextBlockSetVertAlign;
- ltsTextBlockSetHorzAlign: TltsTextBlockSetHorzAlign;
- ltsTextBlockSetClipping: TltsTextBlockSetClipping;
- ltsTextBlockSetColor: TltsTextBlockSetColor;
- ltsTextBlockSetFont: TltsTextBlockSetFont;
- ltsTextBlockGetActualHeight: TltsTextBlockGetActualHeight;
- ltsTextBlockGetTextWidthA: TltsTextBlockGetTextWidthA;
- ltsTextBlockGetTextWidthW: TltsTextBlockGetTextWidthW;
- ltsTextBlockTextOutA: TltsTextBlockTextOutA;
- ltsTextBlockTextOutW: TltsTextBlockTextOutW;
- ltsTextBlockDestroy: TltsTextBlockDestroy;
-
- ltsImageCreate: TltsImageCreate;
- ltsImageIsEmpty: TltsImageIsEmpty;
- ltsImageGetWidth: TltsImageGetWidth;
- ltsImageGetHeight: TltsImageGetHeight;
- ltsImageGetLineSize: TltsImageGetLineSize;
- ltsImageGetDataSize: TltsImageGetDataSize;
- ltsImageGetFormat: TltsImageGetFormat;
- ltsImageGetData: TltsImageGetData;
- ltsImageGetScanline: TltsImageGetScanline;
- ltsImageGetPixelAt: TltsImageGetPixelAt;
- ltsImageAssign: TltsImageAssign;
- ltsImageCreateEmpty: TltsImageCreateEmpty;
- ltsImageLoadFromFunc: TltsImageLoadFromFunc;
- ltsImageResize: TltsImageResize;
- ltsImageFillColor: TltsImageFillColor;
- ltsImageFillPattern: TltsImageFillPattern;
- ltsImageBlend: TltsImageBlend;
- ltsImageBlur: TltsImageBlur;
- ltsImageDestroy: TltsImageDestroy;
-
- ltsPostProcessorAddRange: TltsPostProcessorAddRange;
- ltsPostProcessorAddChars: TltsPostProcessorAddChars;
- ltsPostProcessorClearRanges: TltsPostProcessorClearRanges;
- ltsPostProcessorExecute: TltsPostProcessorExecute;
- ltsPostProcessorFillColorCreate: TltsPostProcessorFillColorCreate;
- ltsPostProcessorFillPatterCreate: TltsPostProcessorFillPatterCreate;
- ltsPostProcessorBorderCreate: TltsPostProcessorBorderCreate;
- ltsPostProcessorShadowCreate: TltsPostProcessorShadowCreate;
- ltsPostProcessorCustomCreate: TltsPostProcessorCustomCreate;
- ltsPostProcessorDestroy: TltsPostProcessorDestroy;
-
- ltsCharGetCharCode: TltsCharGetCharCode;
- ltsCharGetGlyphMetric: TltsCharGetGlyphMetric;
- ltsCharSetGlyphMetric: TltsCharSetGlyphMetric;
-
- ltsGetVersion: TltsGetVersion;
- ltsGetLastErrorCode: TltsGetLastErrorCode;
- ltsGetLastErrorMsg: TltsGetLastErrorMsg;
-
- procedure ltsInitialize(const aLibName: String);
- procedure ltsFinalize;
-
- function ltsColor4f(r, g, b, a: Single): TltsColor4f;
- function ltsPosition(const x, y: Integer): TltsPosition;
- function ltsRect(const l, t, r, b: Integer): TltsRect; overload;
- function ltsRect(const aTopLeft, aBottomRight: TltsPosition): TltsRect; overload;
- function ltsVector4f(X, Y, Z, W: Single): TltsVector4f;
- function ltsMatrix4f(X, Y, Z, P: TltsVector4f): TltsMatrix4f;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsException = class(Exception)
- private
- fErrorCode: TltsErrorCode;
- public
- property ErrorCode: TltsErrorCode read fErrorCode;
- constructor Create(const aMessage: String; const aErrorCode: TltsErrorCode = ltsErrNone);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsContext = class(TObject)
- private
- fHandle: TltsContextHandle;
- function GetCodePage: TltsCodePage;
- function GetDefaultChar: WideChar;
- procedure SetCodePage(aValue: TltsCodePage);
- procedure SetDefaultChar(aValue: WideChar);
- public
- property Handle: TltsContextHandle read fHandle;
- property CodePage: TltsCodePage read GetCodePage write SetCodePage;
- property DefaultChar: WideChar read GetDefaultChar write SetDefaultChar;
-
- constructor Create;
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsChar = class(TObject)
- private
- fHandle: TltsCharHandle;
- function GetCharCode: WideChar;
- function GetGlyphMetric: TltsGlyphMetric;
- procedure SetGlyphMetric(aValue: TltsGlyphMetric);
- public
- property Handle: TltsCharHandle read fHandle;
- property CharCode: WideChar read GetCharCode;
- property GlyphMetric: TltsGlyphMetric read GetGlyphMetric write SetGlyphMetric;
-
- constructor CreateFromHandle(const aHandle: TltsCharHandle);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsPostProcessor = class(TObject)
- private
- fHandle: TltsPostProcessorHandle;
- protected
- procedure Execute(const aChar: TltsChar; const aImage: TltsImage); virtual;
- public
- property Handle: TltsPostProcessorHandle read fHandle;
-
- procedure AddRange(const aUsage: TltsCharRangeUsage; const aStart, aStop: WideChar);
- procedure AddChars(const aUsage: TltsCharRangeUsage; const aChars: PWideChar);
- procedure ClearRanges;
-
- constructor Create(const aHandle: TltsPostProcessorHandle);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsPostProcessorFillColor = class(TltsPostProcessor)
- private
- fColor: TltsColor4f;
- fModes: TltsImageModes;
- fChannels: TltsColorChannels;
- public
- property Color: TltsColor4f read fColor;
- property Modes: TltsImageModes read fModes;
- property Channels: TltsColorChannels read fChannels;
-
- constructor Create(const aContext: TltsContext; const aColor: TltsColor4f; const aModes: TltsImageModes; const aChannels: TltsColorChannels);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsPostProcessorFillPattern = class(TltsPostProcessor)
- private
- fPattern: TltsImage;
- fOwnsPattern: Boolean;
- fPosition: TltsPosition;
- fModes: TltsImageModes;
- fChannels: TltsColorChannels;
- public
- property Pattern: TltsImage read fPattern;
- property OwnsPattern: Boolean read fOwnsPattern;
- property Position: TltsPosition read fPosition;
- property Modes: TltsImageModes read fModes;
- property Channels: TltsColorChannels read fChannels;
-
- constructor Create(const aContext: TltsContext; const aPattern: TltsImage; const aOwnsPatter: Boolean; const aPosition: TltsPosition; const aModes: TltsImageModes; const aChannels: TltsColorChannels);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsPostProcessorBorder = class(TltsPostProcessor)
- private
- fWidth: Single;
- fStrength: Single;
- fColor: TltsColor4f;
- fKeepSize: Boolean;
- public
- property Width: Single read fWidth;
- property Strength: Single read fStrength;
- property Color: TltsColor4f read fColor;
- property KeepSize: Boolean read fKeepSize;
-
- constructor Create(const aContext: TltsContext; const aWidth, aStrength: Single; const aColor: TltsColor4f; const aKeepSize: Boolean);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsPostProcessorShadow = class(TltsPostProcessor)
- private
- fRadius: Single;
- fStrength: Single;
- fOffset: TltsPosition;
- fColor: TltsColor4f;
- public
- property Radius: Single read fRadius;
- property Strength: Single read fStrength;
- property Offset: TltsPosition read fOffset;
- property Color: TltsColor4f read fColor;
-
- constructor Create(const aContext: TltsContext; const aRadius, aStrength: Single; const aOffset: TltsPosition; const aColor: TltsColor4f);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsPostProcessorCustom = class(TltsPostProcessor)
- protected
- procedure Execute(const aChar: TltsChar; const aImage: TltsImage); override;
- public
- constructor Create(const aContext: TltsContext);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsPostProcessorList = class(TltsPostProcessorCustom)
- private
- fItems: TObjectList;
-
- function GetCount: Integer;
- function GetItem(const aIndex: Integer): TltsPostProcessor;
- function GetOwnsObjects: Boolean;
-
- procedure SetOwnsObjects(aValue: Boolean);
-
- protected
- procedure Execute(const aChar: TltsChar; const aImage: TltsImage); override;
-
- public
- property Count: Integer read GetCount;
- property OwnsObjects: Boolean read GetOwnsObjects write SetOwnsObjects;
-
- property Items[const aIndex: Integer]: TltsPostProcessor read GetItem;
-
- procedure Add(const aPostProcessor: TltsPostProcessor);
- procedure Delete(const aIndex: Integer);
- procedure Clear;
-
- function Remove(const aPostProcessor: TltsPostProcessor): Integer;
- function IndexOf(const aPostProcessor: TltsPostProcessor): Integer;
-
- constructor Create(const aContext: TltsContext; const aOwnsObjects: Boolean);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsFont = class(TObject)
- private
- fHandle: TltsFontHandle;
- fNames: TltsFontNames;
- fMetric: TltsFontMetric;
- fPostProcessor: TltsPostProcessor;
-
- function GetCharSpacing: Integer;
- function GetLineSpacing: Single;
- function GetTabWidth: Integer;
-
- procedure SetCharSpacing(aValue: Integer);
- procedure SetLineSpacing(aValue: Single);
- procedure SetPostProcessor(aValue: TltsPostProcessor);
- procedure SetTabWidth(aValue: Integer);
- public
- property Handle: TltsFontHandle read fHandle;
- property Names: TltsFontNames read fNames;
- property Metric: TltsFontMetric read fMetric;
- property PostProcessor: TltsPostProcessor read fPostProcessor write SetPostProcessor;
-
- property TabWidth: Integer read GetTabWidth write SetTabWidth;
- property CharSpacing: Integer read GetCharSpacing write SetCharSpacing;
- property LineSpacing: Single read GetLineSpacing write SetLineSpacing;
-
- constructor Create(const aHandle: TltsFontHandle);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsFontCreator = class(TObject)
- private
- fHandle: TltsFontCreatorHandle;
- public
- property Handle: TltsFontCreatorHandle read fHandle;
-
- function GetFontByName (const aFontname: String; const aSize: Integer; const aStyle: TltsFontStyles; const aAntiAliasing: TltsAntiAliasing): TltsFont;
- function GetFontByFile (const aFilename: String; const aSize: Integer; const aStyle: TltsFontStyles; const aAntiAliasing: TltsAntiAliasing): TltsFont;
- function GetFontByStream(const aStream: TStream; const aSize: Integer; const aStyle: TltsFontStyles; const aAntiAliasing: TltsAntiAliasing): TltsFont;
-
- constructor Create(const aHandle: TltsFontCreatorHandle);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsFontCreatorGDI = class(TltsFontCreator)
- public
- constructor Create(const aContext: TltsContext);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsFontCreatorFreeType = class(TltsFontCreator)
- public
- constructor Create(const aContext: TltsContext);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsTextBlock = class(TObject)
- private
- fHandle: TltsTextBlockHandle;
- fCurrentFont: TltsFont;
-
- function GetClipping: TltsClipping;
- function GetColor: TltsColor4f;
- function GetFlags: TltsBlockFlags;
- function GetHeight: Integer;
- function GetHorzAlign: TltsHorzAlignment;
- function GetLeft: Integer;
- function GetRect: TltsRect;
- function GetTop: Integer;
- function GetVertAlign: TltsVertAlignment;
- function GetWidth: Integer;
-
- procedure SetClipping(aValue: TltsClipping);
- procedure SetColor(aValue: TltsColor4f);
- procedure SetCurrentFont(aValue: TltsFont);
- procedure SetHorzAlign(aValue: TltsHorzAlignment);
- procedure SetLeft(aValue: Integer);
- procedure SetTop(aValue: Integer);
- procedure SetVertAlign(aValue: TltsVertAlignment);
- public
- property Handle: TltsTextBlockHandle read fHandle;
- property Rect: TltsRect read GetRect;
- property Width: Integer read GetWidth;
- property Height: Integer read GetHeight;
- property Flags: TltsBlockFlags read GetFlags;
-
- property Top: Integer read GetTop write SetTop;
- property Left: Integer read GetLeft write SetLeft;
- property VertAlign: TltsVertAlignment read GetVertAlign write SetVertAlign;
- property HorzAlign: TltsHorzAlignment read GetHorzAlign write SetHorzAlign;
- property Clipping: TltsClipping read GetClipping write SetClipping;
- property CurrentColor: TltsColor4f read GetColor write SetColor;
- property CurrentFont: TltsFont read fCurrentFont write SetCurrentFont;
-
- function GetActualBlockHeight: Integer;
-
- procedure ChangeFont(const aFont: TltsFont);
- procedure ChangeColor(const aColor: TltsColor4f);
-
- procedure TextOutA(const aText: PAnsiChar);
- procedure TextOutW(const aText: PWideChar);
-
- function GetTextWidthA(const aText: PAnsiChar): Integer;
- function GetTextWidthW(const aText: PWideChar): Integer;
-
- constructor Create(const aHandle: TltsTextBlockHandle);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsImage = class(TObject)
- private
- fHandle: TltsImageHandle;
- fOwnsHandle: Boolean;
-
- function GetData: Pointer;
- function GetDataSize: Integer;
- function GetFormat: TltsFormat;
- function GetHeight: Integer;
- function GetIsEmpty: Boolean;
- function GetLineSize: Integer;
- function GetWidth: Integer;
- function GetScanline(const aIndex: Integer): Pointer;
- public
- property Handle: TltsImageHandle read fHandle;
-
- property IsEmpty: Boolean read GetIsEmpty;
- property Width: Integer read GetWidth;
- property Height: Integer read GetHeight;
- property LineSize: Integer read GetLineSize;
- property DataSize: Integer read GetDataSize;
- property Format: TltsFormat read GetFormat;
- property Data: Pointer read GetData;
-
- property Scanline[const aIndex: Integer]: Pointer read GetScanline;
-
- function GetPixelAt(const x, y: Integer; out aColor: TltsColor4f): Boolean;
-
- procedure Assign(const aImage: TltsImage);
- procedure CreateEmpty(const aFormat: TltsFormat; const aWidth, aHeight: Integer);
- procedure LoadFromFunc(const aFunc: TltsImageLoadFunc; const aArgs: Pointer);
-
- procedure Resize(const aWidth, aHeight, X, Y: Integer);
- procedure FillColor(const aColor: TltsColor4f; const aMask: TltsColorChannels; const aModes: TltsImageModes);
- procedure FillPatter(const aPattern: TltsImage; const X, Y: Integer; const aMask: TltsColorChannels; const aModes: TltsImageModes);
- procedure Blend(const aImage: TltsImage; const X, Y: Integer; const aFunc: TltsImageBlendFunc; aArgs: Pointer);
- procedure Blur(const aHorzRad, aHorzStr, aVertRad, aVertStr: Single; const aMask: TltsColorChannels);
-
- constructor CreateFromHandle(const aHandle: TltsImageHandle);
- constructor Create(const aContext: TltsContext);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsRenderer = class(TObject)
- private
- fHandle: TltsRendererHandle;
- public
- property Handle: TltsRendererHandle read fHandle;
-
- function BeginBlock(const aTop, aLeft, aWidth, aHeight: Integer; const aFlags: TltsBlockFlags): TltsTextBlock;
- procedure EndBlock(var aTextBlock: TltsTextBlock);
- procedure AbortBlock(var aTextBlock: TltsTextBlock);
-
- function GetTextWidthA(const aFont: TltsFont; const aText: PAnsiChar): Integer;
- function GetTextWidthW(const aFont: TltsFont; const aText: PWideChar): Integer;
-
- constructor Create(const aHandle: TltsRendererHandle);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsRendererOpenGL = class(TltsRenderer)
- public
- constructor Create(const aContext: TltsContext; const aFormat: TltsFormat);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsRendererOpenGLES = class(TltsRenderer)
- public
- constructor Create(const aContext: TltsContext; const aFormat: TltsFormat);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TltsRendererCustom = class(TltsRenderer)
- protected
- fDrawPos: TltsPosition;
- fColor: TltsColor4f;
-
- procedure BeginRender; virtual;
- procedure EndRender; virtual;
- function GetDrawPos: TltsPosition; virtual;
- procedure SetDrawPos(const aValue: TltsPosition); virtual;
- procedure MoveDrawPos(const aOffset: TltsPosition); virtual;
- procedure SetColor(const aValue: TltsColor4f); virtual;
- procedure Render(const aRenderRef: Pointer; const aForcedWidth: Integer = 0); virtual;
- protected
- function CreateRenderRef(const aChar: TltsChar; const aImage: TltsImage): Pointer; virtual;
- procedure FreeRenderRef(const aRenderRef: Pointer); virtual;
- public
- constructor Create(const aContext: TltsContext; const aFormat: TltsFormat);
- end;
-
- implementation
-
- {$IF DEFINED(WIN32) OR DEFINED(WIN64)}
- uses
- windows;
-
- type
- TLibHandle = HMODULE;
-
- const
- InvalidLibHandle: TLibHandle = 0;
-
- function LibOpen(const aLibName: String; out aError: String): TLibHandle;
- begin
- result := LoadLibraryA(PAnsiChar(AnsiString(aLibName)));
- if (result = 0)
- then aError := SysErrorMessage(GetLastError())
- else aError := '';
- end;
-
- function GetAddr(const aLibHandle: TLibHandle; const aName: String): Pointer;
- begin
- result := GetProcAddress(aLibHandle, PAnsiChar(AnsiString(aName)));
- end;
-
- procedure LibClose(const aLibHandle: TLibHandle);
- begin
- FreeLibrary(aLibHandle);
- end;
-
- {$ELSEIF DEFINED(LINUX)}
- uses
- dl;
-
- type
- TLibHandle = Pointer;
-
- const
- InvalidLibHandle: TLibHandle = nil;
-
- function LibOpen(const aLibName: String; out aError: String): TLibHandle;
- begin
- dlerror();
- result := dlopen(PChar(aLibName), RTLD_LAZY);
- if (result = InvalidLibHandle)
- then aError := dlerror()
- else aError := '';
- end;
-
- function GetAddr(const aLibHandle: TLibHandle; const aName: String): Pointer;
- begin
- result := dlsym(aLibHandle, PChar(aName));
- end;
-
- procedure LibClose(const aLibHandle: TLibHandle);
- begin
- dlclose(aLibHandle);
- end;
-
- {$ELSE}
- {$ERROR 'unknown operation system'}
- {$IFEND}
-
- var
- libHandle: TLibHandle;
- ltsInitializeIntern: TltsInitialize;
- ltsFinalizeIntern: TltsFinalize;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Stream Callbacks//////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsStreamReadCallback(const aArgs: Pointer; const aBuffer: Pointer; const aSize: Integer): Integer; stdcall;
- var
- s: TStream;
- begin
- result := 0;
- if not Assigned(aArgs) then
- exit;
- s := TStream(aArgs);
- result := s.Read(aBuffer^, aSize);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsStreamSeekCallback(const aArgs: Pointer; const aOrigin: TltsStreamOrigin; const aPos: Integer): Integer; stdcall;
- var
- s: TStream;
- begin
- result := 0;
- if not Assigned(aArgs) then
- exit;
- s := TStream(aArgs);
- result := s.Seek(aPos, TSeekOrigin(aOrigin));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Image Callbacks///////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- type
- PImageLoadArgs = ^TImageLoadArgs;
- TImageLoadArgs = packed record
- callback: TltsImageLoadFunc;
- image: TltsImage;
- args: Pointer;
- end;
-
- PImageBlendArgs = ^TImageBlendArgs;
- TImageBlendArgs = packed record
- callback: TltsImageBlendFunc;
- args: Pointer;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsImageLoadCallback(aHandle: TltsImageHandle; X, Y: Integer; var aPixel: TltsColor4f; aArgs: Pointer); stdcall;
- var
- p: PImageLoadArgs;
- begin
- p := PImageLoadArgs(aArgs);
- p^.callback(p^.image, X, Y, aPixel, p^.args);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsImageBlendCallback(aHandle: TltsImageHandle; aSrc, aDst: TltsColor4f; out aResult: TltsColor4f; aArgs: Pointer); stdcall;
- var
- p: PImageBlendArgs;
- begin
- p := PImageBlendArgs(aArgs);
- aResult := p^.callback(aSrc, aDst, p^.args);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //General///////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsInitialize(const aLibName: String);
-
- function LoadProc(const aName: String): Pointer;
- begin
- result := GetAddr(libHandle, aName);
- if not Assigned(result) then
- raise TltsException.CreateFmt('unable to load ''%s'' from ''%s''', [aName, aLibName]);
- end;
-
- var
- eMsg: String;
- err: TltsErrorCode;
- begin
- libHandle := LibOpen(aLibName, eMsg);
- if (libHandle = InvalidLibHandle) then
- raise TltsException.Create('unable to load library: ' + eMsg);
-
- ltsContextCreate := TltsContextCreate( LoadProc('ltsContextCreate'));
- ltsContextGetCodePage := TltsContextGetCodePage( LoadProc('ltsContextGetCodePage'));
- ltsContextGetDefaultChar := TltsContextGetDefaultChar( LoadProc('ltsContextGetDefaultChar'));
- ltsContextSetCodePage := TltsContextSetCodePage( LoadProc('ltsContextSetCodePage'));
- ltsContextSetDefaultChar := TltsContextSetDefaultChar( LoadProc('ltsContextSetDefaultChar'));
- ltsContextAnsiToWide := TltsContextAnsiToWide( LoadProc('ltsContextAnsiToWide'));
- ltsContextDestroy := TltsContextDestroy( LoadProc('ltsContextDestroy'));
-
- ltsRendererCreate := TltsRendererCreate( LoadProc('ltsRendererCreate'));
- ltsRendererCustomCreate := TltsRendererCustomCreate( LoadProc('ltsRendererCustomCreate'));
- ltsRendererBeginBlock := TltsRendererBeginBlock( LoadProc('ltsRendererBeginBlock'));
- ltsRendererEndBlock := TltsRendererEndBlock( LoadProc('ltsRendererEndBlock'));
- ltsRendererAbortBlock := TltsRendererAbortBlock( LoadProc('ltsRendererAbortBlock'));
- ltsRendererGetTextWidthA := TltsRendererGetTextWidthA( LoadProc('ltsRendererGetTextWidthA'));
- ltsRendererGetTextWidthW := TltsRendererGetTextWidthW( LoadProc('ltsRendererGetTextWidthW'));
- ltsRendererDestroy := TltsRendererDestroy( LoadProc('ltsRendererDestroy'));
-
- ltsFontCreatorCreate := TltsFontCreatorCreate( LoadProc('ltsFontCreatorCreate'));
- ltsFontCreatorGetFontByName := TltsFontCreatorGetFontByName( LoadProc('ltsFontCreatorGetFontByName'));
- ltsFontCreatorGetFontByFile := TltsFontCreatorGetFontByFile( LoadProc('ltsFontCreatorGetFontByFile'));
- ltsFontCreatorGetFontByStream := TltsFontCreatorGetFontByStream( LoadProc('ltsFontCreatorGetFontByStream'));
- ltsFontCreatorDestroy := TltsFontCreatorDestroy( LoadProc('ltsFontCreatorDestroy'));
-
- ltsFontGetPostProcessor := TltsFontGetPostProcessor( LoadProc('ltsFontGetPostProcessor'));
- ltsFontGetTabWidth := TltsFontGetTabWidth( LoadProc('ltsFontGetTabWidth'));
- ltsFontGetCharSpacing := TltsFontGetCharSpacing( LoadProc('ltsFontGetCharSpacing'));
- ltsFontGetLineSpacing := TltsFontGetLineSpacing( LoadProc('ltsFontGetLineSpacing'));
- ltsFontGetMetric := TltsFontGetMetric( LoadProc('ltsFontGetMetric'));
- ltsFontGetFontname := TltsFontGetFontname( LoadProc('ltsFontGetFontname'));
- ltsFontGetFacename := TltsFontGetFacename( LoadProc('ltsFontGetFacename'));
- ltsFontGetStylename := TltsFontGetStylename( LoadProc('ltsFontGetStylename'));
- ltsFontGetFullname := TltsFontGetFullname( LoadProc('ltsFontGetFullname'));
- ltsFontGetCopyright := TltsFontGetCopyright( LoadProc('ltsFontGetCopyright'));
- ltsFontSetPostProcessor := TltsFontSetPostProcessor( LoadProc('ltsFontSetPostProcessor'));
- ltsFontSetTabWidth := TltsFontSetTabWidth( LoadProc('ltsFontSetTabWidth'));
- ltsFontSetCharSpacing := TltsFontSetCharSpacing( LoadProc('ltsFontSetCharSpacing'));
- ltsFontSetLineSpacing := TltsFontSetLineSpacing( LoadProc('ltsFontSetLineSpacing'));
- ltsFontDestroy := TltsFontDestroy( LoadProc('ltsFontDestroy'));
-
- ltsTextBlockGetRect := TltsTextBlockGetRect( LoadProc('ltsTextBlockGetRect'));
- ltsTextBlockGetWidth := TltsTextBlockGetWidth( LoadProc('ltsTextBlockGetWidth'));
- ltsTextBlockGetHeight := TltsTextBlockGetHeight( LoadProc('ltsTextBlockGetHeight'));
- ltsTextBlockGetFlags := TltsTextBlockGetFlags( LoadProc('ltsTextBlockGetFlags'));
- ltsTextBlockGetTop := TltsTextBlockGetTop( LoadProc('ltsTextBlockGetTop'));
- ltsTextBlockGetLeft := TltsTextBlockGetLeft( LoadProc('ltsTextBlockGetLeft'));
- ltsTextBlockGetVertAlign := TltsTextBlockGetVertAlign( LoadProc('ltsTextBlockGetVertAlign'));
- ltsTextBlockGetHorzAlign := TltsTextBlockGetHorzAlign( LoadProc('ltsTextBlockGetHorzAlign'));
- ltsTextBlockGetClipping := TltsTextBlockGetClipping( LoadProc('ltsTextBlockGetClipping'));
- ltsTextBlockGetColor := TltsTextBlockGetColor( LoadProc('ltsTextBlockGetColor'));
- ltsTextBlockGetFont := TltsTextBlockGetFont( LoadProc('ltsTextBlockGetFont'));
- ltsTextBlockSetTop := TltsTextBlockSetTop( LoadProc('ltsTextBlockSetTop'));
- ltsTextBlockSetLeft := TltsTextBlockSetLeft( LoadProc('ltsTextBlockSetLeft'));
- ltsTextBlockSetVertAlign := TltsTextBlockSetVertAlign( LoadProc('ltsTextBlockSetVertAlign'));
- ltsTextBlockSetHorzAlign := TltsTextBlockSetHorzAlign( LoadProc('ltsTextBlockSetHorzAlign'));
- ltsTextBlockSetClipping := TltsTextBlockSetClipping( LoadProc('ltsTextBlockSetClipping'));
- ltsTextBlockSetColor := TltsTextBlockSetColor( LoadProc('ltsTextBlockSetColor'));
- ltsTextBlockSetFont := TltsTextBlockSetFont( LoadProc('ltsTextBlockSetFont'));
- ltsTextBlockGetActualHeight := TltsTextBlockGetActualHeight( LoadProc('ltsTextBlockGetActualHeight'));
- ltsTextBlockGetTextWidthA := TltsTextBlockGetTextWidthA( LoadProc('ltsTextBlockGetTextWidthA'));
- ltsTextBlockGetTextWidthW := TltsTextBlockGetTextWidthW( LoadProc('ltsTextBlockGetTextWidthW'));
- ltsTextBlockTextOutA := TltsTextBlockTextOutA( LoadProc('ltsTextBlockTextOutA'));
- ltsTextBlockTextOutW := TltsTextBlockTextOutW( LoadProc('ltsTextBlockTextOutW'));
- ltsTextBlockDestroy := TltsTextBlockDestroy( LoadProc('ltsTextBlockDestroy'));
-
- ltsImageCreate := TltsImageCreate( LoadProc('ltsImageCreate'));
- ltsImageIsEmpty := TltsImageIsEmpty( LoadProc('ltsImageIsEmpty'));
- ltsImageGetWidth := TltsImageGetWidth( LoadProc('ltsImageGetWidth'));
- ltsImageGetHeight := TltsImageGetHeight( LoadProc('ltsImageGetHeight'));
- ltsImageGetLineSize := TltsImageGetLineSize( LoadProc('ltsImageGetLineSize'));
- ltsImageGetDataSize := TltsImageGetDataSize( LoadProc('ltsImageGetDataSize'));
- ltsImageGetFormat := TltsImageGetFormat( LoadProc('ltsImageGetFormat'));
- ltsImageGetData := TltsImageGetData( LoadProc('ltsImageGetData'));
- ltsImageGetScanline := TltsImageGetScanline( LoadProc('ltsImageGetScanline'));
- ltsImageGetPixelAt := TltsImageGetPixelAt( LoadProc('ltsImageGetPixelAt'));
- ltsImageAssign := TltsImageAssign( LoadProc('ltsImageAssign'));
- ltsImageCreateEmpty := TltsImageCreateEmpty( LoadProc('ltsImageCreateEmpty'));
- ltsImageLoadFromFunc := TltsImageLoadFromFunc( LoadProc('ltsImageLoadFromFunc'));
- ltsImageResize := TltsImageResize( LoadProc('ltsImageResize'));
- ltsImageFillColor := TltsImageFillColor( LoadProc('ltsImageFillColor'));
- ltsImageFillPattern := TltsImageFillPattern( LoadProc('ltsImageFillPattern'));
- ltsImageBlend := TltsImageBlend( LoadProc('ltsImageBlend'));
- ltsImageBlur := TltsImageBlur( LoadProc('ltsImageBlur'));
- ltsImageDestroy := TltsImageDestroy( LoadProc('ltsImageDestroy'));
-
- ltsPostProcessorAddRange := TltsPostProcessorAddRange( LoadProc('ltsPostProcessorAddRange'));
- ltsPostProcessorAddChars := TltsPostProcessorAddChars( LoadProc('ltsPostProcessorAddChars'));
- ltsPostProcessorClearRanges := TltsPostProcessorClearRanges( LoadProc('ltsPostProcessorClearRanges'));
- ltsPostProcessorExecute := TltsPostProcessorExecute( LoadProc('ltsPostProcessorExecute'));
- ltsPostProcessorFillColorCreate := TltsPostProcessorFillColorCreate( LoadProc('ltsPostProcessorFillColorCreate'));
- ltsPostProcessorFillPatterCreate := TltsPostProcessorFillPatterCreate( LoadProc('ltsPostProcessorFillPatterCreate'));
- ltsPostProcessorBorderCreate := TltsPostProcessorBorderCreate( LoadProc('ltsPostProcessorBorderCreate'));
- ltsPostProcessorShadowCreate := TltsPostProcessorShadowCreate( LoadProc('ltsPostProcessorShadowCreate'));
- ltsPostProcessorCustomCreate := TltsPostProcessorCustomCreate( LoadProc('ltsPostProcessorCustomCreate'));
- ltsPostProcessorDestroy := TltsPostProcessorDestroy( LoadProc('ltsPostProcessorDestroy'));
-
- ltsCharGetCharCode := TltsCharGetCharCode( LoadProc('ltsCharGetCharCode'));
- ltsCharGetGlyphMetric := TltsCharGetGlyphMetric( LoadProc('ltsCharGetGlyphMetric'));
- ltsCharSetGlyphMetric := TltsCharSetGlyphMetric( LoadProc('ltsCharSetGlyphMetric'));
-
- ltsInitializeIntern := TltsInitialize( LoadProc('ltsInitialize'));
- ltsGetVersion := TltsGetVersion( LoadProc('ltsGetVersion'));
- ltsGetLastErrorCode := TltsGetLastErrorCode( LoadProc('ltsGetLastErrorCode'));
- ltsGetLastErrorMsg := TltsGetLastErrorMsg( LoadProc('ltsGetLastErrorMsg'));
- ltsFinalizeIntern := TltsFinalize( LoadProc('ltsFinalize'));
-
- err := ltsInitializeIntern();
- if (err <> ltsErrNone) then
- raise TltsException.Create('error while initializing library: ' + ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsFinalize;
- begin
- if Assigned(ltsFinalizeIntern) then
- ltsFinalizeIntern();
-
- ltsContextCreate := nil;
- ltsContextGetCodePage := nil;
- ltsContextGetDefaultChar := nil;
- ltsContextSetCodePage := nil;
- ltsContextSetDefaultChar := nil;
- ltsContextAnsiToWide := nil;
- ltsContextDestroy := nil;
-
- ltsRendererCreate := nil;
- ltsRendererBeginBlock := nil;
- ltsRendererEndBlock := nil;
- ltsRendererAbortBlock := nil;
- ltsRendererGetTextWidthA := nil;
- ltsRendererGetTextWidthW := nil;
- ltsRendererDestroy := nil;
-
- ltsFontCreatorCreate := nil;
- ltsFontCreatorGetFontByName := nil;
- ltsFontCreatorGetFontByFile := nil;
- ltsFontCreatorGetFontByStream := nil;
- ltsFontCreatorDestroy := nil;
- ltsFontGetPostProcessor := nil;
- ltsFontGetTabWidth := nil;
- ltsFontGetCharSpacing := nil;
- ltsFontGetLineSpacing := nil;
- ltsFontGetMetric := nil;
- ltsFontGetFontname := nil;
- ltsFontGetFacename := nil;
- ltsFontGetStylename := nil;
- ltsFontGetFullname := nil;
- ltsFontGetCopyright := nil;
- ltsFontSetPostProcessor := nil;
- ltsFontSetTabWidth := nil;
- ltsFontSetCharSpacing := nil;
- ltsFontSetLineSpacing := nil;
-
- ltsTextBlockGetRect := nil;
- ltsTextBlockGetWidth := nil;
- ltsTextBlockGetHeight := nil;
- ltsTextBlockGetFlags := nil;
- ltsTextBlockGetTop := nil;
- ltsTextBlockGetLeft := nil;
- ltsTextBlockGetVertAlign := nil;
- ltsTextBlockGetHorzAlign := nil;
- ltsTextBlockGetClipping := nil;
- ltsTextBlockGetColor := nil;
- ltsTextBlockGetFont := nil;
- ltsTextBlockSetTop := nil;
- ltsTextBlockSetLeft := nil;
- ltsTextBlockSetVertAlign := nil;
- ltsTextBlockSetHorzAlign := nil;
- ltsTextBlockSetClipping := nil;
- ltsTextBlockSetColor := nil;
- ltsTextBlockSetFont := nil;
- ltsTextBlockGetActualHeight := nil;
- ltsTextBlockGetTextWidthA := nil;
- ltsTextBlockGetTextWidthW := nil;
- ltsTextBlockTextOutA := nil;
- ltsTextBlockTextOutW := nil;
-
- ltsImageCreate := nil;
- ltsImageIsEmpty := nil;
- ltsImageGetWidth := nil;
- ltsImageGetHeight := nil;
- ltsImageGetLineSize := nil;
- ltsImageGetDataSize := nil;
- ltsImageGetFormat := nil;
- ltsImageGetData := nil;
- ltsImageGetScanline := nil;
- ltsImageGetPixelAt := nil;
- ltsImageAssign := nil;
- ltsImageCreateEmpty := nil;
- ltsImageLoadFromFunc := nil;
- ltsImageResize := nil;
- ltsImageFillColor := nil;
- ltsImageFillPattern := nil;
- ltsImageBlend := nil;
- ltsImageBlur := nil;
- ltsImageDestroy := nil;
-
- ltsPostProcessorAddRange := nil;
- ltsPostProcessorAddChars := nil;
- ltsPostProcessorClearRanges := nil;
- ltsPostProcessorFillColorCreate := nil;
- ltsPostProcessorFillPatterCreate := nil;
- ltsPostProcessorBorderCreate := nil;
- ltsPostProcessorShadowCreate := nil;
-
- ltsInitializeIntern := nil;
- ltsGetLastErrorCode := nil;
- ltsGetLastErrorMsg := nil;
- ltsFinalizeIntern := nil;
-
- if (libHandle <> InvalidLibHandle) then begin
- LibClose(libHandle);
- libHandle := InvalidLibHandle;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Utils/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsColor4f(r, g, b, a: Single): TltsColor4f;
- begin
- result.r := r;
- result.g := g;
- result.b := b;
- result.a := a;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsPosition(const x, y: Integer): TltsPosition;
- begin
- result.x := x;
- result.y := y;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsRect(const l, t, r, b: Integer): TltsRect;
- begin
- result.Left := l;
- result.Top := t;
- result.Right := r;
- result.Bottom := b;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsRect(const aTopLeft, aBottomRight: TltsPosition): TltsRect;
- begin
- result.TopLeft := aTopLeft;
- result.BottomRight := aBottomRight;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsVector4f(X, Y, Z, W: Single): TltsVector4f;
- begin
- result[0] := X;
- result[1] := Y;
- result[2] := Z;
- result[3] := W;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsMatrix4f(X, Y, Z, P: TltsVector4f): TltsMatrix4f;
- begin
- result[0] := X;
- result[1] := Y;
- result[2] := Z;
- result[3] := P;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsException/////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsException.Create(const aMessage: String; const aErrorCode: TltsErrorCode);
- begin
- inherited Create(aMessage);
- fErrorCode := aErrorCode;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsContext///////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsContext.GetCodePage: TltsCodePage;
- var
- err: TltsErrorCode;
- begin
- err := ltsContextGetCodePage(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsContext.GetDefaultChar: WideChar;
- var
- err: TltsErrorCode;
- begin
- err := ltsContextGetDefaultChar(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsContext.SetCodePage(aValue: TltsCodePage);
- var
- err: TltsErrorCode;
- begin
- err := ltsContextSetCodePage(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsContext.SetDefaultChar(aValue: WideChar);
- var
- err: TltsErrorCode;
- begin
- err := ltsContextSetDefaultChar(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsContext.Create;
- begin
- inherited Create;
- fHandle := ltsContextCreate();
- if not Assigned(fHandle) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TltsContext.Destroy;
- begin
- if Assigned(fHandle) then begin
- ltsContextDestroy(fHandle);
- fHandle := nil;
- end;
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsChar//////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsChar.GetCharCode: WideChar;
- var
- err: TltsErrorCode;
- begin
- err := ltsCharGetCharCode(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsChar.GetGlyphMetric: TltsGlyphMetric;
- var
- err: TltsErrorCode;
- begin
- err := ltsCharGetGlyphMetric(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsChar.SetGlyphMetric(aValue: TltsGlyphMetric);
- var
- err: TltsErrorCode;
- begin
- err := ltsCharSetGlyphMetric(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsChar.CreateFromHandle(const aHandle: TltsCharHandle);
- begin
- inherited Create;
- fHandle := aHandle;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsPostProcessor/////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsPostProcessor.Execute(const aChar: TltsChar; const aImage: TltsImage);
- var
- err: TltsErrorCode;
- begin
- err := ltsPostProcessorExecute(fHandle, aChar.Handle, aImage.Handle);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsPostProcessor.AddRange(const aUsage: TltsCharRangeUsage; const aStart, aStop: WideChar);
- var
- err: TltsErrorCode;
- begin
- err := ltsPostProcessorAddRange(fHandle, aUsage, aStart, aStop);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsPostProcessor.AddChars(const aUsage: TltsCharRangeUsage; const aChars: PWideChar);
- var
- err: TltsErrorCode;
- begin
- err := ltsPostProcessorAddChars(fHandle, aUsage, aChars);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsPostProcessor.ClearRanges;
- var
- err: TltsErrorCode;
- begin
- err := ltsPostProcessorClearRanges(fHandle);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsPostProcessor.Create(const aHandle: TltsPostProcessorHandle);
- begin
- inherited Create;
- fHandle := aHandle;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TltsPostProcessor.Destroy;
- begin
- if Assigned(fHandle) then begin
- ltsPostProcessorDestroy(fHandle);
- fHandle := nil;
- end;
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsPostProcessorFillColor////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsPostProcessorFillColor.Create(const aContext: TltsContext; const aColor: TltsColor4f;
- const aModes: TltsImageModes; const aChannels: TltsColorChannels);
- var
- h: TltsPostProcessorHandle;
- begin
- fColor := aColor;
- fModes := aModes;
- fChannels := aChannels;
- h := ltsPostProcessorFillColorCreate(aContext.Handle, fColor, fModes, fChannels);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- inherited Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsPostProcessorFillPattern//////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsPostProcessorFillPattern.Create(const aContext: TltsContext; const aPattern: TltsImage; const aOwnsPatter: Boolean;
- const aPosition: TltsPosition; const aModes: TltsImageModes; const aChannels: TltsColorChannels);
- var
- h: TltsPostProcessorHandle;
- begin
- fPattern := aPattern;
- fOwnsPattern := aOwnsPatter;
- fPosition := aPosition;
- fModes := aModes;
- fChannels := aChannels;
- h := ltsPostProcessorFillPatterCreate(aContext.Handle, fPattern.Handle, fOwnsPattern, fPosition, fModes, fChannels);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- inherited Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TltsPostProcessorFillPattern.Destroy;
- begin
- inherited Destroy;
- if Assigned(fPattern) and fOwnsPattern then
- FreeAndNil(fPattern);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsPostProcessorBorder///////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsPostProcessorBorder.Create(const aContext: TltsContext; const aWidth, aStrength: Single;
- const aColor: TltsColor4f; const aKeepSize: Boolean);
- var
- h: TltsPostProcessorHandle;
- begin
- fWidth := aWidth;
- fStrength := aStrength;
- fColor := aColor;
- fKeepSize := aKeepSize;
- h := ltsPostProcessorBorderCreate(aContext.Handle, fWidth, fStrength, fColor, fKeepSize);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- inherited Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsPostProcessorShadow///////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsPostProcessorShadow.Create(const aContext: TltsContext; const aRadius, aStrength: Single;
- const aOffset: TltsPosition; const aColor: TltsColor4f);
- var
- h: TltsPostProcessorHandle;
- begin
- fRadius := aRadius;
- fStrength := aStrength;
- fOffset := aOffset;
- fColor := aColor;
- h := ltsPostProcessorShadowCreate(aContext.Handle, fRadius, fStrength, fOffset, fColor);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- inherited Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsPostProcessorCustom///////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsPostProcessorExecuteCallback(const aChar: TltsCharHandle; const aImage: TltsImageHandle; aArgs: Pointer); stdcall;
- var
- chr: TltsChar;
- img: TltsImage;
- begin
- chr := TltsChar.CreateFromHandle(aChar);
- img := TltsImage.CreateFromHandle(aImage);
- try
- TltsPostProcessorCustom(aArgs).Execute(chr, img);
- finally
- FreeAndNil(img);
- FreeAndNil(chr);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsPostProcessorCustom.Execute(const aChar: TltsChar; const aImage: TltsImage);
- begin
- // calling inherited will cause infinite loop !!!
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsPostProcessorCustom.Create(const aContext: TltsContext);
- var
- h: TltsPostProcessorHandle;
- p: TltsPostProcessorCustomData;
- begin
- p.args := self;
- p.execute := @ltsPostProcessorExecuteCallback;
- h := ltsPostProcessorCustomCreate(aContext.Handle, p);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- inherited Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsPostProcessorList/////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsPostProcessorList.GetCount: Integer;
- begin
- result := fItems.Count;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsPostProcessorList.GetItem(const aIndex: Integer): TltsPostProcessor;
- begin
- result := TltsPostProcessor(fItems[aIndex]);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsPostProcessorList.GetOwnsObjects: Boolean;
- begin
- result := fItems.OwnsObjects;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsPostProcessorList.SetOwnsObjects(aValue: Boolean);
- begin
- fItems.OwnsObjects := aValue;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsPostProcessorList.Execute(const aChar: TltsChar; const aImage: TltsImage);
- var
- i: Integer;
- begin
- inherited Execute(aChar, aImage);
- for i := 0 to fItems.Count-1 do
- TltsPostProcessor(fItems[i]).Execute(aChar, aImage);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsPostProcessorList.Add(const aPostProcessor: TltsPostProcessor);
- begin
- fItems.Add(aPostProcessor);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsPostProcessorList.Delete(const aIndex: Integer);
- begin
- fItems.Delete(aIndex);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsPostProcessorList.Clear;
- begin
- fItems.Clear;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsPostProcessorList.Remove(const aPostProcessor: TltsPostProcessor): Integer;
- begin
- result := fItems.Remove(aPostProcessor);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsPostProcessorList.IndexOf(const aPostProcessor: TltsPostProcessor): Integer;
- begin
- result := fItems.IndexOf(aPostProcessor);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsPostProcessorList.Create(const aContext: TltsContext; const aOwnsObjects: Boolean);
- begin
- inherited Create(aContext);
- fItems := TObjectList.Create(aOwnsObjects);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TltsPostProcessorList.Destroy;
- begin
- FreeAndNil(fItems);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsFont//////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsFont.GetCharSpacing: Integer;
- var
- err: TltsErrorCode;
- begin
- err := ltsFontGetCharSpacing(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsFont.GetLineSpacing: Single;
- var
- err: TltsErrorCode;
- begin
- err := ltsFontGetLineSpacing(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsFont.GetTabWidth: Integer;
- var
- err: TltsErrorCode;
- begin
- err := ltsFontGetTabWidth(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsFont.SetCharSpacing(aValue: Integer);
- var
- err: TltsErrorCode;
- begin
- err := ltsFontSetCharSpacing(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsFont.SetLineSpacing(aValue: Single);
- var
- err: TltsErrorCode;
- begin
- err := ltsFontSetLineSpacing(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsFont.SetPostProcessor(aValue: TltsPostProcessor);
- var
- err: TltsErrorCode;
- begin
- err := ltsFontSetPostProcessor(fHandle, aValue.Handle);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsFont.SetTabWidth(aValue: Integer);
- var
- err: TltsErrorCode;
- begin
- err := ltsFontSetTabWidth(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsFont.Create(const aHandle: TltsFontHandle);
-
- procedure HandleErr(const aError: TltsErrorCode);
- begin
- if (aError <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), aError);
- end;
-
- procedure HandleName(const aValue: PAnsiChar; var aName: String);
- begin
- if not Assigned(aValue) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- aName := aValue;
- end;
-
- begin
- inherited Create;
- fHandle := aHandle;
-
- HandleErr (ltsFontGetMetric(fHandle, fMetric));
- HandleName(ltsFontGetCopyright(fHandle), fNames.Copyright);
- HandleName(ltsFontGetFacename(fHandle), fNames.Facename);
- HandleName(ltsFontGetFontname(fHandle), fNames.Fontname);
- HandleName(ltsFontGetFullname(fHandle), fNames.Fullname);
- HandleName(ltsFontGetStylename(fHandle), fNames.Stylename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TltsFont.Destroy;
- begin
- if Assigned(fHandle) then begin
- ltsFontDestroy(fHandle);
- fHandle := nil;
- end;
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsFontCreator///////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsFontCreator.GetFontByName(const aFontname: String; const aSize: Integer; const aStyle: TltsFontStyles; const aAntiAliasing: TltsAntiAliasing): TltsFont;
- var
- h: TltsFontHandle;
- begin
- h := ltsFontCreatorGetFontByName(fHandle, PAnsiChar(aFontname), aSize, aStyle, aAntiAliasing);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- result := TltsFont.Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsFontCreator.GetFontByFile(const aFilename: String; const aSize: Integer; const aStyle: TltsFontStyles; const aAntiAliasing: TltsAntiAliasing): TltsFont;
- var
- h: TltsFontHandle;
- begin
- h := ltsFontCreatorGetFontByFile(fHandle, PAnsiChar(aFilename), aSize, aStyle, aAntiAliasing);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- result := TltsFont.Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsFontCreator.GetFontByStream(const aStream: TStream; const aSize: Integer; const aStyle: TltsFontStyles; const aAntiAliasing: TltsAntiAliasing): TltsFont;
- var
- h: TltsFontHandle;
- s: TltsStream;
- begin
- s.args := Pointer(aStream);
- s.read := @ltsStreamReadCallback;
- s.seek := @ltsStreamSeekCallback;
- h := ltsFontCreatorGetFontByStream(fHandle, @s, aSize, aStyle, aAntiAliasing);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- result := TltsFont.Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsFontCreator.Create(const aHandle: TltsFontCreatorHandle);
- begin
- inherited Create;
- fHandle := aHandle;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TltsFontCreator.Destroy;
- begin
- if Assigned(fHandle) then begin
- ltsFontCreatorDestroy(fHandle);
- fHandle := nil;
- end;
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsFontCreatorGDI////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsFontCreatorGDI.Create(const aContext: TltsContext);
- var
- h: TltsFontCreatorHandle;
- begin
- h := ltsFontCreatorCreate(aContext.Handle, ltsFontCreatorGDI);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- inherited Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsFontCreatorFreeType///////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsFontCreatorFreeType.Create(const aContext: TltsContext);
- var
- h: TltsFontCreatorHandle;
- begin
- h := ltsFontCreatorCreate(aContext.Handle, ltsFontCreatorFreeType);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- inherited Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsTextBlock/////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetClipping: TltsClipping;
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockGetClipping(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetColor: TltsColor4f;
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockGetColor(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetFlags: TltsBlockFlags;
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockGetFlags(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetHeight: Integer;
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockGetHeight(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetHorzAlign: TltsHorzAlignment;
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockGetHorzAlign(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetLeft: Integer;
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockGetLeft(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetRect: TltsRect;
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockGetRect(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetTop: Integer;
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockGetTop(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetVertAlign: TltsVertAlignment;
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockGetVertAlign(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetWidth: Integer;
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockGetWidth(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsTextBlock.SetClipping(aValue: TltsClipping);
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockSetClipping(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsTextBlock.SetColor(aValue: TltsColor4f);
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockSetColor(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsTextBlock.SetCurrentFont(aValue: TltsFont);
- var
- err: TltsErrorCode;
- begin
- fCurrentFont := aValue;
- err := ltsTextBlockSetFont(fHandle, fCurrentFont.Handle);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsTextBlock.SetHorzAlign(aValue: TltsHorzAlignment);
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockSetHorzAlign(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsTextBlock.SetLeft(aValue: Integer);
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockSetLeft(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsTextBlock.SetTop(aValue: Integer);
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockSetTop(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsTextBlock.SetVertAlign(aValue: TltsVertAlignment);
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockSetVertAlign(fHandle, aValue);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetActualBlockHeight: Integer;
- begin
- result := ltsTextBlockGetActualHeight(fHandle);
- if (result < 0) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsTextBlock.ChangeFont(const aFont: TltsFont);
- begin
- SetCurrentFont(aFont);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsTextBlock.ChangeColor(const aColor: TltsColor4f);
- begin
- SetColor(aColor);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsTextBlock.TextOutA(const aText: PAnsiChar);
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockTextOutA(fHandle, aText);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsTextBlock.TextOutW(const aText: PWideChar);
- var
- err: TltsErrorCode;
- begin
- err := ltsTextBlockTextOutW(fHandle, aText);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetTextWidthA(const aText: PAnsiChar): Integer;
- begin
- result := ltsTextBlockGetTextWidthA(fHandle, aText);
- if (result < 0) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsTextBlock.GetTextWidthW(const aText: PWideChar): Integer;
- begin
- result := ltsTextBlockGetTextWidthW(fHandle, aText);
- if (result < 0) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsTextBlock.Create(const aHandle: TltsTextBlockHandle);
- begin
- inherited Create;
- fHandle := aHandle;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TltsTextBlock.Destroy;
- begin
- if Assigned(fHandle) then begin
- ltsTextBlockDestroy(fHandle);
- fHandle := nil;
- end;
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsImage/////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsImage.GetData: Pointer;
- begin
- result := ltsImageGetData(fHandle);
- if not Assigned(result) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsImage.GetDataSize: Integer;
- begin
- result := ltsImageGetDataSize(fHandle);
- if (result < 0) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsImage.GetFormat: TltsFormat;
- var
- err: TltsErrorCode;
- begin
- err := ltsImageGetFormat(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsImage.GetHeight: Integer;
- begin
- result := ltsImageGetHeight(fHandle);
- if (result < 0) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsImage.GetIsEmpty: Boolean;
- var
- err: TltsErrorCode;
- begin
- err := ltsImageIsEmpty(fHandle, result);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsImage.GetLineSize: Integer;
- begin
- result := ltsImageGetLineSize(fHandle);
- if (result < 0) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsImage.GetWidth: Integer;
- begin
- result := ltsImageGetWidth(fHandle);
- if (result < 0) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsImage.GetScanline(const aIndex: Integer): Pointer;
- begin
- result := ltsImageGetScanline(fHandle, aIndex);
- if not Assigned(result) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsImage.GetPixelAt(const x, y: Integer; out aColor: TltsColor4f): Boolean;
- var
- err: TltsErrorCode;
- begin
- err := ltsImageGetPixelAt(fHandle, x, y, aColor);
- case err of
- ltsErrNone: result := true;
- ltsErrInvalidValue: result := false;
- else
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsImage.Assign(const aImage: TltsImage);
- var
- err: TltsErrorCode;
- begin
- err := ltsImageAssign(fHandle, aImage.Handle);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsImage.CreateEmpty(const aFormat: TltsFormat; const aWidth, aHeight: Integer);
- var
- err: TltsErrorCode;
- begin
- err := ltsImageCreateEmpty(fHandle, aFormat, aWidth, aHeight);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsImage.LoadFromFunc(const aFunc: TltsImageLoadFunc; const aArgs: Pointer);
- var
- err: TltsErrorCode;
- ila: TImageLoadArgs;
- begin
- ila.args := aArgs;
- ila.callback := aFunc;
- ila.image := self;
- err := ltsImageLoadFromFunc(fHandle, @ltsImageLoadCallback, @ila);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsImage.Resize(const aWidth, aHeight, X, Y: Integer);
- var
- err: TltsErrorCode;
- begin
- err := ltsImageResize(fHandle, aWidth, aHeight, X, Y);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsImage.FillColor(const aColor: TltsColor4f; const aMask: TltsColorChannels; const aModes: TltsImageModes);
- var
- err: TltsErrorCode;
- begin
- err := ltsImageFillColor(fHandle, aColor, aMask, aModes);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsImage.FillPatter(const aPattern: TltsImage; const X, Y: Integer; const aMask: TltsColorChannels; const aModes: TltsImageModes);
- var
- err: TltsErrorCode;
- begin
- err := ltsImageFillPattern(fHandle, aPattern.Handle, X, Y, aMask, aModes);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsImage.Blend(const aImage: TltsImage; const X, Y: Integer; const aFunc: TltsImageBlendFunc; aArgs: Pointer);
- var
- err: TltsErrorCode;
- iba: TImageBlendArgs;
- begin
- iba.callback := aFunc;
- iba.args := aArgs;
- err := ltsImageLoadFromFunc(fHandle, @ltsImageLoadCallback, @iba);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsImage.Blur(const aHorzRad, aHorzStr, aVertRad, aVertStr: Single; const aMask: TltsColorChannels);
- var
- err: TltsErrorCode;
- begin
- err := ltsImageBlur(fHandle, aHorzRad, aHorzStr, aVertRad, aVertStr, aMask);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsImage.CreateFromHandle(const aHandle: TltsImageHandle);
- begin
- inherited Create;
- fHandle := aHandle;
- fOwnsHandle := false;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsImage.Create(const aContext: TltsContext);
- begin
- fOwnsHandle := true;
- fHandle := ltsImageCreate(aContext.Handle);
- if not Assigned(fHandle) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- inherited Create;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TltsImage.Destroy;
- begin
- if Assigned(fHandle) and fOwnsHandle then
- ltsImageDestroy(fHandle);
- fHandle := nil;
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsRenderer//////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsRenderer.BeginBlock(const aTop, aLeft, aWidth, aHeight: Integer; const aFlags: TltsBlockFlags): TltsTextBlock;
- var
- h: TltsTextBlockHandle;
- begin
- h := ltsRendererBeginBlock(fHandle, aTop, aLeft, aWidth, aHeight, aFlags);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- result := TltsTextBlock.Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsRenderer.EndBlock(var aTextBlock: TltsTextBlock);
- var
- err: TltsErrorCode;
- begin
- try
- err := ltsRendererEndBlock(fHandle, aTextBlock.Handle);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- finally
- FreeAndNil(aTextBlock);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsRenderer.AbortBlock(var aTextBlock: TltsTextBlock);
- var
- err: TltsErrorCode;
- begin
- try
- err := ltsRendererAbortBlock(fHandle, aTextBlock.Handle);
- if (err <> ltsErrNone) then
- raise TltsException.Create(ltsGetLastErrorMsg(), err);
- finally
- FreeAndNil(aTextBlock);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsRenderer.GetTextWidthA(const aFont: TltsFont; const aText: PAnsiChar): Integer;
- begin
- result := ltsRendererGetTextWidthA(fHandle, aFont.Handle, aText);
- if (result < 0) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsRenderer.GetTextWidthW(const aFont: TltsFont; const aText: PWideChar): Integer;
- begin
- result := ltsRendererGetTextWidthW(fHandle, aFont.Handle, aText);
- if (result < 0) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsRenderer.Create(const aHandle: TltsRendererHandle);
- begin
- inherited Create;
- fHandle := aHandle;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TltsRenderer.Destroy;
- begin
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsRendererOpenGL////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsRendererOpenGL.Create(const aContext: TltsContext; const aFormat: TltsFormat);
- var
- h: TltsRendererHandle;
- begin
- h := ltsRendererCreate(aContext.Handle, ltsRendererOpenGL, aFormat);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- inherited Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsRendererOpenGLES//////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsRendererOpenGLES.Create(const aContext: TltsContext; const aFormat: TltsFormat);
- var
- h: TltsRendererHandle;
- begin
- h := ltsRendererCreate(aContext.Handle, ltsRendererOpenGLES, aFormat);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- inherited Create(h);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TltsRendererCustom////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsRendererCustomBeginRender(aArgs: Pointer); stdcall;
- begin
- TltsRendererCustom(aArgs).BeginRender;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsRendererCustomEndRender(aArgs: Pointer); stdcall;
- begin
- TltsRendererCustom(aArgs).EndRender;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsRendererCustomGetDrawPos(aArgs: Pointer): TltsPosition; stdcall;
- begin
- result := TltsRendererCustom(aArgs).GetDrawPos;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsRendererCustomSetDrawPos(const aValue: TltsPosition; aArgs: Pointer); stdcall;
- begin
- TltsRendererCustom(aArgs).SetDrawPos(aValue);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsRendererCustomMoveDrawPos(const aOffset: TltsPosition; aArgs: Pointer); stdcall;
- begin
- TltsRendererCustom(aArgs).MoveDrawPos(aOffset);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsRendererCustomSetColor(const aValue: TltsColor4f; aArgs: Pointer); stdcall;
- begin
- TltsRendererCustom(aArgs).SetColor(aValue);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsRendererCustomRender(const aRef: Pointer; const aForcedWidth: Integer; aArgs: Pointer); stdcall;
- begin
- TltsRendererCustom(aArgs).Render(aRef, aForcedWidth);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsRendererCustomCreateRef(const aChar: TltsCharHandle; const aImage: TltsImageHandle; aArgs: Pointer): Pointer; stdcall;
- var
- chr: TltsChar;
- img: TltsImage;
- begin
- chr := TltsChar.CreateFromHandle(aChar);
- img := TltsImage.CreateFromHandle(aImage);
- try
- result := TltsRendererCustom(aArgs).CreateRenderRef(chr, img);
- finally
- FreeAndNil(img);
- FreeAndNil(chr);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure ltsRendererCustomFreeRef(const aRef: Pointer; aArgs: Pointer); stdcall;
- begin
- TltsRendererCustom(aArgs).FreeRenderRef(aRef);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsRendererCustom.BeginRender;
- begin
- // DUMMY
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsRendererCustom.EndRender;
- begin
- // DUMMY
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsRendererCustom.GetDrawPos: TltsPosition;
- begin
- result := fDrawPos;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsRendererCustom.SetDrawPos(const aValue: TltsPosition);
- begin
- fDrawPos := aValue;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsRendererCustom.MoveDrawPos(const aOffset: TltsPosition);
- begin
- fDrawPos.x := fDrawPos.x + aOffset.x;
- fDrawPos.y := fDrawPos.y + aOffset.y;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsRendererCustom.SetColor(const aValue: TltsColor4f);
- begin
- fColor := aValue;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsRendererCustom.Render(const aRenderRef: Pointer; const aForcedWidth: Integer);
- begin
- // DUMMY
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TltsRendererCustom.CreateRenderRef(const aChar: TltsChar; const aImage: TltsImage): Pointer;
- begin
- result := nil; // DUMMY
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TltsRendererCustom.FreeRenderRef(const aRenderRef: Pointer);
- begin
- // DUMMY
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TltsRendererCustom.Create(const aContext: TltsContext; const aFormat: TltsFormat);
- var
- h: TltsRendererHandle;
- d: TltsRendererCustomData;
- begin
- d.args := self;
- d.BeginRender := @ltsRendererCustomBeginRender;
- d.EndRender := @ltsRendererCustomEndRender;
- d.GetDrawPos := @ltsRendererCustomGetDrawPos;
- d.SetDrawPos := @ltsRendererCustomSetDrawPos;
- d.MoveDrawPos := @ltsRendererCustomMoveDrawPos;
- d.SetColor := @ltsRendererCustomSetColor;
- d.Render := @ltsRendererCustomRender;
- d.CreatRef := @ltsRendererCustomCreateRef;
- d.FreeRef := @ltsRendererCustomFreeRef;
- h := ltsRendererCustomCreate(aContext.Handle, aFormat, d);
- if not Assigned(h) then
- raise TltsException.Create(ltsGetLastErrorMsg(), ltsGetLastErrorCode());
- inherited Create(h);
- end;
-
- end.
|