diff --git a/components/lazutils/easylazfreetype.pas b/components/lazutils/easylazfreetype.pas
index 7463767c01..d11fe3a8c6 100644
--- a/components/lazutils/easylazfreetype.pas
+++ b/components/lazutils/easylazfreetype.pas
@@ -48,7 +48,15 @@ type
   TFreeTypeGlyph = class;
   TFreeTypeFont = class;
 
-  TFontCollectionItemDestroyListener = procedure() of object;
+  TFontCollectionItemDestroyProc = procedure() of object;
+  TFontCollectionItemDestroyListener = record
+    TargetObject: TObject;
+    NotifyProc: TFontCollectionItemDestroyProc;
+  end;
+
+  function FontCollectionItemDestroyListener(ATargetObject: TObject; ANotifyProc: TFontCollectionItemDestroyProc): TFontCollectionItemDestroyListener;
+
+type
   ArrayOfFontCollectionItemDestroyListener = array of TFontCollectionItemDestroyListener;
   TCustomFamilyCollectionItem = class;
 
@@ -412,6 +420,14 @@ const
   //TT_PLATFORM_CUSTOM        = 4;
   //TT_PLATFORM_ADOBE         = 7; // artificial
 
+function FontCollectionItemDestroyListener(ATargetObject: TObject;
+  ANotifyProc: TFontCollectionItemDestroyProc
+  ): TFontCollectionItemDestroyListener;
+begin
+  result.TargetObject := ATargetObject;
+  result.NotifyProc := ANotifyProc;
+end;
+
 function StylesToArray(AStyles: string): ArrayOfString;
 var
   StartIndex, EndIndex: integer;
@@ -845,7 +861,7 @@ begin
       fontItem := familyItem.GetFont(FStyleStr);
       if fontItem = nil then
         raise exception.Create('Font style not found ("'+FStyleStr+'")');
-      FFace := fontItem.QueryFace(@OnDestroyFontItem);
+      FFace := fontItem.QueryFace(FontCollectionItemDestroyListener(self,@OnDestroyFontItem));
       FFaceItem := fontItem;
     end;
   end;
@@ -1102,7 +1118,7 @@ begin
     DiscardInstance;
     if FFaceItem <> nil then
     begin
-      FFaceItem.ReleaseFace(@OnDestroyFontItem);
+      FFaceItem.ReleaseFace(FontCollectionItemDestroyListener(self,@OnDestroyFontItem));
       FFaceItem := nil;
     end
     else
diff --git a/components/lazutils/lazfreetypefontcollection.pas b/components/lazutils/lazfreetypefontcollection.pas
index 8ae6f713a0..6af162c5f1 100644
--- a/components/lazutils/lazfreetypefontcollection.pas
+++ b/components/lazutils/lazfreetypefontcollection.pas
@@ -273,10 +273,17 @@ begin
 end;
 
 procedure TFontCollectionItem.NotifyDestroy;
-var i: integer;
+var
+  listener: TFontCollectionItemDestroyListener;
 begin
-  for i := 0 to high(FDestroyListeners) do
-    FDestroyListeners[i]();
+  //the list of listeners may change during the process
+  //so it is safer to avoid the 'for' loop
+  while length(FDestroyListeners) > 0 do
+  begin
+    listener := FDestroyListeners[high(FDestroyListeners)];
+    setlength(FDestroyListeners, length(FDestroyListeners)-1);
+    listener.NotifyProc();
+  end;
   FDestroyListeners := nil;
 end;
 
@@ -341,7 +348,7 @@ begin
   end;
   result := FFace;
   inc(FFaceUsage);
-  if Assigned(AListener) then
+  if Assigned(AListener.NotifyProc) then
   begin
     setlength(FDestroyListeners,length(FDestroyListeners)+1);
     FDestroyListeners[high(FDestroyListeners)] := AListener;
@@ -352,7 +359,8 @@ procedure TFontCollectionItem.ReleaseFace(AListener: TFontCollectionItemDestroyL
 var i,j: integer;
 begin
   for i := 0 to high(FDestroyListeners) do
-    if FDestroyListeners[i] = AListener then
+    if (FDestroyListeners[i].TargetObject = AListener.TargetObject) and
+       (FDestroyListeners[i].NotifyProc = AListener.NotifyProc) then
     begin
       for j := i to high(FDestroyListeners)-1 do
         FDestroyListeners[j] := FDestroyListeners[j+1];