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.
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.