This is an ugly trap, just like FindInFile was: Hold the CTRL key down and click on the word "GetFormImage". This opens the unit with the sources of this method:
function TCustomForm.GetFormImage: TBitmap;
var
ARect: TRect;
begin
Result := TBitmap.Create;
try
Result.SetSize(ClientWidth, ClientHeight);
LCLIntf.GetWindowRect(Handle, ARect);
with GetClientOrigin do
PaintTo(Result.Canvas, ARect.Left - X, ARect.Top - Y);
except
Result.Free;
raise;
end;
end;
As you can see this function creates a bitmap and returns it as its result. And when you Assign this bitmap to the jpegimage, you do not copy the pointer but create a copy of the binary bitmap content. Therefore, your code does not destroy the bitmap that was created by GetFormImage.
This fixes the memory leak:
procedure TForm1.SaveBmpClick(Sender: TObject);
var
imgWindow: TJPEGImage;
bmp: TBitmap;
pngName: String;
SaveDir: String;
begin
pngName:='screenshot-'+FormatDateTime('dd-mm-yyyy hh-mm-ss',Now)+'.jpg';
SaveDir:= GetWindowsSpecialDir(CSIDL_PERSONAL);
SaveDir:= Savedir+'Screenshots\';
try
imgWindow:= TJPEGImage.Create;
bmp := GetFormImage;
imgWindow.Assign(bmp);
bmp.Free;
imgWindow.SaveToFile(SaveDir+pngName);
DispMsg('A screenshot has been saved to...'+
sLineBreak+SaveDir, 'Screenshot saved');
finally
imgWindow.Free;
end;
end;
But please test also the following code. It overloads the GetFormImage function with a procedure which gets the already existing image as an argument and thus no longer creates anything. This, in my eyes, is a clearer way of coding because the same procedure which creates the image, uses it and destroys it. Moreover, the image parameter can be declared as TCustomBitmap which is the ancestor of all the important LCL image types; therefore, you have more freedom in selecting the image type. For example, you can already pass a JpegImage to the procedure.
uses
LCLIntf;
procedure TForm1.GetFormImage(ABitmap: TCustomBitmap);
var
ARect: TRect;
begin
ABitmap.SetSize(ClientWidth, ClientHeight);
LCLIntf.GetWindowRect(Handle, ARect);
with GetClientOrigin do
PaintTo(ABitmap.Canvas, ARect.Left - X, ARect.Top - Y);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
jpg: TJpegImage;
begin
jpg := TJpegImage.Create;
try
GetFormImage(jpg);
jpg.SaveToFile('test.jpg');
finally
jpg.Free;
end;
end;
Tell me whether this modification works for you (it does for me), then I'll add it to TCustomForm.
Recent
