Recent

Author Topic: [SOLVED] Freeing at destructor TLazCanvasState.Destroy;  (Read 796 times)

lagprogramming

  • Sr. Member
  • ****
  • Posts: 296
[SOLVED] Freeing at destructor TLazCanvasState.Destroy;
« on: March 28, 2023, 08:19:39 pm »
lcl/lazcanvas.pas contains destructor TLazCanvasState.Destroy;
Shouldn't Font also be freed there!?
Code: Pascal  [Select][+][-]
  1. if Font <> nil then Font.Free;

Here is existing code:
Code: Pascal  [Select][+][-]
  1. TLazCanvasState = class
  2.   public
  3.     Brush: TFPCustomBrush;
  4.     Pen: TFPCustomPen;
  5.     Font: TFPCustomFont;
  6.     BaseWindowOrg: TPoint;
  7.     WindowOrg: TPoint;
  8.     Clipping: Boolean;
  9.     ClipRegion: TFPCustomRegion;
  10.     destructor Destroy; override;
  11.   end;
  12.  
  13. destructor TLazCanvasState.Destroy;
  14. begin
  15.   if Brush <> nil then Brush.Free;
  16.   if Pen <> nil then Pen.Free;
  17.   inherited Destroy;
  18. end;
« Last Edit: April 01, 2023, 01:38:23 pm by lagprogramming »

Blaazen

  • Hero Member
  • *****
  • Posts: 3234
  • POKE 54296,15
    • Eye-Candy Controls
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #1 on: March 28, 2023, 11:34:05 pm »
Probably should. A basic test gives memory leak.
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2. {$mode objfpc}{$H+}
  3.  
  4. interface
  5.  
  6. uses
  7.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, LazCanvas, FPImage;
  8.  
  9. type
  10.   { TForm1 }
  11.   TForm1 = class(TForm)
  12.     procedure FormCreate(Sender: TObject);
  13.   private
  14.  
  15.   public
  16.  
  17.   end;
  18.  
  19. var
  20.   Form1: TForm1;
  21.  
  22. implementation
  23.  
  24. {$R *.lfm}
  25.  
  26. { TForm1 }
  27.  
  28. procedure TForm1.FormCreate(Sender: TObject);
  29. var lc: TLazCanvas;
  30.     fpi: TFPCustomImage;
  31. begin
  32.   fpi:=TFPCustomImage.Create(100, 100);
  33.   lc:=TLazCanvas.create(fpi);
  34.   lc.SaveState;
  35.   lc.RestoreState(0);
  36.   lc.Free;
  37.   fpi.Free;
  38. end;
  39.  
  40. end.
I don't know what is the purpose of LazCanvas, I never used it.
Lazarus 2.3.0 (rev main-2_3-2863...) FPC 3.3.1 x86_64-linux-qt Chakra, Qt 4.8.7/5.13.2, Plasma 5.17.3
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

dsiders

  • Hero Member
  • *****
  • Posts: 875
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #2 on: March 28, 2023, 11:45:31 pm »
Probably should. A basic test gives memory leak.
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2. {$mode objfpc}{$H+}
  3.  
  4. interface
  5.  
  6. uses
  7.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, LazCanvas, FPImage;
  8.  
  9. type
  10.   { TForm1 }
  11.   TForm1 = class(TForm)
  12.     procedure FormCreate(Sender: TObject);
  13.   private
  14.  
  15.   public
  16.  
  17.   end;
  18.  
  19. var
  20.   Form1: TForm1;
  21.  
  22. implementation
  23.  
  24. {$R *.lfm}
  25.  
  26. { TForm1 }
  27.  
  28. procedure TForm1.FormCreate(Sender: TObject);
  29. var lc: TLazCanvas;
  30.     fpi: TFPCustomImage;
  31. begin
  32.   fpi:=TFPCustomImage.Create(100, 100);
  33.   lc:=TLazCanvas.create(fpi);
  34.   lc.SaveState;
  35.   lc.RestoreState(0);
  36.   lc.Free;
  37.   fpi.Free;
  38. end;
  39.  
  40. end.
I don't know what is the purpose of LazCanvas, I never used it.

It is used as the DC in custom drawn widgetsets.
Preview Lazarus 2.3.0 documentation at: https://dsiders.gitlab.io/lazdocsnext

jamie

  • Hero Member
  • *****
  • Posts: 5362
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #3 on: March 28, 2023, 11:48:16 pm »
Rather badly written.

You don't need to test for Nil if you are going to use Free because Free does that already.

also, its possible maybe a shared font is being used so it could be a bad idea to free it there.
The only true wisdom is knowing you know nothing

Blaazen

  • Hero Member
  • *****
  • Posts: 3234
  • POKE 54296,15
    • Eye-Candy Controls
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #4 on: March 29, 2023, 12:01:49 am »
Quote
also, its possible maybe a shared font is being used so it could be a bad idea to free it there.

