* * *

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

josh

  • Sr. Member
  • ****
  • Posts: 437
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 »
Development Installation Lazarus 1.3, FPC 2.7.1,Windows 7/8 32/64, OSX, *nix

Test Environment Lazarus & FPC Trunk on Windows and OSX (Cocoa Mainly on OSX). Testing also Crosscompile windows to OSX.. 
Any posts made from 2015 will be based on Lazarus Trunk.

marcov

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 5875
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: 2082
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: 437
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 »
Development Installation Lazarus 1.3, FPC 2.7.1,Windows 7/8 32/64, OSX, *nix

Test Environment Lazarus & FPC Trunk on Windows and OSX (Cocoa Mainly on OSX). Testing also Crosscompile windows to OSX.. 
Any posts made from 2015 will be based on Lazarus Trunk.

 

Recent

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