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

implemented TBrushHandleCache

Browse Source 
git-svn-id: trunk@5770 -
This commit is contained in:
mattias 2004-08-11 21:10:30 +00:00
parent 581bef95fc
commit 5d3ed6859c
2 changed files with 50 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lcl/graphics.pp
View File

@ -497,9 +497,17 @@ type
Style: TBrushStyle;
end;
TBrushHandleCache = class(TBlockResourceCache)
protected
procedure RemoveItem(Item: TResourceCacheItem); override;
public
constructor Create;
end;
TBrush = class(TGraphicsObject)
private
FBrushData: TBrushData;
FBrushHandleCached: boolean;
procedure FreeHandle;
protected
function GetHandle: HBRUSH;
@ -1218,6 +1226,7 @@ var
ScreenInfo: TLMScreenInit;
PenResourceCache: TPenHandleCache;
BrushResourceCache: TBrushHandleCache;
const
FontCharsets: array[0..18] of TIdentMapEntry = (
@ -1679,6 +1688,7 @@ procedure InterfaceFinal;
begin
//debugln('Graphics.InterfaceFinal');
FreeAndNil(PenResourceCache);
FreeAndNil(BrushResourceCache);
end;
initialization
@ -1687,6 +1697,7 @@ initialization
OnLoadGraphicFromClipboardFormat:=nil;
OnSaveGraphicToClipboardFormat:=nil;
PenResourceCache:=TPenHandleCache.Create;
BrushResourceCache:=TBrushHandleCache.Create;
RegisterIntegerConsts(TypeInfo(TColor), @IdentToColor, @ColorToIdent);
RegisterIntegerConsts(TypeInfo(TFontCharset), @IdentToCharset, @CharsetToIdent);
RegisterInterfaceFinalizationHandler(@InterfaceFinal);
@ -1704,6 +1715,9 @@ end.
{ =============================================================================
$Log$
Revision 1.141 2004/08/11 21:10:30 mattias
implemented TBrushHandleCache
Revision 1.140 2004/08/11 20:57:09 mattias
moved intfstrconsts.pp to lclstrconsts.pas, implemented TPenHandleCache

38
lcl/include/brush.inc
View File

@ -16,6 +16,24 @@
* *
*****************************************************************************
}
{ TBrushHandleCache }
procedure TBrushHandleCache.RemoveItem(Item: TResourceCacheItem);
begin
//debugln('TBrushHandleCache.RemoveItem ',HexStr(Cardinal(Item.Handle),8));
DeleteObject(Item.Handle);
inherited RemoveItem(Item);
end;
constructor TBrushHandleCache.Create;
begin
inherited Create(SizeOf(TBrushData));
end;
{ TBrush }
{------------------------------------------------------------------------------
Method: TBrush.SetColor
Params: Value: the new value
@ -146,6 +164,7 @@ end;
function TBrush.GetHandle: HBRUSH;
var
LogBrush: TLogBrush;
CachedBrush: TBlockResourceCacheDescriptor;
begin
if FBrushData.Handle = 0
then begin
@ -170,7 +189,15 @@ begin
end;
lbColor := ColorRef(FBrushData.Color);
end;
FBrushData.Handle := CreateBrushIndirect(LogBrush);
CachedBrush:=BrushResourceCache.FindDescriptor(@LogBrush);
if CachedBrush<>nil then begin
CachedBrush.Item.IncreaseRefCount;
FBrushData.Handle := CachedBrush.Item.Handle;
end else begin
FBrushData.Handle := CreateBrushIndirect(LogBrush);
BrushResourceCache.AddResource(FBrushData.Handle,@LogBrush);
end;
FBrushHandleCached:=true;
end;
Result := FBrushData.Handle;
@ -188,7 +215,11 @@ begin
if FBrushData.Handle <> 0
then begin
//TODO: what if a brush is currently selected
DeleteObject(FBrushData.Handle);
if FBrushHandleCached then begin
BrushResourceCache.FindItem(FBrushData.Handle).DecreaseRefCount;
FBrushHandleCached:=false;
end else
DeleteObject(FBrushData.Handle);
FBrushData.Handle := 0;
end;
end;
@ -196,6 +227,9 @@ end;
{ =============================================================================
$Log$
Revision 1.9 2004/08/11 21:10:30 mattias
implemented TBrushHandleCache
Revision 1.8 2004/08/11 20:57:09 mattias
moved intfstrconsts.pp to lclstrconsts.pas, implemented TPenHandleCache