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

MWE:

Browse Source 
+ Added some detailed info on unreleased GDIObjects

git-svn-id: trunk@227 -
This commit is contained in:
lazarus 2001-03-17 17:30:02 +00:00
parent d7a5998509
commit 33a7107d2e
1 changed files with 24 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
lcl/interfaces/gtk/gtkobject.inc
View File

@ -36,13 +36,31 @@ end;
Destructor for the class.
------------------------------------------------------------------------------}
destructor TgtkObject.Destroy;
const
GDITYPENAME: array[TGDIType] of String = ('gdiBitmap', 'gdiBrush', 'gdiFont', 'gdiPen', 'gdiRegion');
var
n: Integer;
p: PMsg;
GDITypeCount: array[TGDIType] of Integer;
GDIType: TGDIType;
begin
if (FDeviceContexts.Count > 0) or (FGDIObjects.Count > 0)
if (FDeviceContexts.Count > 0)
then begin
WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased DCs and %d unreleased GDIObjects' ,[FDeviceContexts.Count, FGDIObjects.Count]));
WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased DCs' ,[FDeviceContexts.Count]));
end;
if (FGDIObjects.Count > 0)
then begin
WriteLN(Format('[TgtkObject.Destroy] WARNING: There are %d unreleased GDIObjects, a detailed dump follows:' ,[FGDIObjects.Count]));
for GDIType := Low(GDIType) to High(GDIType) do
GDITypeCount[GDIType] := 0;
for n := 0 to FGDIObjects.Count - 1 do
Inc(GDITypeCount[PGdiObject(FGDIObjects[n])^.GDIType]);
for GDIType := Low(GDIType) to High(GDIType) do
begin
if GDITypeCount[GDIType] > 0
then WriteLN(Format('[TgtkObject.Destroy] %s: %d', [GDITYPENAME[GDIType], GDITypeCount[GDIType]]));
end
end;
if FMessageQueue.Count > 0
then begin
@ -2698,6 +2716,10 @@ end;
{ =============================================================================
$Log$
Revision 1.33 2001/03/17 17:30:02 lazarus
MWE:
+ Added some detailed info on unreleased GDIObjects
Revision 1.32 2001/03/15 14:40:09 lazarus
MG: added some mouse cursors