LazUtils: FreeType fixes and new features. Issue #28073, patch from Johann.

git-svn-id: trunk@49047 -

components/lazutils/easylazfreetype.pas

@@ -50,9 +50,13 @@ type
 
   TFontCollectionItemDestroyListener = procedure() of object;
   ArrayOfFontCollectionItemDestroyListener = array of TFontCollectionItemDestroyListener;
+  TCustomFamilyCollectionItem = class;
+
+  { TCustomFontCollectionItem }
 
   TCustomFontCollectionItem = class
   protected
+    FFamily: TCustomFamilyCollectionItem;
     function GetBold: boolean; virtual; abstract;
     function GetInformation(AIndex: TFreeTypeInformation): string; virtual; abstract;
     function GetItalic: boolean; virtual; abstract;
@@ -76,6 +80,7 @@ type
     property VersionNumber: string read GetVersionNumber;
     property Style[AIndex: integer]: string read GetStyle;
     property StyleCount: integer read GetStyleCount;
+    property Family: TCustomFamilyCollectionItem read FFamily write FFamily;
   end;
 
   IFreeTypeFontEnumerator = interface
@@ -127,7 +132,9 @@ type
     procedure Clear; virtual; abstract;
     procedure BeginUpdate; virtual; abstract;
     procedure AddFolder(AFolder: string); virtual; abstract;
+    procedure RemoveFolder(AFolder: string); virtual; abstract;
     function AddFile(AFilename: string): boolean; virtual; abstract;
+    function RemoveFile(AFilename: string): boolean; virtual; abstract;
     function AddStream(AStream: TStream; AOwned: boolean): boolean; virtual; abstract;
     procedure EndUpdate; virtual; abstract;
     function FontFileEnumerator: IFreeTypeFontEnumerator; virtual; abstract;
@@ -193,6 +200,8 @@ type
   TFreeTypeFont = class(TFreeTypeRenderableFont)
   private
     FName: String;
+    FFaceChanged: boolean;
+    FDPI: integer;
     FStream: TStream;
     FOwnedStream: boolean;
     FPointSize: single;
@@ -216,7 +225,7 @@ type
     procedure SetFreeTypeStyles(AValue: TFreeTypeStyles);
     procedure SetLineFullHeight(AValue: single);
     procedure SetStyleAsString(AValue: string);
-    procedure UpdateFace(const AName: String);
+    procedure LoadFace;
     procedure SetName(const AValue: String);
     procedure DiscardFace;
     procedure DiscardInstance;
@@ -242,6 +251,7 @@ type
     FCharMap: TT_CharMap;
     FCharmapOk: boolean;
     FAscentValue, FDescentValue, FLineGapValue, FLargeLineGapValue, FCapHeight: single;
+    procedure FaceChanged;
     function GetClearType: boolean; override;
     procedure SetClearType(const AValue: boolean); override;
     function GetLineFullHeight: single; override;
@@ -254,6 +264,8 @@ type
     procedure OnDestroyFontItem;
     procedure FetchNames;
     function GetCollection: TCustomFreeTypeFontCollection;
+    function CheckFace: boolean;
+    function CheckInstance: boolean;
   public
     Quality : TGlyphRenderQuality;
     SmallLinePadding: boolean;
@@ -690,7 +702,7 @@ end;
 
 constructor TFreeTypeGlyph.Create(AFont: TFreeTypeFont; AIndex: integer);
 begin
-  if TT_New_Glyph(AFont.FFace, FGlyphData) <> TT_Err_Ok then
+  if not AFont.CheckFace or (TT_New_Glyph(AFont.FFace, FGlyphData) <> TT_Err_Ok) then
     raise Exception.Create('Cannot create empty glyph');
   FLoaded := AFont.LoadGlyphInto(FGlyphData, AIndex);
   FIndex := AIndex;
@@ -772,65 +784,63 @@ end;
 
 { TFreeTypeFont }
 
