瀏覽代碼

* some Delphi fixed

* example project for Delphi
master
Bergmann89 11 年之前
父節點
當前提交
9cfd120072
共有 19 個文件被更改,包括 440 次插入44 次删除
  1. +1
    -0
      .gitignore
  2. +42
    -0
      examples/Delphi/Delphi.cfg
  3. +138
    -0
      examples/Delphi/Delphi.dof
  4. +13
    -0
      examples/Delphi/Delphi.dpr
  5. +19
    -0
      examples/Delphi/uMainForm.dfm
  6. +142
    -0
      examples/Delphi/uMainForm.pas
  7. +3
    -1
      utsCodePages.pas
  8. +3
    -1
      utsFontCreatorFreeType.pas
  9. +9
    -7
      utsFontCreatorGDI.pas
  10. +3
    -1
      utsFreeType.pas
  11. +10
    -3
      utsGDI.pas
  12. +9
    -7
      utsOpenGLUtils.pas
  13. +7
    -1
      utsPostProcess.pas
  14. +5
    -3
      utsRendererOpenGL.pas
  15. +3
    -1
      utsRendererOpenGLES.pas
  16. +12
    -10
      utsTextSuite.pas
  17. +3
    -1
      utsTtfUtils.pas
  18. +3
    -1
      utsTypes.pas
  19. +15
    -7
      utsUtils.pas

+ 1
- 0
.gitignore 查看文件

@@ -1,4 +1,5 @@
*.exe *.exe
*.log *.log
*.dcu
lib/ lib/
old/ old/

+ 42
- 0
examples/Delphi/Delphi.cfg 查看文件

@@ -0,0 +1,42 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\zusatzprogramme\delphi 7\Projects\Bpl"
-LN"c:\zusatzprogramme\delphi 7\Projects\Bpl"
-U"..\..;..\lib"
-O"..\..;..\lib"
-I"..\..;..\lib"
-R"..\..;..\lib"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

+ 138
- 0
examples/Delphi/Delphi.dof 查看文件

@@ -0,0 +1,138 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=..\..;..\lib
Packages=rtl;vcl;vclie;xmlrtl;inet;inetdbbde;inetdbxpress;vclx;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;adortl;ibxpress;vclactnband;bdertl;vclshlctrls;dclOfficeXP
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1031
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=1
Item0=..\..;..\lib

+ 13
- 0
examples/Delphi/Delphi.dpr 查看文件

@@ -0,0 +1,13 @@
program Delphi;

uses
Forms,
uMainForm in 'uMainForm.pas' {MainForm};

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

+ 19
- 0
examples/Delphi/uMainForm.dfm 查看文件

@@ -0,0 +1,19 @@
object MainForm: TMainForm
Left = 192
Top = 124
Width = 800
Height = 600
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnPaint = FormPaint
PixelsPerInch = 96
TextHeight = 13
end

+ 142
- 0
examples/Delphi/uMainForm.pas 查看文件

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

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,
uglcContext,
utsTextSuite, utsRendererOpenGL, utsFontCreatorGDI, utsTypes, utsPostProcess;

type
TMainForm = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
fContext: TglcContext;
ftsContext: TtsContext;
ftsRenderer: TtsRendererOpenGL;
ftsCreator1: TtsFontGeneratorGDI;
ftsCreator2: TtsFontGeneratorGDI;
ftsFont1: TtsFont;
ftsFont2: TtsFont;
procedure Render;
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation

{$R *.dfm}

uses
dglOpenGL;

const
TEST_TEXT = 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum.';

procedure TMainForm.FormCreate(Sender: TObject);
var
pf: TglcContextPixelFormatSettings;
pp: TtsPostProcessStep;
img: TtsImage;

const
PATTER_DATA: array[0..15] of Byte = (
$FF, $BF, $7F, $BF,
$BF, $FF, $BF, $7F,
$7F, $BF, $FF, $BF,
$BF, $7F, $BF, $FF);

begin
pf := TglcContext.MakePF();
fContext := TglcContext.GetPlatformClass.Create(self, pf);
fContext.BuildContext;