No. It creates a new instance of Font and copies all parameters:
Code: Pascal  [Select][+][-]
  1. function TLazCanvas.SaveState: Integer;
  2. var
  3.   lState: TLazCanvasState;
  4. begin
  5.   lState := TLazCanvasState.Create;
  6.  
  7.   lState.Brush := Brush.CopyBrush;
  8.   lState.Pen := Pen.CopyPen;
  9.   lState.Font := Font.CopyFont;
  10.   lState.BaseWindowOrg := BaseWindowOrg;
  11.   lState.WindowOrg := WindowOrg;
  12.   lState.Clipping := Clipping;
  13.  
  14.   Result := GraphicStateList.Add(lState);
  15. end;
  16.  
  17. function TFPCustomFont.CopyFont : TFPCustomFont;
  18. begin
  19.   result := TFPCustomFont(self.ClassType.Create);
  20.   result.DoCopyProps (self);
  21. end;

CustomDrawn are simply *alpha*.
Lazarus 2.3.0 (rev main-2_3-2863...) FPC 3.3.1 x86_64-linux-qt Chakra, Qt 4.8.7/5.13.2, Plasma 5.17.3
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

jamie

  • Hero Member
  • *****
  • Posts: 5362
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #5 on: March 29, 2023, 12:59:06 am »
Does it leak ?
The only true wisdom is knowing you know nothing

wp

  • Hero Member
  • *****
  • Posts: 10870
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #6 on: March 29, 2023, 01:28:43 am »
Yes. And there is another related leak because the GraphicStateList, a TFPList, does not free its elements. Committed a fix to Laz/main.

A further leak probably is due to FAssignedFont which is auto-created at first access (GetAssignedFont), but never destroyed. However, I did not touch it ATM because I am not 100% sure about font handling in TLazCanvas which probably should get the fonts via FreeType.
« Last Edit: March 29, 2023, 10:26:02 am by wp »

lagprogramming

  • Sr. Member
  • ****
  • Posts: 296
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #7 on: March 29, 2023, 02:01:54 pm »
Yes. And there is another related leak because the GraphicStateList, a TFPList, does not free its elements. Committed a fix to Laz/main.

A further leak probably is due to FAssignedFont which is auto-created at first access (GetAssignedFont), but never destroyed. However, I did not touch it ATM because I am not 100% sure about font handling in TLazCanvas which probably should get the fonts via FreeType.

Indeed, destructor TLazCanvas.destroy; also needs an FAssignedFont.Free; line.
This is the patch. Even if the change is minor, it helps clarify what's the deal with having these FAssigned* variables. Maybe they can be completely replaced with parent Font, Brush and Pen. Looking at both lazcanvas.pas and customdrawn code it's hard to believe they are used properly.

Code: Pascal  [Select][+][-]
  1. diff --git a/lcl/lazcanvas.pas b/lcl/lazcanvas.pas
  2. index bcc4d0cc17..8cbbea89cf 100644
  3. --- a/lcl/lazcanvas.pas
  4. +++ b/lcl/lazcanvas.pas
  5. @@ -549,6 +549,7 @@ begin
  6.    GraphicStateList.Free;
  7.    FAssignedBrush.Free;
  8.    FAssignedPen.Free;
  9. +  FAssignedFont.Free;
  10.    inherited destroy;
  11.  end;