-procedure TFreeTypeFont.UpdateFace(const AName: String);
+procedure TFreeTypeFont.LoadFace;
 var errorNum: TT_Error;
-    PrevDPI: integer;
     familyItem: TCustomFamilyCollectionItem;
     fontItem: TCustomFontCollectionItem;
 begin
-  PrevDPI := DPI;
   DiscardFace;
-
   if FStream <> nil then
   begin
     errorNum := TT_Open_Face(FStream,False,FFace);
     if errorNum <> TT_Err_Ok then
       raise exception.Create('Cannot open font (TT_Error ' + intToStr(errorNum)+') <Stream>');
   end else
-  if (Pos(PathDelim, AName) <> 0) or (Collection = nil) or (Collection.FontFileCount = 0) then
   begin
-    if AName = '' then exit;
+    if Pos(PathDelim, FName) <> 0 then
-
+    begin
-    errorNum := TT_Open_Face(AName,FFace);
+      errorNum := TT_Open_Face(FName,FFace);
-    if errorNum <> TT_Err_Ok then
+      if errorNum <> TT_Err_Ok then
-      raise exception.Create('Cannot open font (TT_Error ' + intToStr(errorNum)+') "'+AName+'"');
+        raise exception.Create('Cannot open font (TT_Error ' + intToStr(errorNum)+') "'+FName+'"');
-  end else
+    end else
-  begin
+    begin
-    familyItem := Collection.Family[AName];
+      familyItem := Collection.Family[FName];
-    if familyItem = nil then
+      if familyItem = nil then
-      raise exception.Create('Font family not found');
+        raise exception.Create('Font family not found ("'+FName+'")');
-    fontItem := familyItem.GetFont(FStyleStr);
+      fontItem := familyItem.GetFont(FStyleStr);
-    if fontItem = nil then
+      if fontItem = nil then
-      raise exception.Create('Font style not found');
+        raise exception.Create('Font style not found ("'+FStyleStr+'")');
-    FFace := fontItem.QueryFace(@OnDestroyFontItem);
+      FFace := fontItem.QueryFace(@OnDestroyFontItem);
-    FFaceItem := fontItem;
+      FFaceItem := fontItem;
+    end;
   end;
 
   FFaceLoaded:= true;
-  FName:=AName;
   UpdateInstance;
-  DPI := PrevDPI;
 end;
 
 procedure TFreeTypeFont.SetName(const AValue: String);
 begin
   DiscardStream;
   if FName=AValue then exit;
-  UpdateFace(AValue);
+  FName := AValue;
+  FaceChanged;
 end;
 
 {$hints off}
 function TFreeTypeFont.GetDPI: integer;
 var metrics: TT_Instance_Metrics;
 begin
-  if not FInstanceCreated then
+  if not CheckInstance then
-    result := 96
+  begin
+    result := FDPI;
+  end
   else
   begin
     if TT_Get_Instance_Metrics(FInstance,metrics) = TT_Err_Ok then
       result := metrics.y_resolution
     else
-      result := 96;
+      result := FDPI;
   end;
 end;
 {$hints on}
@@ -898,7 +908,7 @@ function TFreeTypeFont.GetGlyph(Index: integer): TFreeTypeGlyph;
 var node: TAvgLvlTreeNode;
     lGlyph: TFreeTypeGlyph;
 begin
-  if not FInstanceCreated then
+  if not CheckInstance then
   begin
     result := nil;
     exit;
@@ -917,7 +927,7 @@ end;
 function TFreeTypeFont.GetGlyphCount: integer;
 var prop : TT_Face_Properties;
 begin
-  if not FFaceLoaded then
+  if not CheckFace then
     result := 0
   else
   begin
@@ -955,6 +965,7 @@ end;
 procedure TFreeTypeFont.OnDestroyFontItem;
 begin
   DiscardFace;