ftsContext := TtsContext.Create;
ftsRenderer := TtsRendererOpenGL.Create(ftsContext, tsFormatRGBA8);

ftsCreator1 := TtsFontGeneratorGDI.Create(ftsContext);
ftsFont1 := ftsCreator1.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', ftsRenderer, 40, [], tsAANormal);

pp := TtsPostProcessFillColor.Create(tsColor4f(0, 0, 0, 1), TS_MODES_REPLACE_ALL, TS_CHANNELS_RGB);
pp.AddUsageChars(tsUsageExclude, 'Lorem');
ftsCreator1.AddPostProcessStep(pp);

pp := TtsPostProcessFillColor.Create(tsColor4f(1.0, 0.0, 0.0, 1.0), TS_MODES_MODULATE_ALL, TS_CHANNELS_RGB);
pp.AddUsageChars(tsUsageInclude, 'Lorem');
ftsCreator1.AddPostProcessStep(pp);

img := TtsImage.Create;
img.CreateEmpty(tsFormatAlpha8, 4, 4);
Move(PATTER_DATA[0], img.Data^, 16);
pp := TtsPostProcessFillPattern.Create(img, true, 0, 0, TS_MODES_MODULATE_ALL, TS_CHANNELS_RGBA);
pp.AddUsageChars(tsUsageInclude, 'Lorem');
ftsCreator1.AddPostProcessStep(pp);

ftsCreator2 := TtsFontGeneratorGDI.Create(ftsContext);
ftsFont2 := ftsCreator2.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', ftsRenderer, 40, [tsStyleStrikeout], tsAANormal);

pp := TtsPostProcessFillColor.Create(tsColor4f(0, 0, 0.5, 1), TS_MODES_REPLACE_ALL, TS_CHANNELS_RGB);
pp.AddUsageChars(tsUsageExclude, 'e');
ftsCreator2.AddPostProcessStep(pp);

pp := TtsPostProcessBorder.Create(3.0, 0.5, tsColor4f(0.0, 0.5, 0.0, 1.0), true);
pp.AddUsageChars(tsUsageInclude, 'e');
ftsCreator2.AddPostProcessStep(pp);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
FreeAndNil(ftsFont2);
FreeAndNil(ftsCreator2);
FreeAndNil(ftsFont1);
FreeAndNil(ftsCreator1);
FreeAndNil(ftsRenderer);
FreeAndNil(ftsContext);
FreeAndNil(fContext);
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
if Assigned(fContext) then begin
Render;
fContext.SwapBuffers;
end;
end;

procedure TMainForm.Render;
var
block: TtsTextBlock;
begin
glClearColor(1, 1, 1, 1);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

glViewport(0, 0, ClientWidth, ClientHeight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glOrtho(0, ClientWidth, ClientHeight, 0, -10, 10);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;

glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);

block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [tsBlockFlagWordWrap]);
try
block.HorzAlign := tsHorzAlignJustify;
block.ChangeFont(ftsFont1);
block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
block.TextOutW(TEST_TEXT + sLineBreak);

block.ChangeFont(ftsFont2);
block.TextOutW(TEST_TEXT);
finally
ftsRenderer.EndBlock(block);
end;
end;

end.

+ 3
- 1
utsCodePages.pas 查看文件

@@ -1,6 +1,8 @@
unit utsCodePages; unit utsCodePages;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface




+ 3
- 1
utsFontCreatorFreeType.pas 查看文件

@@ -1,6 +1,8 @@
unit utsFontCreatorFreeType; unit utsFontCreatorFreeType;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface




+ 9
- 7
utsFontCreatorGDI.pas 查看文件

@@ -1,6 +1,8 @@
unit utsFontCreatorGDI; unit utsFontCreatorGDI;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface


