paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-05 07:58:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: accelerated new/dispose of gdiobjects

Browse Source 
git-svn-id: trunk@2190 -
This commit is contained in:
lazarus 2002-08-17 23:41:06 +00:00
parent e717242eba
commit 3c67429d0a
1 changed files with 92 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
lcl/interfaces/gtk/gtkdef.pp
View File

@ -33,7 +33,7 @@ unit GtkDef;
interface
uses
gtk, gdk, LCLLinux, LCLType, VclGlobals, Classes;
gtk, gdk, LCLLinux, LCLType, VclGlobals, Classes, LCLMemManager;
type
TGDIType = (gdiBitmap, gdiBrush, gdiFont, gdiPen, gdiRegion);
@ -56,6 +56,7 @@ type
PGDIObject = ^TGDIObject;
TGDIObject = record
Next: PGDIObject;
case GDIType: TGDIType of
gdiBitmap: (
GDIBitmapMaskObject: PGdkPixmap;
@ -101,6 +102,7 @@ type
ClipRegion : hRGN;
SavedContext: PDeviceContext; // linked list of saved DCs
end;
// Info needed by the API of a HWND (=Widget)
PWinWidgetInfo = ^TWinWidgetInfo;
@ -137,13 +139,102 @@ const
);
function NewPGDIObject: PGDIObject;
procedure DisposePGDIObject(GDIObject: PGdiObject);
implementation
{$IFOpt R+}{$Define RangeChecksOn}{$Endif}
type
// memory system for PGDIObject(s)
TGDIObjectMemManager = class(TLCLMemManager)
protected
procedure FreeFirstItem; override;
public
procedure DisposeGDIObject(AGDIObject: PGDIObject);
function NewGDIObject: PGDIObject;
end;
const
GDIObjectMemManager: TGDIObjectMemManager = nil;
function NewPGDIObject: PGDIObject;
begin
if GDIObjectMemManager=nil then begin
GDIObjectMemManager:=TGDIObjectMemManager.Create;
GDIObjectMemManager.MinimumFreeCount:=1000;
end;
Result:=GDIObjectMemManager.NewGDIObject;
end;
procedure DisposePGDIObject(GDIObject: PGdiObject);
begin
GDIObjectMemManager.DisposeGDIObject(GDIObject);
end;
{ TGDIObjectMemManager }
procedure TGDIObjectMemManager.FreeFirstItem;
var AGDIObject: PGDIObject;
begin
AGDIObject:=PGDIObject(FFirstFree);
PGDIObject(FFirstFree):=AGDIObject^.Next;
Dispose(AGDIObject);
end;
procedure TGDIObjectMemManager.DisposeGDIObject(AGDIObject: PGDIObject);
begin
if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
begin
// add AGDIObject to Free list
AGDIObject^.Next:=PGDIObject(FFirstFree);
PGDIObject(FFirstFree):=AGDIObject;
inc(FFreeCount);
end else begin
// free list full -> free the ANode
Dispose(AGDIObject);
{$R-}
inc(FFreedCount);
{$IfDef RangeChecksOn}{$R+}{$Endif}
end;
dec(FCount);
end;
function TGDIObjectMemManager.NewGDIObject: PGDIObject;
begin
if FFirstFree<>nil then begin
// take from free list
Result:=PGDIObject(FFirstFree);
PGDIObject(FFirstFree):=Result^.Next;
dec(FFreeCount);
end else begin
// free list empty -> create new node
New(Result);
{$R-}
inc(FAllocatedCount);
{$IfDef RangeChecksOn}{$R+}{$Endif}
end;
FillChar(Result^, SizeOf(TGDIObject), 0);
inc(FCount);
end;
//------------------------------------------------------------------------------
finalization
GDIObjectMemManager.Free;
GDIObjectMemManager:=nil;
end.
{ =============================================================================
$Log$
Revision 1.11 2002/08/21 08:13:37 lazarus
MG: accelerated new/dispose of gdiobjects
Revision 1.10 2002/08/15 15:46:49 lazarus
MG: added changes from Andrew (Clipping)