paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-11 15:48:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: make lcl resource cache thread-safe (based on patch of Bernd Engelhardt, issue #0016092)

Browse Source 
git-svn-id: trunk@24716 -
This commit is contained in:
paul 2010-04-19 09:01:04 +00:00
parent 4a245a3f0d
commit d20b80df76
4 changed files with 122 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
lcl/include/brush.inc
View File

@ -174,10 +174,15 @@ begin
Changing;
if FBrushHandleCached then
begin
CacheItem := BrushResourceCache.FindItem(FReference.Handle);
if CacheItem <> nil then
CacheItem.DecreaseRefCount;
FBrushHandleCached := False;
BrushResourceCache.Lock;
try
CacheItem := BrushResourceCache.FindItem(FReference.Handle);
if CacheItem <> nil then
CacheItem.DecreaseRefCount;
FBrushHandleCached := False;
finally
BrushResourceCache.Unlock;
end;
end else
DeleteObject(HGDIOBJ(FReference.Handle));
FReference._lclHandle := 0;
@ -219,20 +224,25 @@ begin
lbColor := ColorRef(FColor);
end;
CachedBrush := BrushResourceCache.FindDescriptor(@LogBrush);
if CachedBrush <> nil then
begin
CachedBrush.Item.IncreaseRefCount;
FReference._lclHandle := CachedBrush.Item.Handle;
end else
begin
if LogBrush.lbStyle <> BS_PATTERN then
FReference._lclHandle := TLCLHandle(CreateBrushIndirect(LogBrush))
else
FReference._lclHandle := TLCLHandle(CreatePatternBrush(LogBrush.lbHatch));
BrushResourceCache.AddResource(FReference.Handle, @LogBrush);
BrushResourceCache.Lock;
try
CachedBrush := BrushResourceCache.FindDescriptor(@LogBrush);
if CachedBrush <> nil then
begin
CachedBrush.Item.IncreaseRefCount;
FReference._lclHandle := CachedBrush.Item.Handle;
end else
begin
if LogBrush.lbStyle <> BS_PATTERN then
FReference._lclHandle := TLCLHandle(CreateBrushIndirect(LogBrush))
else
FReference._lclHandle := TLCLHandle(CreatePatternBrush(LogBrush.lbHatch));
BrushResourceCache.AddResource(FReference.Handle, @LogBrush);
end;
FBrushHandleCached := True;
finally
BrushResourceCache.Unlock;
end;
FBrushHandleCached := True;
FInternalUpdateIndex := GraphicsUpdateCount;
end;

44
lcl/include/font.inc
View File

@ -1110,20 +1110,25 @@ begin
lfPitchAndFamily := DEFAULT_PITCH;
end;
end;
// ask the font cache for the nearest font
CachedFont := FontResourceCache.FindFontDesc(ALogFont, Name);
//DebugLn(['TFont.GetHandle in cache: ',CachedFont<>nil]);
if CachedFont <> nil then
begin
CachedFont.Item.IncreaseRefCount;
FReference._lclHandle := CachedFont.Item.Handle;
end else
begin
// ask the interface for the nearest font
FReference._lclHandle := TLCLHandle(CreateFontIndirectEx(ALogFont, Name));
FontResourceCache.Add(FReference.Handle, ALogFont, Name);
FontResourceCache.Lock;
try
// ask the font cache for the nearest font
CachedFont := FontResourceCache.FindFontDesc(ALogFont, Name);
//DebugLn(['TFont.GetHandle in cache: ',CachedFont<>nil]);
if CachedFont <> nil then
begin
CachedFont.Item.IncreaseRefCount;
FReference._lclHandle := CachedFont.Item.Handle;
end else
begin
// ask the interface for the nearest font
FReference._lclHandle := TLCLHandle(CreateFontIndirectEx(ALogFont, Name));
FontResourceCache.Add(FReference.Handle, ALogFont, Name);
end;
FFontHandleCached := True;
finally
FontResourceCache.Unlock;
end;
FFontHandleCached := True;
FCanUTF8Valid := False;
FIsMonoSpaceValid := False;
end;
@ -1170,9 +1175,16 @@ begin
Changing;
if FFontHandleCached then
begin
if FontResourceCache <> nil then
FontResourceCache.FindFont(FReference.Handle).DecreaseRefCount;
FFontHandleCached := False;
if Assigned(FontResourceCache) then
begin
FontResourceCache.Lock;
try
FontResourceCache.FindFont(FReference.Handle).DecreaseRefCount;
FFontHandleCached := False;
finally
FontResourceCache.Unlock;
end;
end;
end else
DeleteObject(HGDIOBJ(FReference.Handle));
FReference._lclHandle := 0;

90
lcl/include/pen.inc
View File

@ -388,47 +388,52 @@ begin
elpColor := FColor;
end;
if Style = psPattern then
CachedPen := PenResourceCache.FindPenDesc(AExtPen, FPattern)
else
CachedPen := PenResourceCache.FindPenDesc(AExtPen, nil);
if CachedPen <> nil then
begin
CachedPen.Item.IncreaseRefCount;
FReference._lclHandle := CachedPen.Item.Handle;
end else
begin
// choose which function to use: CreatePenIndirect or ExtCreatePen
if ((AExtPen.elpPenStyle and PS_STYLE_MASK) = AExtPen.elpPenStyle) and
(AExtPen.elpPenStyle <> PS_USERSTYLE) then
begin
// simple pen
ALogPen.lopnStyle := AExtPen.elpPenStyle;
ALogPen.lopnWidth := Point(AExtPen.elpWidth, 0);
ALogPen.lopnColor := AExtPen.elpColor;
FReference._lclHandle := TLCLHandle(CreatePenIndirect(ALogPen));
end
else
begin
// extended pen
ALogBrush.lbStyle := AExtPen.elpBrushStyle;
ALogBrush.lbColor := AExtPen.elpColor;
ALogBrush.lbHatch := AExtPen.elpHatch;
if (Style = psPattern) and (Length(FPattern) > 0) then
FReference._lclHandle := TLCLHandle(ExtCreatePen(AExtPen.elpPenStyle,
AExtPen.elpWidth, ALogBrush, Length(FPattern), @FPattern[0]))
else
FReference._lclHandle := TLCLHandle(ExtCreatePen(AExtPen.elpPenStyle,
AExtPen.elpWidth, ALogBrush, 0, nil));
end;
PenResourceCache.Lock;
try
if Style = psPattern then
PenResourceCache.Add(FReference.Handle, AExtPen, FPattern)
CachedPen := PenResourceCache.FindPenDesc(AExtPen, FPattern)
else
PenResourceCache.Add(FReference.Handle, AExtPen, nil);
CachedPen := PenResourceCache.FindPenDesc(AExtPen, nil);
if CachedPen <> nil then
begin
CachedPen.Item.IncreaseRefCount;
FReference._lclHandle := CachedPen.Item.Handle;
end else
begin
// choose which function to use: CreatePenIndirect or ExtCreatePen
if ((AExtPen.elpPenStyle and PS_STYLE_MASK) = AExtPen.elpPenStyle) and
(AExtPen.elpPenStyle <> PS_USERSTYLE) then
begin
// simple pen
ALogPen.lopnStyle := AExtPen.elpPenStyle;
ALogPen.lopnWidth := Point(AExtPen.elpWidth, 0);
ALogPen.lopnColor := AExtPen.elpColor;
FReference._lclHandle := TLCLHandle(CreatePenIndirect(ALogPen));
end
else
begin
// extended pen
ALogBrush.lbStyle := AExtPen.elpBrushStyle;
ALogBrush.lbColor := AExtPen.elpColor;
ALogBrush.lbHatch := AExtPen.elpHatch;
if (Style = psPattern) and (Length(FPattern) > 0) then
FReference._lclHandle := TLCLHandle(ExtCreatePen(AExtPen.elpPenStyle,
AExtPen.elpWidth, ALogBrush, Length(FPattern), @FPattern[0]))
else
FReference._lclHandle := TLCLHandle(ExtCreatePen(AExtPen.elpPenStyle,
AExtPen.elpWidth, ALogBrush, 0, nil));
end;
if Style = psPattern then
PenResourceCache.Add(FReference.Handle, AExtPen, FPattern)
else
PenResourceCache.Add(FReference.Handle, AExtPen, nil);
end;
FPenHandleCached := True;
finally
PenResourceCache.Unlock;
end;
FPenHandleCached := True;
end;
procedure TPen.SetCosmetic(const AValue: Boolean);
@ -466,8 +471,13 @@ begin
Changing;
if FPenHandleCached then
begin
PenResourceCache.FindPen(FReference.Handle).DecreaseRefCount;
FPenHandleCached := False;
PenResourceCache.Lock;
try
PenResourceCache.FindPen(FReference.Handle).DecreaseRefCount;
FPenHandleCached := False;
finally
PenResourceCache.Unlock;
end;
end else
DeleteObject(HGDIOBJ(FReference.Handle));
FReference._lclHandle := 0;

18
lcl/lclrescache.pas
View File

@ -25,7 +25,8 @@ unit LCLResCache;
interface
uses
Classes, SysUtils, FPCAdds, Types, LCLType, LCLProc, AvgLvlTree, WSReferences;
Classes, SysUtils, FPCAdds, Types, LCLType, LCLProc, AvgLvlTree, WSReferences,
syncobjs;
{off $DEFINE CheckResCacheConsistency}
@ -86,6 +87,7 @@ type
FMaxUnusedItem: integer; // how many freed resources to keep
FFirstUnusedItem, FLastUnusedItem: TResourceCacheItem;
FUnUsedItemCount: integer;
FLock: TCriticalSection;
procedure RemoveItem(Item: TResourceCacheItem); virtual;
procedure RemoveDescriptor(Desc: TResourceCacheDescriptor); virtual;
procedure ItemUsed(Item: TResourceCacheItem);
@ -98,6 +100,8 @@ type
function CompareItems(Tree: TAvgLvlTree; Item1, Item2: Pointer): integer; virtual;
function CompareDescriptors(Tree: TAvgLvlTree; Desc1, Desc2: Pointer): integer; virtual; abstract;
procedure ConsistencyCheck;
procedure Lock;
procedure Unlock;
public
property MaxUnusedItem: integer read FMaxUnusedItem
write FMaxUnusedItem;
@ -358,6 +362,7 @@ begin
FDescriptors := TAvgLvlTree.CreateObjectCompare(@CompareDescriptors);
FResourceCacheItemClass := TResourceCacheItem;
FResourceCacheDescriptorClass := TResourceCacheDescriptor;
FLock := TCriticalSection.Create;
end;
procedure TResourceCache.Clear;
@ -376,6 +381,7 @@ begin
FItems := nil;
FDescriptors.Free;
FDescriptors := nil;
FLock.Free;
inherited Destroy;
end;
@ -445,6 +451,16 @@ begin
end;
end;
procedure TResourceCache.Lock;
begin
FLock.Enter;
end;
procedure TResourceCache.Unlock;
begin
FLock.Leave;
end;
{ THandleResourceCache }
function THandleResourceCache.FindItem(Handle: TLCLHandle): TResourceCacheItem;