wp

  • Hero Member
  • *****
  • Posts: 10870
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #8 on: March 29, 2023, 05:54:08 pm »
Do you have a working example in which TLazCanvas is used to draw text? All I know is code in which FreeType is employed, and this does not even need a canvas.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, ExtCtrls, EasyLazFreeType;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Image1: TImage;
  16.     procedure FormCreate(Sender: TObject);
  17.     procedure FormDestroy(Sender: TObject);
  18.   private
  19.     FFont: TFreeTypeFont;
  20.     procedure DrawOnIntfImage;
  21.  
  22.   public
  23.  
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29. implementation
  30.  
  31. {$R *.lfm}
  32.  
  33. uses
  34.   fpImage, fpCanvas,
  35.   IntfGraphics, LazFreeTypeIntfDrawer, LazFreeTypeFontCollection;
  36.  
  37. procedure TForm1.DrawOnIntfImage;
  38. const
  39.   FontFile = 'arial.ttf';
  40. var
  41.   bmp: TBitmap;
  42.   img: TLazIntfImage;
  43.   drawer: TIntfFreeTypeDrawer;
  44. begin
  45.   bmp := TBitmap.Create;
  46.   try
  47.     bmp.PixelFormat := pf32Bit;
  48.     bmp.SetSize(Image1.Width, Image1.Height);
  49.  
  50.     img := bmp.CreateIntfImage;
  51.     try
  52.       drawer := TIntfFreeTypeDrawer.Create(img);
  53.       try
  54.         if FFont = nil then
  55.         begin
  56.           FFont := TFreeTypeFont.Create;
  57.           FFont.Name := FontCollection.AddFile('c:\windows\fonts\' + FontFile).Family.FamilyName;
  58.         end;
  59.         FFont.SizeInPoints := 24;
  60.         drawer.DrawTextRect('This is a test', FFont, 0,0, img.Width, img.Height, colRed, [ftaCenter, ftaVerticalCenter]);
  61.       finally
  62.         drawer.Free;
  63.       end;
  64.       bmp.LoadFromIntfImage(img);
  65.       Image1.Picture.Assign(bmp);
  66.     finally
  67.       img.Free;
  68.     end;
  69.   finally
  70.     bmp.Free;
  71.   end;
  72. end;
  73.  
  74. procedure TForm1.FormCreate(Sender: TObject);
  75. begin
  76.   DrawOnIntfImage;
  77. end;
  78.  
  79. procedure TForm1.FormDestroy(Sender: TObject);
  80. begin
  81.   FreeAndNil(FFont);
  82. end;

lagprogramming

  • Sr. Member
  • ****
  • Posts: 296
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #9 on: March 29, 2023, 07:26:58 pm »
Maybe this is helpful.
Add a break-point at function TCDWidgetSet.ExtTextOut. It contains lDestCanvas: TLazCanvas absolute DC;
This bug can be noticed in Linux-CustomDrawn. Probably Windows too.
The first saved bitmap is not good, the second one looks OK.

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. {BUG!
  3. Press the button once and notice that h1<>h2. h1 should equal h2!
  4. Press the button twice and notice that h1=h2.
  5. Look at the saved bitmap files.
  6. In linux-customdrawn the first returned TextHeight value is different than the following TextHeight values that appear when you press the button.}
  7. var
  8.   h1,h2: integer;
  9.   b: tbitmap;
  10. begin
  11.   b:=tbitmap.Create;
  12.   b.Canvas.Font.Name := 'Arial';
  13.   b.Canvas.Font.Height := 19; //Changing this value will not change the first computed value of h1!!!!!
  14.   b.Canvas.Font.Color:=clred;
  15.   b.SetSize(b.Canvas.TextWidth('Test'),b.Canvas.TextHeight('Test'));
  16.   h1:=b.Canvas.TextHeight('Test');
  17.   {BUG TRIGGERED BY THE FOLLOWING CANVAS.TEXTOUT LINE! Notice that h2 becomes different than h1!
  18.   Commenting "ExtUTF8Out(FHandle, X, Y, Flags, nil, PChar(Text), Length(Text), nil);" in procedure TCanvas.TextOut(X,Y: Integer; const Text: String); leaves the value unchanged to 15!}
  19.   b.Canvas.TextOut(0, 0, 'Test');
  20.   h2:=b.Canvas.TextHeight('Test');
  21.   Form1.Caption:=Form1.Caption+' h1='+inttostr(h1)+' h2='+inttostr(h2);
  22.   {Notice that the first bitmap saved shows only a part of the "Test" text!
  23.    Pressing the button twice will make the bitmap show the entire "Test" text.}
  24.   b.SaveToFile('/tmp/bmp.bmp');
  25.   b.Free;
  26. end;

wp

  • Hero Member
  • *****
  • Posts: 10870
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #10 on: March 29, 2023, 11:33:01 pm »
Lots of strange things going on here. For example: Why is Font.PixelsPerInch = 0 on Windows?
« Last Edit: March 29, 2023, 11:37:09 pm by wp »

lagprogramming

  • Sr. Member
  • ****
  • Posts: 296
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #11 on: March 31, 2023, 07:48:03 pm »
Lots of strange things going on here. For example: Why is Font.PixelsPerInch = 0 on Windows?

In Linux applying the following patch fixes the TextHeight problem. It returns the same value, no matter how many times you press the button. I wonder if it fixes the bug in Windows, too.

Code: Pascal  [Select][+][-]
  1. diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi.inc b/lcl/interfaces/customdrawn/customdrawnwinapi.inc
  2. index 3843bd1cef..412a42a1ca 100644
  3. --- a/lcl/interfaces/customdrawn/customdrawnwinapi.inc
  4. +++ b/lcl/interfaces/customdrawn/customdrawnwinapi.inc
  5. @@ -528,7 +528,7 @@ begin
  6.    );*)
  7.  
  8.    lFont.Size := Abs(LogFont.lfHeight);
  9. -
  10. +  lFont.ftFont.SizeInPoints := lFont.Size;
  11.  (*  // Some values at available on Qt documentation at a table
  12.    // Others are guesses. The best would be to test different values for those
  13.    // See: http://doc.trolltech.com/4.1/qfont.html#Weight-enum

wp

  • Hero Member
  • *****
  • Posts: 10870
Re: Freeing at destructor TLazCanvasState.Destroy;
« Reply #12 on: March 31, 2023, 08:03:12 pm »
Thanks, seems to fix the issue in Windows, too. Applied.

 

TinyPortal © 2005-2018