@@ -92,7 +94,7 @@ uses
constructor TtsFontGDI.Create(const aRenderer: TtsRenderer; const aCreator: TtsFontGenerator; const aProperties: TtsFontProperties; const aHandle: THandle); constructor TtsFontGDI.Create(const aRenderer: TtsRenderer; const aCreator: TtsFontGenerator; const aProperties: TtsFontProperties; const aHandle: THandle);
begin begin
inherited Create(aRenderer, aCreator, aProperties); inherited Create(aRenderer, aCreator, aProperties);
FillByte(fMat2, SizeOf(fMat2), 0);
FillChar(fMat2, SizeOf(fMat2), #0);
fMat2.eM11.value := 1; fMat2.eM11.value := 1;
fMat2.eM22.value := 1; fMat2.eM22.value := 1;
fHandle := aHandle; fHandle := aHandle;
@@ -223,7 +225,7 @@ begin
try try
SelectObject(DC, aFont.fHandle); SelectObject(DC, aFont.fHandle);
if Assigned(GetCharacterPlacementW) then begin if Assigned(GetCharacterPlacementW) then begin
FillByte(GCPRes, SizeOf(GCPRes), 0);
FillChar(GCPRes, SizeOf(GCPRes), #0);
GetMem(GCPRes.lpGlyphs, SizeOf(Cardinal)); GetMem(GCPRes.lpGlyphs, SizeOf(Cardinal));
try try
GCPRes.lStructSize := SizeOf(GCPRes); GCPRes.lStructSize := SizeOf(GCPRes);
@@ -276,7 +278,7 @@ var
begin begin
if (aFont.fMat2.eM11.value <> 1) then if (aFont.fMat2.eM11.value <> 1) then
raise EtsException.Create('invalid value'); raise EtsException.Create('invalid value');
FillByte(Metric, SizeOf(Metric), 0);
FillChar(Metric, SizeOf(Metric), #0);


GlyphIndex := GetGlyphIndex(aFont, aCharCode); GlyphIndex := GetGlyphIndex(aFont, aCharCode);
if (GlyphIndex < 0) then if (GlyphIndex < 0) then
@@ -336,7 +338,7 @@ var
end; end;


begin begin
FillByte(Metric, SizeOf(Metric), 0);
FillChar(Metric, SizeOf(Metric), #0);


GlyphIndex := GetGlyphIndex(aFont, aCharCode); GlyphIndex := GetGlyphIndex(aFont, aCharCode);
if (GlyphIndex < 0) then if (GlyphIndex < 0) then
@@ -403,14 +405,14 @@ var
begin begin
result := 0; result := 0;


FillByte(aProperties, SizeOf(aProperties), 0);
FillChar(aProperties, SizeOf(aProperties), #0);
aProperties.Size := aSize; aProperties.Size := aSize;
aProperties.Style := aStyle; aProperties.Style := aStyle;
aProperties.AntiAliasing := aAntiAliasing; aProperties.AntiAliasing := aAntiAliasing;
aProperties.Fontname := aFontname; aProperties.Fontname := aFontname;


// prepare font attribs // prepare font attribs
FillByte(LogFont, SizeOf(LogFont), 0);
FillChar(LogFont, SizeOf(LogFont), #0);
for i := 1 to min(Length(aFontname), Length(LogFont.lfFaceName)) do for i := 1 to min(Length(aFontname), Length(LogFont.lfFaceName)) do
LogFont.lfFaceName[i-1] := aFontname[i]; LogFont.lfFaceName[i-1] := aFontname[i];
LogFont.lfCharSet := DEFAULT_CHARSET; LogFont.lfCharSet := DEFAULT_CHARSET;


+ 3
- 1
utsFreeType.pas 查看文件

@@ -1,6 +1,8 @@
unit utsFreeType; unit utsFreeType;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface




+ 10
- 3
utsGDI.pas 查看文件

@@ -1,14 +1,21 @@
unit utsGDI; unit utsGDI;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface


uses uses
Classes, SysUtils, utsTypes, syncobjs, dynlibs;
Classes, SysUtils, utsTypes, syncobjs{$IFDEF FPC}, dynlibs{$ELSE}, Windows{$ENDIF};


type type
HDC = Cardinal; HDC = Cardinal;
{$IFNDEF FPC}
DWORD = Cardinal;
PDWORD = ^DWORD;
TLibHandle = Cardinal;
{$ENDIF}


TFixed = packed record TFixed = packed record
fract: Word; fract: Word;
@@ -235,7 +242,7 @@ procedure InitGDI;


function GetProcAddr(const aLibHandle: TLibHandle; const aName: String): Pointer; function GetProcAddr(const aLibHandle: TLibHandle; const aName: String): Pointer;
begin begin
result := GetProcAddress(aLibHandle, aName);
result := GetProcAddress(aLibHandle, PAnsiChar(aName));
if not Assigned(result) then if not Assigned(result) then
raise EtsException.Create('unable to load procedure from library: ' + aName); raise EtsException.Create('unable to load procedure from library: ' + aName);
end; end;


+ 9
- 7
utsOpenGLUtils.pas 查看文件

@@ -1,6 +1,8 @@
unit utsOpenGLUtils; unit utsOpenGLUtils;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface


@@ -88,9 +90,9 @@ constructor TtsCharRenderRefOpenGL.Create;
begin begin
inherited Create; inherited Create;
TextureID := 0; TextureID := 0;
FillByte(TexMat, SizeOf(TexMat), 0);
FillByte(VertMat, SizeOf(VertMat), 0);
FillByte(Size, SizeOf(Size), 0);
FillChar(TexMat, SizeOf(TexMat), #0);
FillChar(VertMat, SizeOf(VertMat), #0);
FillChar(Size, SizeOf(Size), #0);
end; end;


//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -185,8 +187,8 @@ var
end else begin end else begin
new(aItem^.children[0]); new(aItem^.children[0]);
new(aItem^.children[1]); new(aItem^.children[1]);
FillByte(aItem^.children[0]^, SizeOf(aItem^.children[0]^), 0);
FillByte(aItem^.children[1]^, SizeOf(aItem^.children[1]^), 0);
FillChar(aItem^.children[0]^, SizeOf(aItem^.children[0]^), #0);
FillChar(aItem^.children[1]^, SizeOf(aItem^.children[1]^), #0);
if (w - GlyphWidth) < (h - GlyphHeight) then begin if (w - GlyphWidth) < (h - GlyphHeight) then begin
aItem^.value := Y1 + GlyphHeight; aItem^.value := Y1 + GlyphHeight;
result := InsertToTree(aItem^.children[0], X1, Y1, X2, aItem^.value, X, Y); result := InsertToTree(aItem^.children[0], X1, Y1, X2, aItem^.value, X, Y);
@@ -302,7 +304,7 @@ var
begin begin
FreeTextureTreeItem(aItem^.children[0]); FreeTextureTreeItem(aItem^.children[0]);
FreeTextureTreeItem(aItem^.children[1]); FreeTextureTreeItem(aItem^.children[1]);
FillByte(aItem^, SizeOf(aItem^), 0);
FillChar(aItem^, SizeOf(aItem^), #0);
end; end;
end; end;




+ 7
- 1
utsPostProcess.pas 查看文件

@@ -1,6 +1,8 @@
unit utsPostProcess; unit utsPostProcess;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface


@@ -144,7 +146,11 @@ var
(tmpY >= 0) and (tmpY < orig.Height) and (tmpY >= 0) and (tmpY < orig.Height) and
orig.GetPixelAt(tmpX, tmpY, c) then orig.GetPixelAt(tmpX, tmpY, c) then
begin begin
{$IFDEF FPC}
for chan in mask do begin for chan in mask do begin
{$ELSE}
for chan := low(TtsColorChannel) to high(TtsColorChannel) do if (chan in mask) then begin
{$ENDIF}
s := c.arr[Integer(chan)] * fColor.arr[Integer(chan)] * fKernel.Items[i].Value; s := c.arr[Integer(chan)] * fColor.arr[Integer(chan)] * fKernel.Items[i].Value;
if (s > result.arr[Integer(chan)]) then begin if (s > result.arr[Integer(chan)]) then begin
result.arr[Integer(chan)] := s; result.arr[Integer(chan)] := s;


+ 5
- 3
utsRendererOpenGL.pas 查看文件

@@ -1,6 +1,8 @@
unit utsRendererOpenGL; unit utsRendererOpenGL;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface


@@ -81,9 +83,9 @@ function TtsRendererOpenGL.CreateNewTexture: PtsFontTexture;
begin begin
new(result); new(result);
try try
FillByte(result^, SizeOf(result^), 0);
FillChar(result^, SizeOf(result^), #0);
new(result^.Usage); new(result^.Usage);
FillByte(result^.Usage^, SizeOf(result^.Usage^), 0);
FillChar(result^.Usage^, SizeOf(result^.Usage^), #0);
result^.Size := TextureSize; result^.Size := TextureSize;
glGenTextures(1, @result^.ID); glGenTextures(1, @result^.ID);
glBindTexture(GL_TEXTURE_2D, result^.ID); glBindTexture(GL_TEXTURE_2D, result^.ID);


+ 3
- 1
utsRendererOpenGLES.pas 查看文件

@@ -1,6 +1,8 @@
unit utsRendererOpenGLES; unit utsRendererOpenGLES;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}
{.$DEFINE DEBUG} {.$DEFINE DEBUG}


interface interface


+ 12
- 10
utsTextSuite.pas 查看文件

@@ -1,6 +1,8 @@
unit utsTextSuite; unit utsTextSuite;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface


@@ -438,9 +440,9 @@ implementation


const const
IMAGE_MODE_FUNCTIONS: array[TtsImageMode] of TtsImageModeFunc = ( IMAGE_MODE_FUNCTIONS: array[TtsImageMode] of TtsImageModeFunc = (
@tsImageModeFuncIgnore,
@tsImageModeFuncReplace,
@tsImageModeFuncModulate);
tsImageModeFuncIgnore,
tsImageModeFuncReplace,
tsImageModeFuncModulate);


//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TtsKernel1D/////////////////////////////////////////////////////////////////////////////////////////////////////////// //TtsKernel1D///////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -694,7 +696,7 @@ begin
lSize := lSize + ((4 - (lSize mod 4)) mod 4); lSize := lSize + ((4 - (lSize mod 4)) mod 4);
dSize := aHeight * lSize; dSize := aHeight * lSize;
ImgData := AllocMem(dSize); ImgData := AllocMem(dSize);
FillByte(ImgData^, dSize, 0);
FillChar(ImgData^, dSize, #0);
SetData(ImgData, aFormat, aWidth, aHeight, lSize, dSize); SetData(ImgData, aFormat, aWidth, aHeight, lSize, dSize);
end; end;


@@ -1556,7 +1558,7 @@ begin
if (aWidth <= 0) then if (aWidth <= 0) then
exit; exit;
new(p); new(p);
FillByte(p^, SizeOf(p^), 0);
FillChar(p^, SizeOf(p^), #0);
p^.ItemType := tsItemTypeSpacing; p^.ItemType := tsItemTypeSpacing;
p^.Spacing := aWidth; p^.Spacing := aWidth;
PushLineItem(p); PushLineItem(p);
@@ -1635,7 +1637,7 @@ var
exit; exit;


new(p); new(p);
FillByte(p^, SizeOf(p^), 0);
FillChar(p^, SizeOf(p^), #0);
p^.ItemType := State; p^.ItemType := State;


case State of case State of
@@ -1869,7 +1871,7 @@ begin
TrimSpaces(fLastLine); TrimSpaces(fLastLine);


new(p); new(p);
FillByte(p^, SizeOf(p^), 0);
FillChar(p^, SizeOf(p^), #0);
UpdateLineMeta(p); UpdateLineMeta(p);


if Assigned(fLastLine) then begin if Assigned(fLastLine) then begin
@@ -1910,7 +1912,7 @@ begin
exit; exit;


New(p); New(p);
FillByte(p^, SizeOf(p^), 0);
FillChar(p^, SizeOf(p^), #0);
fCurrentFont := aFont; fCurrentFont := aFont;
p^.ItemType := tsItemTypeFont; p^.ItemType := tsItemTypeFont;
p^.Font := fCurrentFont; p^.Font := fCurrentFont;
@@ -1925,7 +1927,7 @@ var
p: PtsLineItem; p: PtsLineItem;
begin begin
New(p); New(p);
FillByte(p^, SizeOf(p^), 0);
FillChar(p^, SizeOf(p^), #0);
p^.ItemType := tsItemTypeColor; p^.ItemType := tsItemTypeColor;
p^.Color := aColor; p^.Color := aColor;
PushLineItem(p); PushLineItem(p);


+ 3
- 1
utsTtfUtils.pas 查看文件

@@ -1,6 +1,8 @@
unit utsTtfUtils; unit utsTtfUtils;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface




+ 3
- 1
utsTypes.pas 查看文件

@@ -1,6 +1,8 @@
unit utsTypes; unit utsTypes;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface




+ 15
- 7
utsUtils.pas 查看文件

@@ -1,6 +1,8 @@
unit utsUtils; unit utsUtils;


{$mode objfpc}{$H+}
{$IFDEF FPC}
{$mode delphi}{$H+}
{$ENDIF}


interface interface


@@ -114,7 +116,7 @@ const
STATE_STARTBYTE = 0; STATE_STARTBYTE = 0;
STATE_FOLLOWBYTE = 1; STATE_FOLLOWBYTE = 1;
var var
cc: QWord;
cc: UInt64;
len, state, c: Integer; len, state, c: Integer;
p: PByte; p: PByte;
tmp: Byte; tmp: Byte;
@@ -123,18 +125,20 @@ begin
if not Assigned(aDst) or not Assigned(aSrc) or (aSize <= 0) then if not Assigned(aDst) or not Assigned(aSrc) or (aSize <= 0) then
exit; exit;


c := 0;
cc := 0;
p := PByte(aSrc); p := PByte(aSrc);
len := Length(aSrc); len := Length(aSrc);
state := STATE_STARTBYTE; state := STATE_STARTBYTE;
while (len > 0) do begin while (len > 0) do begin
case state of case state of
STATE_STARTBYTE: begin STATE_STARTBYTE: begin
if (p^ and %10000000 = 0) then begin
if (p^ and $80 = 0) then begin
AddToDest(p^); AddToDest(p^);
end else if (p^ and %01000000 > 0) then begin
end else if (p^ and $40 > 0) then begin
tmp := p^; tmp := p^;
c := 0; c := 0;
while (tmp and %10000000) > 0 do begin
while (tmp and $80) > 0 do begin
inc(c); inc(c);
tmp := tmp shl 1; tmp := tmp shl 1;
end; end;
@@ -145,8 +149,8 @@ begin
end; end;


STATE_FOLLOWBYTE: begin STATE_FOLLOWBYTE: begin
if ((p^ and %11000000) = %10000000) then begin
cc := (cc shl 6) or (p^ and %00111111);
if ((p^ and $C0) = $80) then begin
cc := (cc shl 6) or (p^ and $3F);
c := c - 1; c := c - 1;
if (c = 0) then begin if (c = 0) then begin
AddToDest(cc); AddToDest(cc);
@@ -183,7 +187,11 @@ var
begin begin
result := 0; result := 0;
while (aSrcSize > 1) and (aDstSize > 0) do begin while (aSrcSize > 1) and (aDstSize > 0) do begin
{$IFDEF FPC}
tmp := (aSrc^ shl 8) or (aSrc + 1)^; tmp := (aSrc^ shl 8) or (aSrc + 1)^;
{$ELSE}
tmp := (PByteArray(aSrc)[0] shl 8) or PByteArray(aSrc)[1];
{$ENDIF}
inc(aSrc, 2); inc(aSrc, 2);
dec(aSrcSize, 2); dec(aSrcSize, 2);
AddToDest(tmp); AddToDest(tmp);


Loading…
取消
儲存