From 9cfd120072271bb651a92a91e384be0287d1c845 Mon Sep 17 00:00:00 2001 From: Bergmann89 Date: Sat, 7 Mar 2015 16:05:23 +0100 Subject: [PATCH] * some Delphi fixed * example project for Delphi --- .gitignore | 1 + examples/Delphi/Delphi.cfg | 42 ++++++++++ examples/Delphi/Delphi.dof | 138 +++++++++++++++++++++++++++++++++ examples/Delphi/Delphi.dpr | 13 ++++ examples/Delphi/uMainForm.dfm | 19 +++++ examples/Delphi/uMainForm.pas | 142 ++++++++++++++++++++++++++++++++++ utsCodePages.pas | 4 +- utsFontCreatorFreeType.pas | 4 +- utsFontCreatorGDI.pas | 16 ++-- utsFreeType.pas | 4 +- utsGDI.pas | 13 +++- utsOpenGLUtils.pas | 16 ++-- utsPostProcess.pas | 8 +- utsRendererOpenGL.pas | 8 +- utsRendererOpenGLES.pas | 4 +- utsTextSuite.pas | 22 +++--- utsTtfUtils.pas | 4 +- utsTypes.pas | 4 +- utsUtils.pas | 22 ++++-- 19 files changed, 440 insertions(+), 44 deletions(-) create mode 100644 examples/Delphi/Delphi.cfg create mode 100644 examples/Delphi/Delphi.dof create mode 100644 examples/Delphi/Delphi.dpr create mode 100644 examples/Delphi/uMainForm.dfm create mode 100644 examples/Delphi/uMainForm.pas diff --git a/.gitignore b/.gitignore index a1b5a61..2be8143 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ *.exe *.log +*.dcu lib/ old/ \ No newline at end of file diff --git a/examples/Delphi/Delphi.cfg b/examples/Delphi/Delphi.cfg new file mode 100644 index 0000000..83c5be5 --- /dev/null +++ b/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 diff --git a/examples/Delphi/Delphi.dof b/examples/Delphi/Delphi.dof new file mode 100644 index 0000000..ee51503 --- /dev/null +++ b/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 diff --git a/examples/Delphi/Delphi.dpr b/examples/Delphi/Delphi.dpr new file mode 100644 index 0000000..b77c7d6 --- /dev/null +++ b/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. diff --git a/examples/Delphi/uMainForm.dfm b/examples/Delphi/uMainForm.dfm new file mode 100644 index 0000000..1fa401c --- /dev/null +++ b/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 diff --git a/examples/Delphi/uMainForm.pas b/examples/Delphi/uMainForm.pas new file mode 100644 index 0000000..5bc3963 --- /dev/null +++ b/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. diff --git a/utsCodePages.pas b/utsCodePages.pas index 38e59fd..1ff9b55 100644 --- a/utsCodePages.pas +++ b/utsCodePages.pas @@ -1,6 +1,8 @@ unit utsCodePages; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface diff --git a/utsFontCreatorFreeType.pas b/utsFontCreatorFreeType.pas index 4278cb7..bbf3774 100644 --- a/utsFontCreatorFreeType.pas +++ b/utsFontCreatorFreeType.pas @@ -1,6 +1,8 @@ unit utsFontCreatorFreeType; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface diff --git a/utsFontCreatorGDI.pas b/utsFontCreatorGDI.pas index 17d8931..12df120 100644 --- a/utsFontCreatorGDI.pas +++ b/utsFontCreatorGDI.pas @@ -1,6 +1,8 @@ unit utsFontCreatorGDI; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface @@ -92,7 +94,7 @@ uses constructor TtsFontGDI.Create(const aRenderer: TtsRenderer; const aCreator: TtsFontGenerator; const aProperties: TtsFontProperties; const aHandle: THandle); begin inherited Create(aRenderer, aCreator, aProperties); - FillByte(fMat2, SizeOf(fMat2), 0); + FillChar(fMat2, SizeOf(fMat2), #0); fMat2.eM11.value := 1; fMat2.eM22.value := 1; fHandle := aHandle; @@ -223,7 +225,7 @@ begin try SelectObject(DC, aFont.fHandle); if Assigned(GetCharacterPlacementW) then begin - FillByte(GCPRes, SizeOf(GCPRes), 0); + FillChar(GCPRes, SizeOf(GCPRes), #0); GetMem(GCPRes.lpGlyphs, SizeOf(Cardinal)); try GCPRes.lStructSize := SizeOf(GCPRes); @@ -276,7 +278,7 @@ var begin if (aFont.fMat2.eM11.value <> 1) then raise EtsException.Create('invalid value'); - FillByte(Metric, SizeOf(Metric), 0); + FillChar(Metric, SizeOf(Metric), #0); GlyphIndex := GetGlyphIndex(aFont, aCharCode); if (GlyphIndex < 0) then @@ -336,7 +338,7 @@ var end; begin - FillByte(Metric, SizeOf(Metric), 0); + FillChar(Metric, SizeOf(Metric), #0); GlyphIndex := GetGlyphIndex(aFont, aCharCode); if (GlyphIndex < 0) then @@ -403,14 +405,14 @@ var begin result := 0; - FillByte(aProperties, SizeOf(aProperties), 0); + FillChar(aProperties, SizeOf(aProperties), #0); aProperties.Size := aSize; aProperties.Style := aStyle; aProperties.AntiAliasing := aAntiAliasing; aProperties.Fontname := aFontname; // prepare font attribs - FillByte(LogFont, SizeOf(LogFont), 0); + FillChar(LogFont, SizeOf(LogFont), #0); for i := 1 to min(Length(aFontname), Length(LogFont.lfFaceName)) do LogFont.lfFaceName[i-1] := aFontname[i]; LogFont.lfCharSet := DEFAULT_CHARSET; diff --git a/utsFreeType.pas b/utsFreeType.pas index e15371c..efc79c4 100644 --- a/utsFreeType.pas +++ b/utsFreeType.pas @@ -1,6 +1,8 @@ unit utsFreeType; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface diff --git a/utsGDI.pas b/utsGDI.pas index 893bb48..e526464 100644 --- a/utsGDI.pas +++ b/utsGDI.pas @@ -1,14 +1,21 @@ unit utsGDI; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface uses - Classes, SysUtils, utsTypes, syncobjs, dynlibs; + Classes, SysUtils, utsTypes, syncobjs{$IFDEF FPC}, dynlibs{$ELSE}, Windows{$ENDIF}; type HDC = Cardinal; +{$IFNDEF FPC} + DWORD = Cardinal; + PDWORD = ^DWORD; + TLibHandle = Cardinal; +{$ENDIF} TFixed = packed record fract: Word; @@ -235,7 +242,7 @@ procedure InitGDI; function GetProcAddr(const aLibHandle: TLibHandle; const aName: String): Pointer; begin - result := GetProcAddress(aLibHandle, aName); + result := GetProcAddress(aLibHandle, PAnsiChar(aName)); if not Assigned(result) then raise EtsException.Create('unable to load procedure from library: ' + aName); end; diff --git a/utsOpenGLUtils.pas b/utsOpenGLUtils.pas index 92bcb2c..9f68e29 100644 --- a/utsOpenGLUtils.pas +++ b/utsOpenGLUtils.pas @@ -1,6 +1,8 @@ unit utsOpenGLUtils; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface @@ -88,9 +90,9 @@ constructor TtsCharRenderRefOpenGL.Create; begin inherited Create; 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; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -185,8 +187,8 @@ var end else begin new(aItem^.children[0]); 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 aItem^.value := Y1 + GlyphHeight; result := InsertToTree(aItem^.children[0], X1, Y1, X2, aItem^.value, X, Y); @@ -302,7 +304,7 @@ var begin FreeTextureTreeItem(aItem^.children[0]); FreeTextureTreeItem(aItem^.children[1]); - FillByte(aItem^, SizeOf(aItem^), 0); + FillChar(aItem^, SizeOf(aItem^), #0); end; end; diff --git a/utsPostProcess.pas b/utsPostProcess.pas index ed6e706..a72ea00 100644 --- a/utsPostProcess.pas +++ b/utsPostProcess.pas @@ -1,6 +1,8 @@ unit utsPostProcess; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface @@ -144,7 +146,11 @@ var (tmpY >= 0) and (tmpY < orig.Height) and orig.GetPixelAt(tmpX, tmpY, c) then begin + {$IFDEF FPC} 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; if (s > result.arr[Integer(chan)]) then begin result.arr[Integer(chan)] := s; diff --git a/utsRendererOpenGL.pas b/utsRendererOpenGL.pas index 01a4e23..2df895b 100644 --- a/utsRendererOpenGL.pas +++ b/utsRendererOpenGL.pas @@ -1,6 +1,8 @@ unit utsRendererOpenGL; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface @@ -81,9 +83,9 @@ function TtsRendererOpenGL.CreateNewTexture: PtsFontTexture; begin new(result); try - FillByte(result^, SizeOf(result^), 0); + FillChar(result^, SizeOf(result^), #0); new(result^.Usage); - FillByte(result^.Usage^, SizeOf(result^.Usage^), 0); + FillChar(result^.Usage^, SizeOf(result^.Usage^), #0); result^.Size := TextureSize; glGenTextures(1, @result^.ID); glBindTexture(GL_TEXTURE_2D, result^.ID); diff --git a/utsRendererOpenGLES.pas b/utsRendererOpenGLES.pas index 40b1c5d..bb8760a 100644 --- a/utsRendererOpenGLES.pas +++ b/utsRendererOpenGLES.pas @@ -1,6 +1,8 @@ unit utsRendererOpenGLES; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} {.$DEFINE DEBUG} interface diff --git a/utsTextSuite.pas b/utsTextSuite.pas index 2f47ec2..8501c67 100644 --- a/utsTextSuite.pas +++ b/utsTextSuite.pas @@ -1,6 +1,8 @@ unit utsTextSuite; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface @@ -438,9 +440,9 @@ implementation const IMAGE_MODE_FUNCTIONS: array[TtsImageMode] of TtsImageModeFunc = ( - @tsImageModeFuncIgnore, - @tsImageModeFuncReplace, - @tsImageModeFuncModulate); + tsImageModeFuncIgnore, + tsImageModeFuncReplace, + tsImageModeFuncModulate); //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TtsKernel1D/////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -694,7 +696,7 @@ begin lSize := lSize + ((4 - (lSize mod 4)) mod 4); dSize := aHeight * lSize; ImgData := AllocMem(dSize); - FillByte(ImgData^, dSize, 0); + FillChar(ImgData^, dSize, #0); SetData(ImgData, aFormat, aWidth, aHeight, lSize, dSize); end; @@ -1556,7 +1558,7 @@ begin if (aWidth <= 0) then exit; new(p); - FillByte(p^, SizeOf(p^), 0); + FillChar(p^, SizeOf(p^), #0); p^.ItemType := tsItemTypeSpacing; p^.Spacing := aWidth; PushLineItem(p); @@ -1635,7 +1637,7 @@ var exit; new(p); - FillByte(p^, SizeOf(p^), 0); + FillChar(p^, SizeOf(p^), #0); p^.ItemType := State; case State of @@ -1869,7 +1871,7 @@ begin TrimSpaces(fLastLine); new(p); - FillByte(p^, SizeOf(p^), 0); + FillChar(p^, SizeOf(p^), #0); UpdateLineMeta(p); if Assigned(fLastLine) then begin @@ -1910,7 +1912,7 @@ begin exit; New(p); - FillByte(p^, SizeOf(p^), 0); + FillChar(p^, SizeOf(p^), #0); fCurrentFont := aFont; p^.ItemType := tsItemTypeFont; p^.Font := fCurrentFont; @@ -1925,7 +1927,7 @@ var p: PtsLineItem; begin New(p); - FillByte(p^, SizeOf(p^), 0); + FillChar(p^, SizeOf(p^), #0); p^.ItemType := tsItemTypeColor; p^.Color := aColor; PushLineItem(p); diff --git a/utsTtfUtils.pas b/utsTtfUtils.pas index 92caa59..31bf9bf 100644 --- a/utsTtfUtils.pas +++ b/utsTtfUtils.pas @@ -1,6 +1,8 @@ unit utsTtfUtils; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface diff --git a/utsTypes.pas b/utsTypes.pas index 850384e..13e4c73 100644 --- a/utsTypes.pas +++ b/utsTypes.pas @@ -1,6 +1,8 @@ unit utsTypes; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface diff --git a/utsUtils.pas b/utsUtils.pas index 7d6f400..237ca02 100644 --- a/utsUtils.pas +++ b/utsUtils.pas @@ -1,6 +1,8 @@ unit utsUtils; -{$mode objfpc}{$H+} +{$IFDEF FPC} +{$mode delphi}{$H+} +{$ENDIF} interface @@ -114,7 +116,7 @@ const STATE_STARTBYTE = 0; STATE_FOLLOWBYTE = 1; var - cc: QWord; + cc: UInt64; len, state, c: Integer; p: PByte; tmp: Byte; @@ -123,18 +125,20 @@ begin if not Assigned(aDst) or not Assigned(aSrc) or (aSize <= 0) then exit; + c := 0; + cc := 0; p := PByte(aSrc); len := Length(aSrc); state := STATE_STARTBYTE; while (len > 0) do begin case state of STATE_STARTBYTE: begin - if (p^ and %10000000 = 0) then begin + if (p^ and $80 = 0) then begin AddToDest(p^); - end else if (p^ and %01000000 > 0) then begin + end else if (p^ and $40 > 0) then begin tmp := p^; c := 0; - while (tmp and %10000000) > 0 do begin + while (tmp and $80) > 0 do begin inc(c); tmp := tmp shl 1; end; @@ -145,8 +149,8 @@ begin end; 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; if (c = 0) then begin AddToDest(cc); @@ -183,7 +187,11 @@ var begin result := 0; while (aSrcSize > 1) and (aDstSize > 0) do begin +{$IFDEF FPC} tmp := (aSrc^ shl 8) or (aSrc + 1)^; +{$ELSE} + tmp := (PByteArray(aSrc)[0] shl 8) or PByteArray(aSrc)[1]; +{$ENDIF} inc(aSrc, 2); dec(aSrcSize, 2); AddToDest(tmp);