Преглед изворни кода

* 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
*.log
*.dcu
lib/
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;

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

interface



+ 3
- 1
utsFontCreatorFreeType.pas Прегледај датотеку

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

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

interface



+ 9
- 7
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;


+ 3
- 1
utsFreeType.pas Прегледај датотеку

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

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

interface



+ 10
- 3
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;


+ 9
- 7
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;



+ 7
- 1
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;


+ 5
- 3
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);


+ 3
- 1
utsRendererOpenGLES.pas Прегледај датотеку

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

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

interface


+ 12
- 10
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);


+ 3
- 1
utsTtfUtils.pas Прегледај датотеку

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

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

interface



+ 3
- 1
utsTypes.pas Прегледај датотеку

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

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

interface



+ 15
- 7
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);


Loading…
Откажи
Сачувај