opengl
/
libTextSuite
1
0
複製 0
程式碼 問題管理 0 合併請求 0 版本發佈 0 Wiki Activity
瀏覽代碼

* implemented header for fpc 

* added example for fpc
master
Bergmann89 10 年之前
父節點
cb3db5ffd8
當前提交
aacc1a3ad1
共有 11 個文件被更改，包括 2653 次插入 和 213 次删除
分割檢視
Diff Options
Show Stats Download Patch File Download Diff File
  1. +93
    -0
      header/examples/fpc/example.lpi
  2. +20
    -0
      header/examples/fpc/example.lpr
  3. +12
    -0
      header/examples/fpc/uMainForm.lfm
  4. +95
    -0
      header/examples/fpc/uMainForm.pas
  5. +2030
    -0
      header/ulibTextSuite.pas
  6. +334
    -2
      libTextSuite.lpi
  7. +6
    -11
      libTextSuite.lpr
  8. +22
    -0
      ultsFont.pas
  9. +10
    -10
      ultsImage.pas
  10. +9
    -190
      ultsPostProcessor.pas
  11. +22
    -0
      ultsTextBlock.pas

+ 93
- 0
header/examples/fpc/example.lpi 查看文件

@@ -0,0 +1,93 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="example"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="example.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainForm"/>
</Unit1>
<Unit2>
<Filename Value="..\..\ulibTextSuite.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ulibTextSuite"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="example"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\..\..\OpenGlCore;..\.."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5024="True"/>
</CompilerMessages>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

+ 20
- 0
header/examples/fpc/example.lpr 查看文件

@@ -0,0 +1,20 @@
program example;

{$mode objfpc}{$H+}

uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, uMainForm, ulibTextSuite;

{$R *.res}

begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.


+ 12
- 0
header/examples/fpc/uMainForm.lfm 查看文件

@@ -0,0 +1,12 @@
object MainForm: TMainForm
Left = 485
Height = 240
Top = 255
Width = 320
Caption = 'libTextSuite'
OnCreate = FormCreate
OnDestroy = FormDestroy
OnPaint = FormPaint
OnResize = FormResize
LCLVersion = '1.3'
end

+ 95
- 0
header/examples/fpc/uMainForm.pas 查看文件

@@ -0,0 +1,95 @@
unit uMainForm;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
uglcContext;

type
TMainForm = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
private
fContext: TglcContext;
procedure Render;
end;

var
MainForm: TMainForm;

implementation

{$R *.lfm}

uses
dglOpenGL;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//MainForm//////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormCreate(Sender: TObject);
var
pf: TglcContextPixelFormatSettings;
begin
pf := TglcContext.MakePF();
fContext := TglcContext.GetPlatformClass.Create(self, pf);
fContext.BuildContext;
fContext.Activate;

