paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-03 01:38:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazUtils: Remove ambiguity from font item listeners. Issue #28137, patch from Johann.

Browse Source 
git-svn-id: trunk@49136 -
This commit is contained in:
juha 2015-05-22 20:20:39 +00:00
parent 89b1411c3f
commit 0fe92eae95
2 changed files with 32 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
components/lazutils/easylazfreetype.pas
View File

@ -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

18
components/lazutils/lazfreetypefontcollection.pas
View File

@ -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];