+  FaceChanged;
 end;
 
 function TFreeTypeFont.GetPixelSize: single;
@@ -986,6 +997,8 @@ end;
 
 procedure TFreeTypeFont.SetDPI(const AValue: integer);
 begin
+  if FDPI = AValue then exit;
+  FDPI := AValue;
   if FInstanceCreated then
   begin
     TT_Set_Instance_Resolutions(FInstance, AValue,AValue);
@@ -1033,7 +1046,7 @@ begin
   AValue := Trim(AValue);
   if FStyleStr=AValue then Exit;
   FStyleStr:=AValue;
-  UpdateFace(FName);
+  FaceChanged;
 end;
 
 procedure TFreeTypeFont.DiscardFace;
@@ -1077,8 +1090,7 @@ end;
 
 procedure TFreeTypeFont.SetPixelSize(const AValue: single);
 begin
-  if FInstanceCreated then
+  SizeInPoints := AValue*72/DPI;
-    SizeInPoints := AValue*72/DPI;
 end;
 
 procedure TFreeTypeFont.SetPointSize(AValue: single);
@@ -1086,14 +1098,13 @@ begin
   if AValue < FreeTypeMinPointSize then AValue := FreeTypeMinPointSize;
   if FPointSize=AValue then exit;
   FPointSize:=AValue;
-  if FInstanceCreated then
+  UpdateSizeInPoints;
-    UpdateSizeInPoints;
 end;
 
 function TFreeTypeFont.LoadGlyphInto(_glyph: TT_Glyph; glyph_index: Word): boolean;
 var flags: integer;
 begin
-  if not FInstanceCreated then
+  if not CheckInstance then
     raise Exception.Create('No font instance');
   flags := TT_Load_Scale_Glyph;
   if FHinted then flags := flags or TT_Load_Hint_Glyph;
@@ -1105,8 +1116,7 @@ begin
   if FWidthFactor=AValue then exit;
   FWidthFactor:=AValue;
   FGlyphTable.FreeAndClear;
-  if FInstanceCreated then
+  UpdateSizeInPoints;
-    UpdateSizeInPoints;
 end;
 
 procedure TFreeTypeFont.UpdateInstance;
@@ -1119,6 +1129,8 @@ begin
   if errorNum = TT_Err_Ok then
   begin
     FInstanceCreated := true;
+    TT_Set_Instance_Resolutions(FInstance, FDPI,FDPI);
+    UpdateSizeInPoints;
     UpdateMetrics;
     UpdateCharmap;
   end else
@@ -1144,7 +1156,7 @@ end;
 procedure TFreeTypeFont.UpdateMetrics;
 var prop: TT_Face_Properties;
 begin
-  if FFaceLoaded then
+  if CheckFace then
   begin
     TT_Get_Face_Properties(FFace,prop);
     FAscentValue := prop.horizontal^.ascender;
@@ -1198,7 +1210,7 @@ end;
 
 procedure TFreeTypeFont.UpdateCharmap;
 var i,n: integer;
-    platform,encoding: integer;
+    lPlatform,encoding: integer;
 begin
   if FCharmapOk then exit;
   if not FFaceLoaded then
@@ -1208,15 +1220,15 @@ begin
   end;
 
   n := TT_Get_CharMap_Count(FFace);
-  platform := 0;
+  lPlatform := 0;
   encoding := 0;
 
   //MS Unicode
   for i := 0 to n-1 do
   begin
-    if TT_Get_CharMap_ID(FFace, i, platform, encoding) = TT_Err_Ok then
+    if TT_Get_CharMap_ID(FFace, i, lPlatform, encoding) = TT_Err_Ok then
     begin
-      if (platform = 3) and (encoding = 1) then
+      if (lPlatform = 3) and (encoding = 1) then
         if TT_Get_CharMap(FFace, i, FCharMap) = TT_Err_Ok then
         begin
           FCharmapOk := true;