glDisable(GL_DEPTH_TEST);
glDisable(GL_CULL_FACE);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormDestroy(Sender: TObject);
begin
FreeAndNil(fContext);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormPaint(Sender: TObject);
begin
Render;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormResize(Sender: TObject);
begin
if Assigned(fContext) then begin
glViewport(0, 0, ClientWidth, ClientHeight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glOrtho(0, ClientWidth, ClientHeight, 0, 10, -10);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.Render;
const
X = 100;
var
w, h: Integer;
begin
w := ClientWidth;
h := ClientHeight;

glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glColor4f(1.0, 1.0, 1.0, 1.0);
glBegin(GL_QUADS);
glVertex2f(X, X);
glVertex2f(X, h-X);
glVertex2f(w-X, h-X);
glVertex2f(w-X, X);
glEnd;
fContext.SwapBuffers;
end;

end.


+ 2030
- 0
header/ulibTextSuite.pas
文件差異過大導致無法顯示
查看文件


+ 334
- 2
libTextSuite.lpi 查看文件

@@ -20,8 +20,336 @@
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<BuildModes Count="9">
<Item1 Name="Default" Default="True"/>
<Item2 Name="Win64Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="libTextSuite-$(TargetCPU)-$(TargetOS)"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="TextSuite;Utils;OpenGlCore"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<RelocatableUnit Value="True"/>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<TargetCPU Value="x86_64"/>
<TargetOS Value="win64"/>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
<UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5024="True"/>
</CompilerMessages>
</Other>
</CompilerOptions>
</Item2>
<Item3 Name="Win64Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="libTextSuite-$(TargetCPU)-$(TargetOS)"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="TextSuite;Utils;OpenGlCore"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<RelocatableUnit Value="True"/>
<TargetCPU Value="x86_64"/>
<TargetOS Value="win64"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5024="True"/>
</CompilerMessages>
</Other>
</CompilerOptions>
</Item3>
<Item4 Name="Win32Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="libTextSuite-$(TargetCPU)-$(TargetOS)"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="TextSuite;Utils;OpenGlCore"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<RelocatableUnit Value="True"/>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
<UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5024="True"/>
</CompilerMessages>
</Other>
</CompilerOptions>
</Item4>
<Item5 Name="Win32Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="libTextSuite-$(TargetCPU)-$(TargetOS)"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="TextSuite;Utils;OpenGlCore"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<RelocatableUnit Value="True"/>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5024="True"/>
</CompilerMessages>
</Other>
</CompilerOptions>
</Item5>
<Item6 Name="Linux32Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="libTextSuite-$(TargetCPU)-$(TargetOS)"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="TextSuite;Utils;OpenGlCore"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<RelocatableUnit Value="True"/>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<TargetCPU Value="i386"/>
<TargetOS Value="linux"/>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
<UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5024="True"/>
</CompilerMessages>
</Other>
</CompilerOptions>
</Item6>
<Item7 Name="Linus32Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="libTextSuite-$(TargetCPU)-$(TargetOS)"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="TextSuite;Utils;OpenGlCore"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<RelocatableUnit Value="True"/>
<TargetCPU Value="i386"/>
<TargetOS Value="linux"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5024="True"/>
</CompilerMessages>
</Other>
</CompilerOptions>
</Item7>
<Item8 Name="Linux64Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="libTextSuite-$(TargetCPU)-$(TargetOS)"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="TextSuite;Utils;OpenGlCore"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<RelocatableUnit Value="True"/>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<TargetCPU Value="x86_64"/>
<TargetOS Value="linux"/>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
<UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5024="True"/>
</CompilerMessages>
</Other>
</CompilerOptions>
</Item8>
<Item9 Name="Linux64Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="libTextSuite-$(TargetCPU)-$(TargetOS)"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="TextSuite;Utils;OpenGlCore"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<RelocatableUnit Value="True"/>
<TargetCPU Value="x86_64"/>
<TargetOS Value="linux"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5024="True"/>
</CompilerMessages>
</Other>
</CompilerOptions>
</Item9>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
@@ -91,7 +419,7 @@
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="libTextSuite"/>
<Filename Value="libTextSuite-$(TargetCPU)-$(TargetOS)"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
@@ -102,6 +430,10 @@
<RelocatableUnit Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<ExecutableType Value="Library"/>
</Options>


+ 6
- 11
libTextSuite.lpr 查看文件

@@ -17,6 +17,9 @@ exports
ltsRendererCreate,
ltsRendererBeginBlock,
ltsRendererEndBlock,
ltsRendererAbortBlock,
ltsRendererGetTextWidthA,
ltsRendererGetTextWidthW,
ltsRendererDestroy,

ltsFontCreatorCreate,
@@ -39,6 +42,7 @@ exports
ltsFontSetTabWidth,
ltsFontSetCharSpacing,
ltsFontSetLineSpacing,
ltsFontDestroy,

ltsTextBlockGetRect,
ltsTextBlockGetWidth,
@@ -63,6 +67,7 @@ exports
ltsTextBlockGetTextWidthW,
ltsTextBlockTextOutA,
ltsTextBlockTextOutW,
ltsTextBlockDestroy,

ltsImageCreate,
ltsImageIsEmpty,
@@ -73,7 +78,7 @@ exports
ltsImageGetFormat,
ltsImageGetData,
ltsImageGetScanline,
lstImageGetPixelAt,
ltsImageGetPixelAt,
ltsImageAssign,
ltsImageCreateEmpty,
ltsImageLoadFromFunc,
@@ -91,16 +96,6 @@ exports
ltsPostProcessorFillPatterCreate,
ltsPostProcessorBorderCreate,
ltsPostProcessorShadowCreate,
ltsPostProcessorListCreate,
ltsPostProcessorListGetCount,
ltsPostProcessorListGetItem,
ltsPostProcessorListGetOwnsObjects,
ltsPostProcessorListSetOwnsObjects,
ltsPostProcessorListAdd,
ltsPostProcessorListDel,
ltsPostProcessorListClear,
ltsPostProcessorListRem,
ltsPostProcessorListIndexOf,

ltsInitialize,
ltsGetLastErrorCode,


+ 22
- 0
ultsFont.pas 查看文件

@@ -26,6 +26,8 @@ function ltsFontSetTabWidth (const aHandle: TltsFontHandle; const aV
function ltsFontSetCharSpacing (const aHandle: TltsFontHandle; const aValue: Integer): TltsErrorCode; stdcall;
function ltsFontSetLineSpacing (const aHandle: TltsFontHandle; const aValue: Single): TltsErrorCode; stdcall;

function ltsFontDestroy (const aHandle: TltsFontHandle): TltsErrorCode; stdcall;

implementation

uses
@@ -280,5 +282,25 @@ begin
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFontDestroy(const aHandle: TltsFontHandle): TltsErrorCode; stdcall;
var
f: TtsFont;
begin
try
result := ltsErrNone;
if CheckFontHandle(aHandle, f) then begin
DelReference(ltsObjTypeFont, f);
FreeAndNil(f);
end else
result := LastErrorCode;
except
on ex: Exception do begin
SetLastError(ex);
result := LastErrorCode;
end;
end;
end;

end.


+ 10
- 10
ultsImage.pas 查看文件

@@ -10,8 +10,8 @@ uses
ultsTypes;

type
TltsImageFunc = procedure(const aHandle: TltsImageHandle; const X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer); stdcall;
TltsBlendColorFunc = function (const aHandle: TltsImageHandle; const aSrc, aDst: TtsColor4f; aArgs: Pointer): TtsColor4f; stdcall;
TltsImageLoadFunc = procedure(const aHandle: TltsImageHandle; const X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer); stdcall;
TltsImageBlendFunc = function (const aHandle: TltsImageHandle; const aSrc, aDst: TtsColor4f; aArgs: Pointer): TtsColor4f; stdcall;

function ltsImageCreate (const aContext: TltsContextHandle): TltsImageHandle; stdcall;
function ltsImageIsEmpty (const aHandle: TltsImageHandle; var aValue: Boolean): TltsErrorCode; stdcall;
@@ -22,14 +22,14 @@ function ltsImageGetDataSize (const aHandle: TltsImageHandle):
function ltsImageGetFormat (const aHandle: TltsImageHandle; var aValue: TtsFormat): TltsErrorCode; stdcall;
function ltsImageGetData (const aHandle: TltsImageHandle): Pointer; stdcall;
function ltsImageGetScanline (const aHandle: TltsImageHandle; const aIndex: Integer): Pointer; stdcall;
function lstImageGetPixelAt (const aHandle: TltsImageHandle; const aX, aY: Integer; var aColor: TtsColor4f): TltsErrorCode; stdcall;
function ltsImageGetPixelAt (const aHandle: TltsImageHandle; const aX, aY: Integer; var aColor: TtsColor4f): TltsErrorCode; stdcall;
function ltsImageAssign (const aHandle, aSource: TltsImageHandle): TltsErrorCode; stdcall;
function ltsImageCreateEmpty (const aHandle: TltsImageHandle; const aFormat: TtsFormat; const aWidth, aHeight: Integer): TltsErrorCode; stdcall;
function ltsImageLoadFromFunc (const aHandle: TltsImageHandle; const aCallback: TltsImageFunc; aArgs: Pointer): TltsErrorCode; stdcall;
function ltsImageLoadFromFunc (const aHandle: TltsImageHandle; const aCallback: TltsImageLoadFunc; aArgs: Pointer): TltsErrorCode; stdcall;
function ltsImageResize (const aHandle: TltsImageHandle; const aWidth, aHeight, aX, aY: Integer): TltsErrorCode; stdcall;
function ltsImageFillColor (const aHandle: TltsImageHandle; const aColor: TtsColor4f; const aMask: TtsColorChannels; const aModes: TtsImageModes): TltsErrorCode; stdcall;
function ltsImageFillPattern (const aHandle, aPattern: TltsImageHandle; const aX, aY: Integer; const aMask: TtsColorChannels; const aModes: TtsImageModes): TltsErrorCode; stdcall;
function ltsImageBlend (const aHandle, aSource: TltsImageHandle; const aX, aY: Integer; const aBlendFunc: TltsBlendColorFunc; aArgs: Pointer): TltsErrorCode; stdcall;
function ltsImageBlend (const aHandle, aSource: TltsImageHandle; const aX, aY: Integer; const aBlendFunc: TltsImageBlendFunc; aArgs: Pointer): TltsErrorCode; stdcall;
function ltsImageBlur (const aHandle: TltsImageHandle; const aHorzRad, aHorzStr, aVertRad, aVertStr: Single; const aMask: TtsColorChannels): TltsErrorCode; stdcall;
function ltsImageDestroy (const aHandle: TltsImageHandle): TltsErrorCode; stdcall;

@@ -43,14 +43,14 @@ type
TLoadArgs = packed record
args: Pointer;
handle: TltsImageHandle;
callback: TltsImageFunc
callback: TltsImageLoadFunc
end;

PBlendArgs = ^TBlendArgs;
TBlendArgs = packed record
args: Pointer;
handle: TltsImageHandle;
callback: TltsBlendColorFunc;
callback: TltsImageBlendFunc;
end;

procedure ImageLoadCallback(const aImage: TtsImage; X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer);
@@ -234,7 +234,7 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function lstImageGetPixelAt(const aHandle: TltsImageHandle; const aX, aY: Integer; var aColor: TtsColor4f): TltsErrorCode; stdcall;
function ltsImageGetPixelAt(const aHandle: TltsImageHandle; const aX, aY: Integer; var aColor: TtsColor4f): TltsErrorCode; stdcall;
var
img: TtsImage;
begin
@@ -301,7 +301,7 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageLoadFromFunc(const aHandle: TltsImageHandle; const aCallback: TltsImageFunc; aArgs: Pointer): TltsErrorCode; stdcall;
function ltsImageLoadFromFunc(const aHandle: TltsImageHandle; const aCallback: TltsImageLoadFunc; aArgs: Pointer): TltsErrorCode; stdcall;
var
img: TtsImage;
la: TLoadArgs;
@@ -385,7 +385,7 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsImageBlend(const aHandle, aSource: TltsImageHandle; const aX, aY: Integer; const aBlendFunc: TltsBlendColorFunc; aArgs: Pointer): TltsErrorCode; stdcall;
function ltsImageBlend(const aHandle, aSource: TltsImageHandle; const aX, aY: Integer; const aBlendFunc: TltsImageBlendFunc; aArgs: Pointer): TltsErrorCode; stdcall;
var
img, src: TtsImage;
ba: TBlendArgs;


+ 9
- 190
ultsPostProcessor.pas 查看文件

@@ -20,17 +20,7 @@ function ltsPostProcessorBorderCreate (const aContext: TltsContextHandle;
const aColor: TtsColor4f; const aKeepSize: Boolean): TltsPostProcessorHandle; stdcall;
function ltsPostProcessorShadowCreate (const aContext: TltsContextHandle; const aRadius, aStrength: Single;
const aOffset: TtsPosition; const aColor: TtsColor4f): TltsPostProcessorHandle; stdcall;

function ltsPostProcessorListCreate (const aContext: TltsContextHandle): TltsPostProcessorHandle; stdcall;
function ltsPostProcessorListGetCount (const aHandle: TltsPostProcessorHandle): Integer; stdcall;
function ltsPostProcessorListGetItem (const aHandle: TltsPostProcessorHandle; const aIndex: Integer): TltsPostProcessorHandle; stdcall;
function ltsPostProcessorListGetOwnsObjects (const aHandle: TltsPostProcessorHandle; var aValue: Boolean): TltsErrorCode; stdcall;
function ltsPostProcessorListSetOwnsObjects (const aHandle: TltsPostProcessorHandle; const aValue: Boolean): TltsErrorCode; stdcall;
function ltsPostProcessorListAdd (const aHandle, aItem: TltsPostProcessorHandle): TltsErrorCode; stdcall;
function ltsPostProcessorListDel (const aHandle: TltsPostProcessorHandle; const aIndex: Integer): TltsErrorCode; stdcall;
function ltsPostProcessorListClear (const aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall;
function ltsPostProcessorListRem (const aHandle, aItem: TltsPostProcessorHandle): Integer; stdcall;
function ltsPostProcessorListIndexOf (const aHandle, aItem: TltsPostProcessorHandle): Integer; stdcall;
function ltsPostProcessorDestroy (const aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall;

implementation

@@ -127,8 +117,6 @@ begin
if CheckContextHandle(aContext, c) and CheckImageHandle(aPattern, img) then begin
pp := TtsPostProcessorFillPattern.Create(c, img, aOwnsPatter, aPosition, aModes, aChannels);
AddReference(ltsObjTypePostProcessor, pp);
if aOwnsPatter then
DelReference(ltsObjTypeImage, img);
result := pp;
end;
except
@@ -182,132 +170,19 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorListCreate(const aContext: TltsContextHandle): TltsPostProcessorHandle; stdcall;
function ltsPostProcessorDestroy(const aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall;
var
c: TtsContext;
pp: TtsPostProcessor;
begin
try
result := nil;
if CheckContextHandle(aContext, c) then begin
pp := TtsPostProcessorList.Create(c, false);
AddReference(ltsObjTypePostProcessor, pp);
result := pp;
end;
except
on ex: Exception do begin
SetLastError(ex);
result := nil;
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorListGetCount(const aHandle: TltsPostProcessorHandle): Integer; stdcall;
var
pp: TtsPostProcessorList;
begin
try
if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp)
then result := pp.Count
else result := -1;
except
on ex: Exception do begin
SetLastError(ex);
result := -1;
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorListGetItem(const aHandle: TltsPostProcessorHandle; const aIndex: Integer): TltsPostProcessorHandle; stdcall;
var
pp: TtsPostProcessorList;
begin
try
result := nil;
if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) then begin
if (aIndex < 0) or (aIndex >= pp.Count)
then SetLastError(ltsErrInvalidValue, 'index is out of range')
else result := pp.Items[aIndex];
end else
result := nil;
except
on ex: Exception do begin
SetLastError(ex);
result := nil;
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorListGetOwnsObjects(const aHandle: TltsPostProcessorHandle; var aValue: Boolean): TltsErrorCode; stdcall;
var
pp: TtsPostProcessorList;
begin
try
result := ltsErrNone;
if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp)
then aValue := pp.OwnsObjects
else result := LastErrorCode;
except
on ex: Exception do begin
SetLastError(ex);
result := LastErrorCode;
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorListSetOwnsObjects(const aHandle: TltsPostProcessorHandle; const aValue: Boolean): TltsErrorCode; stdcall;
var
pp: TtsPostProcessorList;
begin
try
result := ltsErrNone;
if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp)
then pp.OwnsObjects := aValue
else result := LastErrorCode;
except
on ex: Exception do begin
SetLastError(ex);
result := LastErrorCode;
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorListAdd(const aHandle, aItem: TltsPostProcessorHandle): TltsErrorCode; stdcall;
var
pp, itm: TtsPostProcessorList;
begin
try
result := ltsErrNone;
if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) and
CheckPostProcessorHandle(aItem, TtsPostProcessor, itm)
then pp.Add(itm)
else result := LastErrorCode;
except
on ex: Exception do begin
SetLastError(ex);
result := LastErrorCode;
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorListDel(const aHandle: TltsPostProcessorHandle; const aIndex: Integer): TltsErrorCode; stdcall;
var
pp: TtsPostProcessorList;
begin
try
result := ltsErrNone;
if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) then begin
if (aIndex < 0) or (aIndex >= pp.Count) then begin
SetLastError(ltsErrInvalidValue, 'index is out of range');
result := LastErrorCode
end
else pp.Delete(aIndex);
if CheckPostProcessorHandle(aHandle, TtsPostProcessor, pp) then begin
if (pp is TtsPostProcessorFillPattern) then with (pp as TtsPostProcessorFillPattern) do begin
if OwnsPattern then
DelReference(ltsObjTypeImage, Pattern);
end;
DelReference(ltsObjTypePostProcessor, pp);
FreeAndNil(pp);
end else
result := LastErrorCode;
except
@@ -318,61 +193,5 @@ begin
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorListClear(const aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall;
var
pp: TtsPostProcessorList;
begin
try
result := ltsErrNone;
if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp)
then pp.ClearRanges
else result := LastErrorCode;
except
on ex: Exception do begin
SetLastError(ex);
result := LastErrorCode;
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorListRem(const aHandle, aItem: TltsPostProcessorHandle): Integer; stdcall;
var
pp, itm: TtsPostProcessorList;
begin
try
result := -1;
if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) and
CheckPostProcessorHandle(aItem, TtsPostProcessor, itm)
then result := pp.Remove(itm)
else result := -1;
except
on ex: Exception do begin
SetLastError(ex);
result := -1;
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsPostProcessorListIndexOf(const aHandle, aItem: TltsPostProcessorHandle): Integer; stdcall;
var
pp, itm: TtsPostProcessorList;
begin
try
result := -1;
if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) and
CheckPostProcessorHandle(aItem, TtsPostProcessor, itm)
then result := pp.IndexOf(itm)
else result := -1;
except
on ex: Exception do begin
SetLastError(ex);
result := -1;
end;
end;
end;

end.


+ 22
- 0
ultsTextBlock.pas 查看文件

@@ -37,6 +37,8 @@ function ltsTextBlockGetTextWidthW (const aHandle: TltsTextBlockHandle; const a
function ltsTextBlockTextOutA (const aHandle: TltsTextBlockHandle; const aText: PAnsiChar): TltsErrorCode; stdcall;
function ltsTextBlockTextOutW (const aHandle: TltsTextBlockHandle; const aText: PWideChar): TltsErrorCode; stdcall;

function ltsTextBlockDestroy (const aHandle: TltsTextBlockHandle): TltsErrorCode; stdcall;

implementation

uses
@@ -456,5 +458,25 @@ begin
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsTextBlockDestroy(const aHandle: TltsTextBlockHandle): TltsErrorCode; stdcall;
var
b: TtsTextBlock;
begin
try
result := ltsErrNone;
if CheckTextBlockHandle(aHandle, b) then begin
DelReference(ltsObjTypeTextBlock, b);
FreeAndNil(b);
end else
result := LastErrorCode;
except
on ex: Exception do begin
SetLastError(ex);
result := LastErrorCode;
end;
end;
end;

end.


Write Preview
Loading…
取消
儲存