paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-01 23:20:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 61291 #5b5ad75799 from trunk:

Browse Source 
LazUtils: Add OnCompare func for TFreeTypeFont's AVLTree. Prevents adding glyphs many times. Issue #35627.
........

git-svn-id: branches/fixes_2_0@62837 -
This commit is contained in:
maxim 2020-03-31 21:24:23 +00:00
parent c30586b3f9
commit b110179beb
4 changed files with 20 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
components/lazutils/easylazfreetype.pas
View File

@ -486,6 +486,19 @@ begin
raise Exception.Create('FreeType cannot be initialized'); raise Exception.Create('FreeType cannot be initialized');
end; end;
function GlyphTableOnCompare(Item1, Item2: Pointer): Integer;
var
G1: TFreeTypeGlyph absolute Item1;
G2: TFreeTypeGlyph absolute Item2;
begin
if G1.Index > G2.Index then
Result := 1
else if G1.Index < G2.Index then
Result := -1
else
Result := 0;
end;
{ TFreeTypeRenderableFont } { TFreeTypeRenderableFont }
procedure TFreeTypeRenderableFont.DefaultWordBreakHandler(var ABefore, procedure TFreeTypeRenderableFont.DefaultWordBreakHandler(var ABefore,
@ -1436,6 +1449,7 @@ begin
FPointSize := 10; FPointSize := 10;
FDPI := 96; FDPI := 96;
FGlyphTable := TAvlTree.Create; FGlyphTable := TAvlTree.Create;
FGlyphTable.OnCompare := @GlyphTableOnCompare;
FHinted := true; FHinted := true;
FWidthFactor := 1; FWidthFactor := 1;
FClearType := false; FClearType := false;

8
examples/lazfreetype/lazfreetypetest.lpi
View File

@ -1,10 +1,12 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="11"/> <Version Value="12"/>
<General> <General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="lazfreetypetest"/> <Title Value="lazfreetypetest"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
@ -47,8 +49,6 @@
</BuildModes> </BuildModes>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<FormatVersion Value="2"/> <FormatVersion Value="2"/>

2
examples/lazfreetype/mainform.lfm
View File

@ -14,7 +14,7 @@ object Form1: TForm1
OnPaint = FormPaint OnPaint = FormPaint
OnShow = FormShow OnShow = FormShow
Position = poDefault Position = poDefault
LCLVersion = '1.9.0.0' LCLVersion = '2.1.0.0'
object Panel_Option: TPanel object Panel_Option: TPanel
Left = 0 Left = 0
Height = 40 Height = 40

3
examples/lazfreetype/mainform.pas
View File

@ -139,8 +139,7 @@ begin
lazimg.Free; lazimg.Free;
end; end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
Y: Integer);
begin begin
mx := X; mx := X;
my := Y; my := Y;