@@ -1228,9 +1240,9 @@ begin
   //Apple Unicode
   for i := 0 to n-1 do
   begin
-    if TT_Get_CharMap_ID(FFace, i, platform, encoding) = TT_Err_Ok then
+    if TT_Get_CharMap_ID(FFace, i, lPlatform, encoding) = TT_Err_Ok then
     begin
-      if (platform = 0) then
+      if (lPlatform = 0) then
         if TT_Get_CharMap(FFace, i, FCharMap) = TT_Err_Ok then
         begin
           FCharmapOk := true;
@@ -1242,9 +1254,9 @@ begin
   //ISO Unicode
   for i := 0 to n-1 do
   begin
-    if TT_Get_CharMap_ID(FFace, i, platform, encoding) = TT_Err_Ok then
+    if TT_Get_CharMap_ID(FFace, i, lPlatform, encoding) = TT_Err_Ok then
     begin
-      if (platform = 2) and (encoding = 1) then
+      if (lPlatform = 2) and (encoding = 1) then
         if TT_Get_CharMap(FFace, i, FCharMap) = TT_Err_Ok then
         begin
           FCharmapOk := true;
@@ -1314,6 +1326,15 @@ begin
   end;
 end;
 
+procedure TFreeTypeFont.FaceChanged;
+begin
+  if not FFaceChanged then
+  begin
+    FFaceChanged := true;
+    DiscardFace;
+  end;
+end;
+
 constructor TFreeTypeFont.Create;
 begin
   EnsureFreeTypeInitialized;
@@ -1322,6 +1343,7 @@ begin
   FInstanceCreated := false;
   FCharmapOk := false;
   FPointSize := 10;
+  FDPI := 96;
   FGlyphTable := TAvgLvlTree.Create;
   FHinted := true;
   FWidthFactor := 1;
@@ -1329,8 +1351,7 @@ begin
   FStyleStr:= 'Regular';
   SmallLinePadding:= true;
   Quality := grqHighQuality;
-
+  FFaceChanged := true;
-  UpdateFace('');
 end;
 
 destructor TFreeTypeFont.Destroy;
@@ -1347,7 +1368,7 @@ begin
   DiscardStream;
   FStream := AStream;
   FOwnedStream:= AStreamOwner;
