* * *

Author Topic: [SOLVED] My Routine to scale image has a Memory Leak, and I cant see where  (Read 506 times)

josh

  • Sr. Member
  • ****
  • Posts: 338
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.

« Last Edit: May 02, 2017, 11:27:26 pm by josh »
Lazarus 1.3
FPC 2.7.1
Windows 7/8 32/64, OSX, *nix

marcov

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 5429
Re: My Routine to scale image has a Memory Leak, and I cant see where
« Reply #1 on: May 02, 2017, 11:43:49 am »
when monitored with Task Manager It keeps in creasing in size.

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

lainz

  • Hero Member
  • *****
  • Posts: 1861
  • Nace una flor, todos los días sale el sol...
    • BGRABitmap
Re: My Routine to scale image has a Memory Leak, and I cant see where
« Reply #2 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.

josh

  • Sr. Member
  • ****
  • Posts: 338
Re: My Routine to scale image has a Memory Leak, and I cant see where
« Reply #3 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.

« Last Edit: May 02, 2017, 05:56:36 pm by josh »
Lazarus 1.3
FPC 2.7.1
Windows 7/8 32/64, OSX, *nix

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus