Recent

Author Topic: Custom Component Problems  (Read 1203 times)

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
Custom Component Problems
« on: April 18, 2021, 07:40:53 pm »
Hi, I made the SVG Image List for BGRAControls.

I save the internal Items properties in XML format. When I close any application using it, it produces a memory leak, and sometimes an access violation.

It's something on how I use the resources.

Heaptrc window shows:

Quote
PROCESSRESOURCE, line 2080 of include/customform.inc
INITCOMPONENT, line 3153 or lresources.pp
INITLAZRESOURCECOMPONENT, line 3180 or lresources.pp
INITRESOURCECOMPONENT, line 798 or lresources.pp
PROCESSRESOURCE, line 2080 of include/customform.inc

Any ideas?

Here is the full source code, or just download and install bgracontrols, drop the svg image list and ad an svg image into it.

Thanks for your help!

Code: Pascal  [Select][+][-]
  1. unit BGRASVGImageList;
  2.  
  3. {$mode delphi}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, FGL,
  9.   XMLConf, BGRABitmap, BGRABitmapTypes, BGRASVG;
  10.  
  11. type
  12.  
  13.   TListOfTStringList = TFPGObjectList<TStringList>;
  14.  
  15.   { TBGRASVGImageList }
  16.  
  17.   TBGRASVGImageList = class(TComponent)
  18.   private
  19.     FHeight: integer;
  20.     FHorizontalAlignment: TAlignment;
  21.     FItems: TListOfTStringList;
  22.     FReferenceDPI: integer;
  23.     FUseSVGAlignment: boolean;
  24.     FVerticalAlignment: TTextLayout;
  25.     FWidth: integer;
  26.     procedure ReadData(Stream: TStream);
  27.     procedure SetHeight(AValue: integer);
  28.     procedure SetWidth(AValue: integer);
  29.     procedure WriteData(Stream: TStream);
  30.   protected
  31.     procedure Load(const XMLConf: TXMLConfig);
  32.     procedure Save(const XMLConf: TXMLConfig);
  33.     procedure DefineProperties(Filer: TFiler); override;
  34.     function GetCount: integer;
  35.     // Get SVG string
  36.     function GetSVGString(AIndex: integer): string; overload;
  37.   public
  38.     constructor Create(AOwner: TComponent); override;
  39.     destructor Destroy; override;
  40.     function Add(ASVG: string): integer;
  41.     procedure Remove(AIndex: integer);
  42.     procedure Exchange(AIndex1, AIndex2: integer);
  43.     procedure Replace(AIndex: integer; ASVG: string);
  44.     function GetScaledSize(ATargetDPI: integer): TSize;
  45.     // Get TBGRABitmap with custom width and height
  46.     function GetBGRABitmap(AIndex: integer; AWidth, AHeight: integer): TBGRABitmap; overload;
  47.     function GetBGRABitmap(AIndex: integer; AWidth, AHeight: integer;
  48.       AUseSVGAlignment: boolean): TBGRABitmap; overload;
  49.     // Get TBitmap with custom width and height
  50.     function GetBitmap(AIndex: integer; AWidth, AHeight: integer): TBitmap; overload;
  51.     function GetBitmap(AIndex: integer; AWidth, AHeight: integer;
  52.       AUseSVGAlignment: boolean): TBitmap; overload;
  53.     // Draw image with custom width and height. The Width and
  54.     // Height property are in LCL coordinates.
  55.     procedure Draw(AIndex: integer; AControl: TControl; ACanvas: TCanvas;
  56.       ALeft, ATop, AWidth, AHeight: integer); overload;
  57.     procedure Draw(AIndex: integer; AControl: TControl; ACanvas: TCanvas;
  58.       ALeft, ATop, AWidth, AHeight: integer; AUseSVGAlignment: boolean;
  59.       AOpacity: byte = 255); overload;
  60.     // Draw image with custom width, height and canvas scale. The Width and
  61.     // Height property are in LCL coordinates. CanvasScale is useful on MacOS
  62.     // where LCL coordinates do not match actual pixels.
  63.     procedure Draw(AIndex: integer; ACanvasScale: single; ACanvas: TCanvas;
  64.       ALeft, ATop, AWidth, AHeight: integer); overload;
  65.     procedure Draw(AIndex: integer; ACanvasScale: single; ACanvas: TCanvas;
  66.       ALeft, ATop, AWidth, AHeight: integer; AUseSVGAlignment: boolean;
  67.       AOpacity: byte = 255); overload;
  68.     // Draw on the target BGRABitmap with specified Width and Height.
  69.     procedure Draw(AIndex: integer; ABitmap: TBGRABitmap; const ARectF: TRectF); overload;
  70.     procedure Draw(AIndex: integer; ABitmap: TBGRABitmap; const ARectF: TRectF;
  71.       AUseSVGAlignment: boolean); overload;
  72.  
  73.     // Generate bitmaps for an image list
  74.     procedure PopulateImageList(const AImageList: TImageList; AWidths: array of integer);
  75.     property SVGString[AIndex: integer]: string read GetSVGString;
  76.     property Count: integer read GetCount;
  77.   published
  78.     property Width: integer read FWidth write SetWidth;
  79.     property Height: integer read FHeight write SetHeight;
  80.     property ReferenceDPI: integer read FReferenceDPI write FReferenceDPI default 96;
  81.     property UseSVGAlignment: boolean read FUseSVGAlignment write FUseSVGAlignment default False;
  82.     property HorizontalAlignment: TAlignment read FHorizontalAlignment write FHorizontalAlignment default taCenter;
  83.     property VerticalAlignment: TTextLayout read FVerticalAlignment write FVerticalAlignment default tlCenter;
  84.   end;
  85.  
  86. procedure Register;
  87.  
  88. implementation
  89.  
  90. uses LCLType;
  91.  
  92. procedure Register;
  93. begin
  94.   RegisterComponents('BGRA Themes', [TBGRASVGImageList]);
  95. end;
  96.  
  97. { TBGRASVGImageList }
  98.  
  99. procedure TBGRASVGImageList.ReadData(Stream: TStream);
  100. var
  101.   FXMLConf: TXMLConfig;
  102. begin
  103.   FXMLConf := TXMLConfig.Create(Self);
  104.   try
  105.     Stream.Position := 0;
  106.     FXMLConf.LoadFromStream(Stream);
  107.     Load(FXMLConf);
  108.   finally
  109.     FXMLConf.Free;
  110.   end;
  111. end;
  112.  
  113. procedure TBGRASVGImageList.SetHeight(AValue: integer);
  114. begin
  115.   if FHeight = AValue then
  116.     Exit;
  117.   FHeight := AValue;
  118. end;
  119.  
  120. procedure TBGRASVGImageList.SetWidth(AValue: integer);
  121. begin
  122.   if FWidth = AValue then
  123.     Exit;
  124.   FWidth := AValue;
  125. end;
  126.  
  127. procedure TBGRASVGImageList.WriteData(Stream: TStream);
  128. var
  129.   FXMLConf: TXMLConfig;
  130. begin
  131.   FXMLConf := TXMLConfig.Create(Self);
  132.   try
  133.     Save(FXMLConf);
  134.     FXMLConf.SaveToStream(Stream);
  135.     FXMLConf.Flush;
  136.   finally
  137.     FXMLConf.Free;
  138.   end;
  139. end;
  140.  
  141. procedure TBGRASVGImageList.Load(const XMLConf: TXMLConfig);
  142. var
  143.   i, j, index: integer;
  144. begin
  145.   try
  146.     FItems.Clear;
  147.     j := XMLConf.GetValue('Count', 0);
  148.     for i := 0 to j - 1 do
  149.     begin
  150.       index := FItems.Add(TStringList.Create);
  151.       FItems[index].Text := XMLConf.GetValue('Item' + i.ToString + '/SVG', '');
  152.     end;
  153.   finally
  154.   end;
  155. end;
  156.  
  157. procedure TBGRASVGImageList.Save(const XMLConf: TXMLConfig);
  158. var
  159.   i: integer;
  160. begin
  161.   try
  162.     XMLConf.SetValue('Count', FItems.Count);
  163.     for i := 0 to FItems.Count - 1 do
  164.       XMLConf.SetValue('Item' + i.ToString + '/SVG', FItems[i].Text);
  165.   finally
  166.   end;
  167. end;
  168.  
  169. procedure TBGRASVGImageList.DefineProperties(Filer: TFiler);
  170. begin
  171.   inherited DefineProperties(Filer);
  172.   Filer.DefineBinaryProperty('Items', ReadData, WriteData, True);
  173. end;
  174.  
  175. constructor TBGRASVGImageList.Create(AOwner: TComponent);
  176. begin
  177.   inherited Create(AOwner);
  178.   FItems := TListOfTStringList.Create(True);
  179.   FWidth := 16;
  180.   FHeight := 16;
  181.   FReferenceDPI := 96;
  182.   FUseSVGAlignment:= false;
  183.   FHorizontalAlignment := taCenter;
  184.   FVerticalAlignment := tlCenter;
  185. end;
  186.  
  187. destructor TBGRASVGImageList.Destroy;
  188. begin
  189.   FreeAndNil(FItems);//.Free;
  190.   inherited Destroy;
  191. end;
  192.  
  193. function TBGRASVGImageList.Add(ASVG: string): integer;
  194. var
  195.   list: TStringList;
  196. begin
  197.   list := TStringList.Create;
  198.   list.Text := ASVG;
  199.   Result := FItems.Add(list);
  200. end;
  201.  
  202. procedure TBGRASVGImageList.Remove(AIndex: integer);
  203. begin
  204.   FItems.Remove(FItems[AIndex]);
  205. end;
  206.  
  207. procedure TBGRASVGImageList.Exchange(AIndex1, AIndex2: integer);
  208. begin
  209.   FItems.Exchange(AIndex1, AIndex2);
  210. end;
  211.  
  212. function TBGRASVGImageList.GetSVGString(AIndex: integer): string;
  213. begin
  214.   Result := FItems[AIndex].Text;
  215. end;
  216.  
  217. procedure TBGRASVGImageList.Replace(AIndex: integer; ASVG: string);
  218. begin
  219.   FItems[AIndex].Text := ASVG;
  220. end;
  221.  
  222. function TBGRASVGImageList.GetCount: integer;
  223. begin
  224.   Result := FItems.Count;
  225. end;
  226.  
  227. function TBGRASVGImageList.GetScaledSize(ATargetDPI: integer): TSize;
  228. begin
  229.   result.cx := MulDiv(Width, ATargetDPI, ReferenceDPI);
  230.   result.cy := MulDiv(Height, ATargetDPI, ReferenceDPI);
  231. end;
  232.  
  233. function TBGRASVGImageList.GetBGRABitmap(AIndex: integer; AWidth,
  234.   AHeight: integer): TBGRABitmap;
  235. begin
  236.   result := GetBGRABitmap(AIndex, AWidth, AHeight, UseSVGAlignment);
  237. end;
  238.  
  239. function TBGRASVGImageList.GetBGRABitmap(AIndex: integer; AWidth, AHeight: integer;
  240.   AUseSVGAlignment: boolean): TBGRABitmap;
  241. var
  242.   bmp: TBGRABitmap;
  243.   svg: TBGRASVG;
  244. begin
  245.   bmp := TBGRABitmap.Create(AWidth, AHeight);
  246.   svg := TBGRASVG.CreateFromString(FItems[AIndex].Text);
  247.   try
  248.     svg.StretchDraw(bmp.Canvas2D, 0, 0, AWidth, AHeight, AUseSVGAlignment);
  249.   finally
  250.     svg.Free;
  251.   end;
  252.   Result := bmp;
  253. end;
  254.  
  255. function TBGRASVGImageList.GetBitmap(AIndex: integer; AWidth, AHeight: integer): TBitmap;
  256. begin
  257.   result := GetBitmap(AIndex, AWidth, AHeight, UseSVGAlignment);
  258. end;
  259.  
  260. function TBGRASVGImageList.GetBitmap(AIndex: integer; AWidth, AHeight: integer;
  261.   AUseSVGAlignment: boolean): TBitmap;
  262. var
  263.   bmp: TBGRABitmap;
  264.   ms: TMemoryStream;
  265. begin
  266.   bmp := GetBGRABitmap(AIndex, AWidth, AHeight, AUseSVGAlignment);
  267.   ms := TMemoryStream.Create;
  268.   bmp.Bitmap.SaveToStream(ms);
  269.   bmp.Free;
  270.   Result := TBitmap.Create;
  271.   ms.Position := 0;
  272.   Result.LoadFromStream(ms);
  273.   ms.Free;
  274. end;
  275.  
  276. procedure TBGRASVGImageList.Draw(AIndex: integer; AControl: TControl;
  277.   ACanvas: TCanvas; ALeft, ATop, AWidth, AHeight: integer);
  278. begin
  279.   Draw(AIndex, AControl, ACanvas, ALeft, ATop, AWidth, AHeight, UseSVGAlignment);
  280. end;
  281.  
  282. procedure TBGRASVGImageList.Draw(AIndex: integer; AControl: TControl; ACanvas: TCanvas;
  283.   ALeft, ATop, AWidth, AHeight: integer; AUseSVGAlignment: boolean; AOpacity: byte);
  284. begin
  285.   Draw(AIndex, AControl.GetCanvasScaleFactor, ACanvas, ALeft, ATop, AWidth, AHeight,
  286.        AUseSVGAlignment, AOpacity);
  287. end;
  288.  
  289. procedure TBGRASVGImageList.Draw(AIndex: integer; ACanvasScale: single;
  290.   ACanvas: TCanvas; ALeft, ATop, AWidth, AHeight: integer);
  291. begin
  292.   Draw(AIndex, ACanvasScale, ACanvas, ALeft, ATop, AWidth, AHeight, UseSVGAlignment);
  293. end;
  294.  
  295. procedure TBGRASVGImageList.Draw(AIndex: integer; ACanvasScale: single; ACanvas: TCanvas;
  296.   ALeft, ATop, AWidth, AHeight: integer; AUseSVGAlignment: boolean; AOpacity: byte);
  297. var
  298.   bmp: TBGRABitmap;
  299. begin
  300.   if (AWidth = 0) or (AHeight = 0) or (ACanvasScale = 0) then
  301.     Exit;
  302.   bmp := TBGRABitmap.Create(round(AWidth * ACanvasScale), round(AHeight * ACanvasScale));
  303.   try
  304.     Draw(AIndex, bmp, rectF(0, 0, bmp.Width, bmp.Height), AUseSVGAlignment);
  305.     bmp.ApplyGlobalOpacity(AOpacity);
  306.     bmp.Draw(ACanvas, RectWithSize(ALeft, ATop, AWidth, AHeight), False);
  307.   finally
  308.     bmp.Free;
  309.   end;
  310. end;
  311.  
  312. procedure TBGRASVGImageList.Draw(AIndex: integer; ABitmap: TBGRABitmap; const ARectF: TRectF);
  313. begin
  314.   Draw(AIndex, ABitmap, ARectF, UseSVGAlignment);
  315. end;
  316.  
  317. procedure TBGRASVGImageList.Draw(AIndex: integer; ABitmap: TBGRABitmap; const ARectF: TRectF;
  318.   AUseSVGAlignment: boolean);
  319. var
  320.   svg: TBGRASVG;
  321. begin
  322.   svg := TBGRASVG.CreateFromString(FItems[AIndex].Text);
  323.   try
  324.     if AUseSVGAlignment then
  325.       svg.StretchDraw(ABitmap.Canvas2D, ARectF, true)
  326.       else svg.StretchDraw(ABitmap.Canvas2D, HorizontalAlignment, VerticalAlignment, ARectF.Left, ARectF.Top, ARectF.Width, ARectF.Height);
  327.   finally
  328.     svg.Free;
  329.   end;
  330. end;
  331.  
  332. procedure TBGRASVGImageList.PopulateImageList(const AImageList: TImageList;
  333.   AWidths: array of integer);
  334. var
  335.   i, j: integer;
  336.   arr: array of TCustomBitmap;
  337. begin
  338.   AImageList.Width := AWidths[0];
  339.   AImageList.Height := MulDiv(AWidths[0], Height, Width);
  340.   AImageList.Scaled := True;
  341.   AImageList.RegisterResolutions(AWidths);
  342.   SetLength({%H-}arr, Length(AWidths));
  343.   for j := 0 to Count - 1 do
  344.   begin
  345.     for i := 0 to Length(arr) - 1 do
  346.       arr[i] := GetBitmap(j, AWidths[i], MulDiv(AWidths[i], Height, Width), True);
  347.     AImageList.AddMultipleResolutions(arr);
  348.     for i := 0 to Length(arr) - 1 do
  349.       TBitmap(Arr[i]).Free;
  350.   end;
  351. end;
  352.  
  353. end.

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
Re: Custom Component Problems
« Reply #1 on: April 18, 2021, 07:53:57 pm »
Ok, I'm closer, the bug is in the ReadData method

Edit: This is the faulty line FXMLConf.LoadFromStream(Stream);

How I can fix?...
« Last Edit: April 18, 2021, 07:57:37 pm by lainz »

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
Re: Custom Component Problems
« Reply #2 on: April 18, 2021, 08:35:09 pm »

jamie

  • Hero Member
  • *****
  • Posts: 6090
Re: Custom Component Problems
« Reply #3 on: April 18, 2021, 08:42:28 pm »
you are creating Stringlists that you don't free ?

I doubt very much that control actually takes ownership of the list, it just wants to see one to reference from.

I believe for that generic there is a flag in there to set..
I don't know if you did or not...

But personally that isn't the way I would of done it.

« Last Edit: April 18, 2021, 08:47:02 pm by jamie »
The only true wisdom is knowing you know nothing

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
Re: Custom Component Problems
« Reply #4 on: April 18, 2021, 09:13:27 pm »
Hi jamie, no is not the strings part, if I comment the next line where I use the XMLConfig, it fails the same, so the error is in the LCL combination of XMLConf and this properties.
« Last Edit: April 18, 2021, 09:46:09 pm by lainz »

 

TinyPortal © 2005-2018