-  UpdateFace('');
+  FaceChanged;
 end;
 
 procedure TFreeTypeFont.RenderText(AText: string; x, y: single; ARect: TRect;
@@ -1358,7 +1379,7 @@ var
   idx: integer;
   g: TFreeTypeGlyph;
 begin
-  if not FInstanceCreated then exit;
+  if not CheckInstance then exit;
   if AText = '' then exit;
   idx := pos(LineEnding,AText);
   while idx <> 0 do
@@ -1394,13 +1415,13 @@ begin
   end;
 end;
 
-procedure TFreeTypeFont.SetNameAndStyle(AName: String; AStyle: string);
+procedure TFreeTypeFont.SetNameAndStyle(AName: string; AStyle: string);
 begin
   AStyle := Trim(AStyle);
   if (AName = FName) and (AStyle = FStyleStr) then exit;
   FName := AName;
   FStyleStr := AStyle;
-  UpdateFace(FName);
+  FaceChanged;
 end;
 
 procedure TFreeTypeFont.SetNameAndStyle(AName: string; AStyle: TFreeTypeStyles);
@@ -1421,7 +1442,7 @@ var
   g: TFreeTypeGlyph;
 begin
   result := 0;
-  if not FInstanceCreated then exit;
+  if not CheckInstance then exit;
   if AText = '' then exit;
 
   maxWidth := 0;
@@ -1560,7 +1581,7 @@ var
   g: TFreeTypeGlyph;
 begin
   result := nil;
-  if not FInstanceCreated then exit;
+  if not CheckInstance then exit;
   if AText = '' then exit;
   StrLineEnding := LineEnding;
   pstr := @AText[1];
@@ -1683,7 +1704,7 @@ var i,j: integer;
 
 begin
   setlength(FNamesArray, maxNameIndex+1);
-  if FFaceLoaded then
+  if CheckFace then
   begin
     for i := 0 to TT_Get_Name_Count(FFace)-1 do
     begin
@@ -1725,6 +1746,21 @@ begin
     result := FCollection;
 end;
 
+function TFreeTypeFont.CheckFace: boolean;
+begin
+  if FFaceChanged then
+  begin
+    FFaceChanged:= false;
+    LoadFace;
+  end;
+  result := FFaceLoaded;
+end;
+
+function TFreeTypeFont.CheckInstance: boolean;
+begin
+  result := CheckFace and FInstanceCreated;
+end;
+
 { TFreeTypeGrayscaleMap }
 
 procedure TFreeTypeGrayscaleMap.Init(AWidth, AHeight: integer);

components/lazutils/lazfreetypefontcollection.pas

@@ -65,13 +65,16 @@ type
     function GetFontIndexByStyles(AStyles: string): integer;
     function GetStyle(AIndex: integer): string; override;
     procedure AddStyle(AName: string);
+    function RemoveStyle(AName: string): boolean;
     function GetStyles: string; override;
     function GetFamilyName: string; override;
     function GetFontCount: integer; override;
     function GetStyleCount: integer; override;
+    procedure RebuildStyleList(out ADuplicates: boolean);
   public
     constructor Create(AName: string);
     procedure AddFont(AFontItem: TFontCollectionItem);
+    function RemoveFont(AFontItem: TCustomFontCollectionItem): boolean;
     function GetFont(const AStyles: array of string; NeedAllStyles: boolean = false; NoMoreStyle: boolean = false): TCustomFontCollectionItem; override;
     function GetFont(AStyle: string; NeedAllStyles: boolean = false; NoMoreStyle: boolean = false): TCustomFontCollectionItem; override;
     function GetFontIndex(const AStyles: array of string; NeedAllStyles: boolean = false; NoMoreStyle: boolean = false): integer; override;
@@ -101,13 +104,15 @@ type
     function GetFamily(AName: string): TCustomFamilyCollectionItem; override;
     function GetFamilyCount: integer; override;
     function GetFontCount: integer; override;
-
+    function RemoveAndFreeFamily(AFamily: TCustomFamilyCollectionItem): boolean;
   public
     constructor Create; override;
     procedure Clear; override;
     procedure BeginUpdate; override;
     procedure AddFolder(AFolder: string); override;
+    procedure RemoveFolder(AFolder: string); override;
     function AddFile(AFilename: string): boolean; override;
+    function RemoveFile(AFilename: string): boolean; override;
     function AddStream(AStream: TStream; AOwned: boolean): boolean; override;
     procedure EndUpdate; override;
     destructor Destroy; override;
@@ -457,6 +462,21 @@ begin
   inc(FStyleCount);
 end;
 
+function TFamilyCollectionItem.RemoveStyle(AName: string): boolean;
+var i,j: integer;
+begin
+  for i := 0 to FStyleCount-1 do
+    if CompareText(FStyles[i],AName)=0 then
+    begin
+      for j := i to FStyleCount-2 do
+        FStyles[j] := FStyles[j+1];
+      dec(FStyleCount);
+      result := true;
+      exit;
+    end;
+  result := false;
+end;
+
 function TFamilyCollectionItem.GetStyles: string;
 var i: integer;
 begin
@@ -483,6 +503,31 @@ begin
   result := FStyleCount;
 end;
 
+procedure TFamilyCollectionItem.RebuildStyleList(out ADuplicates: boolean);
+var
+  i: Integer;
+  j: Integer;
+begin
+  FStyleCount := 0;
+  ADuplicates := false;
+  for i := 0 to FFontCount-1 do
+  begin
+    FFonts[i].UsePostscriptStyle := true;
+    for j := 0 to FFonts[i].StyleCount -1 do
+     AddStyle(FFonts[i].Style[j]);
+
+    //add regular style if no other style
+    if FFonts[i].StyleCount = 0 then AddStyle('Regular');
+
+    for j := 0 to i-1 do
+      if FFonts[j].Styles = FFonts[i].Styles then
+      begin
+        ADuplicates:= true;
+        break;
+      end;
+  end;
+end;
+
 constructor TFamilyCollectionItem.Create(AName: string);
 begin
   FFamilyName:= AName;
@@ -494,15 +539,24 @@ begin
 end;
 
 procedure TFamilyCollectionItem.AddFont(AFontItem: TFontCollectionItem);
-var i,j: integer;
+var i: integer;
     DuplicateStyle: boolean;
     StyleNumber: integer;
     TempStyles,BaseStyle: string;
 begin
+  if AFontItem = nil then exit;
+
+  for i := 0 to FFontCount-1 do
+    if FFonts[i] = AFontItem then exit;
+
+  if AFontItem.Family <> nil then
+    raise exception.Create('This font already belongs to another family');
+
   if FFontCount = length(FFonts) then
     setlength(FFonts, length(FFonts)+4);
 
   FFonts[FFontCount] := AFontItem;
+  AFontItem.Family := self;
   inc(FFontCount);
 
   if FUsePostscriptStyle then AFontItem.UsePostscriptStyle := true;
@@ -510,6 +564,9 @@ begin
   for i := 0 to AFontItem.StyleCount -1 do
     AddStyle(AFontItem.Style[i]);
 
+  //add regular style if no other style
+  if AFontItem.StyleCount = 0 then AddStyle('Regular');
+
   DuplicateStyle := false;
   for i := 0 to FFontCount-2 do
     if FFonts[i].Styles = AFontItem.Styles then
@@ -521,21 +578,7 @@ begin
   if DuplicateStyle and not FUsePostscriptStyle then
   begin //try with postscript styles instead
     FUsePostscriptStyle:= true;
-    FStyleCount := 0;
+    RebuildStyleList(DuplicateStyle);
-    DuplicateStyle := false;
-    for i := 0 to FFontCount-1 do
-    begin
-      FFonts[i].UsePostscriptStyle := true;
-      for j := 0 to FFonts[i].StyleCount -1 do
-       AddStyle(FFonts[i].Style[j]);
-
-      for j := 0 to i-1 do
-        if FFonts[j].Styles = FFonts[i].Styles then
-        begin
-          DuplicateStyle:= true;
-          break;
-        end;
-    end;
   end;
 
   if DuplicateStyle then
@@ -558,8 +601,6 @@ begin
     until not DuplicateStyle;
     AFontItem.Information[ftiStyle] := TempStyles;
   end;
-
-  if AFontItem.StyleCount = 0 then AddStyle('Regular');
 end;
 
 function TFamilyCollectionItem.GetFont(const AStyles: array of string;
@@ -627,6 +668,25 @@ begin
     result := GetFontIndex(StylesToArray(AStyle),NeedAllStyles,NoMoreStyle);
 end;
 
+function TFamilyCollectionItem.RemoveFont(AFontItem: TCustomFontCollectionItem
+  ): boolean;
+var i,j: integer;
+  dummy: boolean;
+begin
+  for i := 0 to FFontCount-1 do
+    if FFonts[i] = AFontItem then
+    begin
+      for j := i to FFontCount-2 do
+        FFonts[j] := FFonts[j+1];
+      dec(FFontCount);
+      AFontItem.Family := nil;
+      RebuildStyleList(dummy);
+      result := true;
+      exit;
+    end;
+  result := false;
+end;
+
 function TFamilyCollectionItem.GetFont(AStyle: string; NeedAllStyles: boolean; NoMoreStyle: boolean): TCustomFontCollectionItem;
 begin
   result := GetFontByStyles(AStyle); //exact match
@@ -653,6 +713,17 @@ begin
   result := FFontList.Count;
 end;
 
+function TFreeTypeFontCollection.RemoveAndFreeFamily(
+  AFamily: TCustomFamilyCollectionItem): boolean;
+begin
+  if FFamilyList.Remove(Pointer(AFamily)) then
+  begin
+    result := true;
+    AFamily.Free;
+  end else
+    result := false;
+end;
+
 function TFreeTypeFontCollection.GetFamilyCount: integer;
 begin
   result := FFamilyList.Count;
@@ -751,6 +822,7 @@ end;
 function TFreeTypeFontCollection.GetFont(AFileName: string
   ): TCustomFontCollectionItem;
 begin
+  AFilename:= ExpandFileName(AFilename);
   result := FindFont(AFilename);
 end;
 
@@ -780,6 +852,7 @@ var sr: TSearchRec;
     files: TStringList;
     i: integer;
 begin
+  AFolder := ExpandFileName(AFolder);
   if (length(AFolder) <> 0) and (AFolder[length(AFolder)] <> PathDelim) then
     AFolder += PathDelim;
 
@@ -801,12 +874,39 @@ begin
   files.Free;
 end;
 
+procedure TFreeTypeFontCollection.RemoveFolder(AFolder: string);
+var toBeDeleted: TStringList;
+    enumerator: TAvgLvlTreeNodeEnumerator;
+    i: Integer;
+begin
+  AFolder := ExpandFileName(AFolder);
+  if (length(AFolder) <> 0) and (AFolder[length(AFolder)] <> PathDelim) then
+    AFolder += PathDelim;
+
+  toBeDeleted := TStringList.Create;
+  enumerator := FFontList.GetEnumerator;
+  while enumerator.MoveNext do
+  begin
+    with TCustomFontCollectionItem(enumerator.Current.Data) do
+    begin
+      if copy(Filename, 1, length(AFolder)) = AFolder then
+        toBeDeleted.Add(Filename);
+    end;
+  end;
+  enumerator.Free;
+
+  for i := 0 to toBeDeleted.Count-1 do
+    RemoveFile(toBeDeleted[i]);
+  toBeDeleted.Free;
+end;
+
 function TFreeTypeFontCollection.AddFile(AFilename: string): boolean;
 var info: TFreeTypeInformation;
     fName: string;
     item: TFontCollectionItem;
     f: TFamilyCollectionItem;
 begin
+  AFilename:= ExpandFileName(AFilename);
   result := false;
   BeginUpdate;
   try
@@ -831,6 +931,27 @@ begin
   end;
 end;
 
+function TFreeTypeFontCollection.RemoveFile(AFilename: string): boolean;
+var fontItem : TCustomFontCollectionItem;
+    f: TFamilyCollectionItem;
+begin
+  AFilename:= ExpandFileName(AFilename);
+  fontItem := GetFont(AFilename);
+  if (fontItem = nil) or not (fontItem.Family is TFamilyCollectionItem) then
+  begin
+    result := false;
+    exit;
+  end;
+  FFontList.Remove(Pointer(fontItem));
+  f := fontItem.Family as TFamilyCollectionItem;
+  result := f.RemoveFont(fontItem);
+  if result then
+  begin
+    if f.FontCount = 0 then
+      RemoveAndFreeFamily(f);
+  end;
+end;
+
 function TFreeTypeFontCollection.AddStream(AStream: TStream; AOwned: boolean): boolean;
 var info: TFreeTypeInformation;
     fName: string;

components/lazutils/ttfile.pas

@@ -246,7 +246,7 @@ const
    try
      ftstream := TFreeTypeStream.Create(name);
      if ftstream.Activate then
-       raise exception.Create('Cannot activate');
+       raise exception.Create('Cannot activate stream, file may not exist');
    except
      on ex: Exception do
      begin