Browse Source

* Fixed memory leaks and severe bugs in font manager (caching didn't work
at all and could lead to memory corruption)

sg 21 years ago
parent
commit
9edd8f5b51
2 changed files with 11 additions and 4 deletions
  1. 4 4
      fcl/image/freetype.pp
  2. 7 0
      fcl/image/ftfont.pp

+ 4 - 4
fcl/image/freetype.pp

@@ -416,7 +416,7 @@ function TFontManager.CreateSize (aSize, aResolution : integer) : PMgrSize;
 begin
   new (result);
   result^.Size := aSize;
-  result^.Size := aResolution;
+  result^.Resolution := aResolution;
   result^.Glyphs := Tlist.Create;
   SetPixelSize (aSize,aResolution);
   CurFont.FSizes.Add (result);
@@ -497,14 +497,14 @@ var r : integer;
 begin
   With CurSize^ do
     begin
-    r := FList.Count;
+    r := Glyphs.Count;
     repeat
       dec (r)
-    until (r < 0) or (PMgrGlyph(Flist[r])^.character = c);
+    until (r < 0) or (PMgrGlyph(Glyphs[r])^.character = c);
     if r < 0 then
       result := CreateGlyph (c)
     else
-      result := PMgrGlyph(Flist[r]);
+      result := PMgrGlyph(Glyphs[r]);
     end;
 end;
 

+ 7 - 0
fcl/image/ftfont.pp

@@ -52,6 +52,7 @@ type
     procedure GetFace;
   public
     constructor create; override;
+    destructor Destroy; override;
     property FontIndex : integer read FIndex write SetIndex;
     property Resolution : longword read FResolution write FResolution;
     property AntiAliased : boolean read FAntiAliased write FAntiAliased;
@@ -90,6 +91,12 @@ begin
   FResolution := DefaultResolution;
 end;
 
+destructor TFreeTypeFont.Destroy;
+begin
+  ClearLastText;
+  inherited Destroy;
+end;
+
 procedure TFreeTypeFont.DoCopyProps (From:TFPCanvasHelper);
 var f : TFreeTypeFont;
 begin