[SOLVED] Fixing memory leaks in function RenderWinControl

Forum > CustomDrawn

(1/1)

lagprogramming:
lcl/interfaces/customdrawn/customdrawnproc.pas has function RenderWinControl(var AImage: TLazIntfImage; var ACanvas: TLazCanvas; ACDWinControl: TCDWinControl; ACDForm: TCDForm): Boolean;
A simple form with a TEdit on it run for a couple of seconds in Linux-customdrawn. The application ran with heaptrc unit, which made the console window print lots of memory leaks. One of them was related to line: lRegion := TLazRegionWithChilds.Create; The memory allocated for lRegion is never freed.
As long as customdrawn is selected, the memory leak should be detectable on all operating systems.

This is the original code

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---function RenderWinControl(var AImage: TLazIntfImage; var ACanvas: TLazCanvas; ACDWinControl: TCDWinControl; ACDForm: TCDForm): Boolean;var lWinControl, lParentControl: TWinControl; struct : TPaintStruct; lCanvas: TCanvas; lControlCanvas: TLazCanvas; lBaseWindowOrg: TPoint; lControlStateEx: TCDControlStateEx; lDrawControl: Boolean; lRegion:TLazRegionWithChilds;begin Result := False; lWinControl := ACDWinControl.WinControl; {$ifdef VerboseCDWinControl} DebugLn(Format('[RenderWinControl] lWinControl=%x Name=%s:%s Left=%d' + ' Top=%d Width=%d Height=%d', [PtrInt(lWinControl), lWinControl.Name, lWinControl.ClassName, lWinControl.Left, lWinControl.Top, lWinControl.Width, lWinControl.Height])); {$endif} if lWinControl.Visible = False then Exit; // Disable the drawing itself, but keep the window org and region operations // or else clicking and other things are broken lDrawControl := ACDWinControl.IsControlBackgroundVisible(); // Save the Canvas state ACanvas.SaveState; ACanvas.ResetCanvasState; // lBaseWindowOrg makes debugging easier // Iterate to find the appropriate BaseWindowOrg relative to the parent control lBaseWindowOrg := FindControlPositionRelativeToTheForm(lWinControl); ACanvas.BaseWindowOrg := Point(lBaseWindowOrg.X, lBaseWindowOrg.Y - ACDForm.ScrollY); ACanvas.WindowOrg := Point(0, 0); // Prepare the clippping relative to the form ACanvas.Clipping := True; ACDWinControl.Region.Rect := Bounds(lBaseWindowOrg.X, lBaseWindowOrg.Y - ACDForm.ScrollY, lWinControl.Width, lWinControl.Height); lRegion := TLazRegionWithChilds.Create; lRegion.Assign(ACDWinControl.Region); ACanvas.ClipRegion := lRegion; lControlCanvas := ACanvas; if (ACDWinControl.InvalidateCount > 0) and lDrawControl then begin ACDWinControl.UpdateImageAndCanvas(); lControlCanvas := ACDWinControl.ControlCanvas; ACDWinControl.InvalidateCount := 0; // Special drawing for some native controls if (lWinControl is TCustomPanel) or (lWinControl is TTabSheet) or (lWinControl is TCustomPage) or (lWinControl is TNotebook) then begin // Erase the background of TPanel controls, since it can draw it's own border, but fails to draw it's own background // and also erase the background for TTabSheet (children of TPageControl) and TCustomPage (children of TNotebook) lControlCanvas.SaveState; lControlCanvas.Brush.FPColor := TColorToFPColor(lWinControl.GetRGBColorResolvingParent()); lControlCanvas.Pen.FPColor := lControlCanvas.Brush.FPColor; lControlCanvas.Rectangle(Bounds(0, 0, lWinControl.Width, lWinControl.Height)); lControlCanvas.RestoreState(-1); end else if lWinControl is TCustomGroupBox then begin lControlCanvas.SaveState; lControlStateEx := TCDControlStateEx.Create; try lControlStateEx.Font := lWinControl.Font; lControlStateEx.Caption := lWinControl.Caption; lControlStateEx.ParentRGBColor := lWinControl.GetRGBColorResolvingParent(); GetDefaultDrawer().DrawGroupBox(lControlCanvas, Point(0,0), Size(lWinControl.Width, lWinControl.Height), [], lControlStateEx); finally lControlStateEx.Free; lControlCanvas.RestoreState(-1); end; end; // Send the drawing message {$ifdef VerboseCDWinControl} DebugLn('[RenderWinControl] before LCLSendPaintMsg'); {$endif} FillChar(struct, SizeOf(TPaintStruct), 0); struct.hdc := HDC(lControlCanvas); LCLSendEraseBackgroundMsg(lWinControl, struct.hdc); LCLSendPaintMsg(lWinControl, struct.hdc, @struct); {$ifdef VerboseCDWinControl} DebugLn('[RenderWinControl] after LCLSendPaintMsg'); {$endif} end; // Here we actually blit the control to the form canvas if lDrawControl then ACanvas.CanvasCopyRect(ACDWinControl.ControlCanvas, 0, 0, 0, 0, lWinControl.Width, lWinControl.Height); // Now restore it ACanvas.RestoreState(-1); Result := True;end;

The patch adds "lRegion.Free;" before the last "ACanvas.RestoreState(-1);"

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---diff --git a/lcl/interfaces/customdrawn/customdrawnproc.pas b/lcl/interfaces/customdrawn/customdrawnproc.pasindex 5170ddc72b..aeb36771b2 100644--- a/lcl/interfaces/customdrawn/customdrawnproc.pas+++ b/lcl/interfaces/customdrawn/customdrawnproc.pas@@ -563,6 +563,8 @@ begin ACanvas.CanvasCopyRect(ACDWinControl.ControlCanvas, 0, 0, 0, 0, lWinControl.Width, lWinControl.Height); + lRegion.Free;+ // Now restore it ACanvas.RestoreState(-1);

wp:

--- Quote from: lagprogramming on April 06, 2023, 02:05:10 pm ---The memory allocated for lRegion is never freed.

--- End quote ---
Are you sure? The newly created region is assigned to the canvas' ClipRegion. Maybe the canvas takes care of it? In TFPCustomCanvas.Destroy, at least, there is a "FreeAndNil(FClipRegion)". Maybe there should be a setter for TFPCustomCanvas.SetClipRegion to destroy the previous clip region before assigning the new one, e.g. something like this:

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TFPCustomCanvas.SetClipRegion(AValue: TFPCustomRegion);begin if AValue = FClipRegion then exit; FClipRegion.Free; FClipRegion := AValue;end;
[EDIT]
I was able to verify this kind of memory leak by means of a simple TFPMemoryImage and TFPImageCanvas, and reported a bug in the FPC bug tracker (https://gitlab.com/freepascal.org/fpc/source/-/issues/40232). Hopefully somebody takes care of it...

AlexTP:
Posted to bugtracker:
https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/40203

wp:
My patch for issue #40203 has been applied now.

Navigation

[0] Message Index