Lazarus

Programming => Graphics => Graphics and Multimedia => BGRABitmap and LazPaint => Topic started by: Josh on May 01, 2017, 11:20:22 pm

Title: [SOLVED] My Routine to scale image has a Memory Leak, and I cant see where
Post by: Josh on May 01, 2017, 11:20:22 pm

Hi

I have been playing with BGRABITMAP to create a smooth scaling for images and UI, unfortunately my routine has a memory leak, when monitored with Task Manager It keeps in creasing in size.

I suspect it's my routine but I cant find it, I have created a cut down version which has the basics of the routine.

ANy ideas, pointers.

Attached is a zip of the project.

Code: [Select]

unit scale_image_unit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  ComCtrls,BGRABitmap,BGRABitmapTypes,LCLINTF, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Label1: TLabel;
    original_image: TImage;
    scaled_image: TImage;
    TrackBar1: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.TrackBar1Change(Sender: TObject);
var sz:longint;

procedure DrawBitmap;
var
  DestinationRect: TRect;
  bmpBGRA: TBGRACustomBitmap;
begin
  DestinationRect     := Rect(0,0, scaled_image.width, scaled_image.Height);
  canvas.CopyMode    := cmSrcCopy;
  bmpBGRA:=TBGRABitmap.create(Original_Image.Picture.bitmap); // original image
  bmpBGRA.ResampleFilter:=rfBestQuality;
  bmpBGRA := bmpBGRA.Resample(scaled_image.Width, scaled_image.Height, rmFineResample) as TBGRABitmap;  // resample to width and height of scaled_image
  bmpBGRA.Draw(Canvas,0,0,false);  // Use false for transparency
  with scaled_image do
  begin
//    picture.Clear; //do this to avoid Bitmap going strange on resize, possible bug!!
    picture.Bitmap.SetSize(scaled_image.Width,scaled_image.Height);
    Canvas.Draw(0,0,bmpBGRA.Bitmap);
  end;
  canvas.CopyRect(DestinationRect, scaled_image.Canvas, DestinationRect);
  bmpBgra.Free;
  bmpBGRA:=nil;
  //FreeAndNil(bmpBGRA);
  scaled_image.Invalidate;  // Invalidate;
end;


begin
  sz:=128+round(256*(TrackBar1.position/100));
  scaled_image.Width:=sz;
  scaled_image.Height:=sz;
  drawbitmap;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  form1.DoubleBuffered:=true;
end;

end.



Title: Re: My Routine to scale image has a Memory Leak, and I cant see where
Post by: marcov on May 02, 2017, 11:43:49 am

Quote from: josh on May 01, 2017, 11:20:22 pm

when monitored with Task Manager It keeps in creasing in size.

Task manager is not a good way to monitor memory leaks, use -gh

Title: Re: My Routine to scale image has a Memory Leak, and I cant see where
Post by: lainz on May 02, 2017, 03:30:17 pm

Code: Pascal  [Select][+][-]

1. bmpBGRA := bmpBGRA.Resample(scaled_image.Width, scaled_image.Height, rmFineResample) as TBGRABitmap;

That's the line with the leak. You're creating a new object with .Resample, and then assigning to the same variable bmpBGRA without freeing the old bmpBGRA.

You must use:

Code: Pascal  [Select][+][-]

1. BGRAReplace(bmpBGRA, bmpBGRA.Resample(scaled_image.Width, scaled_image.Height, rmFineResample) as TBGRABitmap);

That method assigns to bmpBGRA but previously frees the original bmpBGRA.

Title: Re: My Routine to scale image has a Memory Leak, and I cant see where
Post by: Josh on May 02, 2017, 05:49:29 pm

Hi Lainz,

Brilliant, that solved my memory leak..  :)

Josh

Code: [Select]

unit scale_image_unit;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  ComCtrls,BGRABitmap,BGRABitmapTypes,LCLINTF, StdCtrls;
type
  { TForm1 }
  TForm1 = class(TForm)
    Label1: TLabel;
    original_image: TImage;
    scaled_image: TImage;
    TrackBar1: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private
  public
  end;
var
  Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.TrackBar1Change(Sender: TObject);
var sz:longint;

procedure DrawBitmap;
var
  DestinationRect: TRect;
  bmpBGRA: TBGRABitmap;//TBGRACustomBitmap <---- Changed Type so can use BGRAReplace
begin
  DestinationRect     := Rect(0,0, scaled_image.width, scaled_image.Height);
  canvas.CopyMode    := cmSrcCopy;
  bmpBGRA:=TBGRABitmap.create(Original_Image.Picture.bitmap); // original image
  bmpBGRA.ResampleFilter:=rfBestQuality;
  // <--- Previous bmpBGRA Assignment used incorrectly causing memory leak
  BGRAReplace(bmpBGRA, bmpBGRA.Resample(scaled_image.Width, scaled_image.Height, rmFineResample) as TBGRABitmap);  // resample to width and height of scaled_imag
  // <--
  bmpBGRA.Draw(Canvas,0,0,false);  // Use false for transparency
  with scaled_image do
  begin
//    picture.Clear; //do this to avoid Bitmap going strange on resize, possible bug!!
    picture.Bitmap.SetSize(scaled_image.Width,scaled_image.Height);
    Canvas.Draw(0,0,bmpBGRA.Bitmap);
  end;
  canvas.CopyRect(DestinationRect, scaled_image.Canvas, DestinationRect);
  bmpBgra.Free;
  bmpBGRA:=nil;
  //FreeAndNil(bmpBGRA);
  scaled_image.Invalidate;  // Invalidate;
end;


begin
  sz:=128+round(256*(TrackBar1.position/100));
  scaled_image.Width:=sz;
  scaled_image.Height:=sz;
  drawbitmap;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  form1.DoubleBuffered:=true;
end;

end.