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

MG: reduced mem leak of clipping stuff, still not fixed

Browse Source 
git-svn-id: trunk@1852 -
This commit is contained in:
lazarus 2002-08-17 23:39:04 +00:00
parent 2a3d550030
commit 204f5ecba3
1 changed files with 14 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -1480,7 +1480,8 @@ begin
DObj := PGdiObject(Dest); DObj := PGdiObject(Dest);
S1Obj := PGdiObject(Src1); S1Obj := PGdiObject(Src1);
S2Obj := PGdiObject(Src2); S2Obj := PGdiObject(Src2);
Continue := IsValidGDIObject(Dest) and IsValidGDIObject(Src1)and IsValidGDIObject(Src2); Continue := IsValidGDIObject(Dest) and IsValidGDIObject(Src1)
and IsValidGDIObject(Src2);
If Not Continue then begin If Not Continue then begin
WriteLn('WARNING: [TgtkObject.CombineRgn] Invalid HRGN'); WriteLn('WARNING: [TgtkObject.CombineRgn] Invalid HRGN');
Result := Error; Result := Error;
@ -1543,7 +1544,8 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TgtkObject.ExtSelectClipRGN(dc: hdc; rgn : hrgn; Mode : Longint) : Integer; function TgtkObject.ExtSelectClipRGN(dc: hdc; rgn : hrgn;
Mode : Longint) : Integer;
var var
OldC, Clip, OldC, Clip,
Tmp : hRGN; Tmp : hRGN;
@ -4263,6 +4265,8 @@ begin
then pDC^.CurrentPen := nil; then pDC^.CurrentPen := nil;
if pSavedDC^.CurrentBrush = pDC^.CurrentBrush if pSavedDC^.CurrentBrush = pDC^.CurrentBrush
then pDC^.CurrentBrush := nil; then pDC^.CurrentBrush := nil;
if pSavedDC^.ClipRegion = pDC^.ClipRegion
then pSavedDC^.ClipRegion := 0;
ReleaseDC(0,HDC(pSavedDC)); ReleaseDC(0,HDC(pSavedDC));
pDC^.SavedContext:=nil; pDC^.SavedContext:=nil;
end; end;
@ -4271,10 +4275,10 @@ begin
DeleteObject(HGDIObj(pDC^.CurrentPen)); DeleteObject(HGDIObj(pDC^.CurrentPen));
DeleteObject(HGDIObj(pDC^.CurrentFont)); DeleteObject(HGDIObj(pDC^.CurrentFont));
DeleteObject(HGDIObj(pDC^.CurrentBitmap)); DeleteObject(HGDIObj(pDC^.CurrentBitmap));
SelectClipRGN(DC, 0);
try try
{ On root window, we don't allocate a graphics context } { On root window, we don't allocate a graphics context }
if pDC^.GC <> nil then begin if pDC^.GC <> nil then begin
SelectClipRGN(DC, 0);
gdk_gc_unref(pDC^.GC); gdk_gc_unref(pDC^.GC);
end; end;
except except
@ -4468,16 +4472,17 @@ begin
if Result <> ERROR if Result <> ERROR
then with PDeviceContext(DC)^ do then with PDeviceContext(DC)^ do
begin begin
if GC = nil if (GC = nil) and (RGN <> 0)
then begin then begin
WriteLn('WARNING: [TgtkObject.SelectClipRGN] Uninitialized GC'); WriteLn('WARNING: [TgtkObject.SelectClipRGN] Uninitialized GC');
Result := ERROR; Result := ERROR;
end end
else begin else begin
If RGN = 0 then begin If (RGN = 0) or (GC = nil) then begin
DeleteObject(ClipRegion); DeleteObject(ClipRegion);
ClipRegion := 0; ClipRegion := 0;
SelectGDIRegion(DC); if GC<>nil then
SelectGDIRegion(DC);
end end
else else
If IsValidGDIObject(RGN) then begin If IsValidGDIObject(RGN) then begin
@ -5959,6 +5964,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.96 2002/08/21 07:16:59 lazarus
MG: reduced mem leak of clipping stuff, still not fixed
Revision 1.95 2002/08/19 20:34:48 lazarus Revision 1.95 2002/08/19 20:34:48 lazarus
MG: improved Clipping, TextOut, Polygon functions MG: improved Clipping, TextOut, Polygon functions