Screenshot Delphi

У новичков часто возникает вопрос "Как сделать screenshot рабочего стола Windows?". Вот небольшой класс, который демонстрирует как это делается.
Данный класс использует VCL, однако нет противопоказаний что бы использовать его в программах FMX. Для этих целей используйте методы Get*Stream. Код написан на Delphi 10.2 Tokyo, однако должен работать и на более ранних версиях.
unit Tool.Capture;
interface
uses
System.SysUtils, System.Classes,
Winapi.Windows, Vcl.Imaging.pngimage, Vcl.Imaging.jpeg, VCL.Graphics;
type
TToolCapture = class
private
DesktopHDC: HDC;
DesktopBMP: TBitmap;
DesktopW: integer;
DesktopH: integer;
procedure RefreshBitmap;
public
constructor Create();
destructor Destroy; override;
function GetPng: TPngImage;
function GetJpg: TJpegImage;
function GetPngStream: TMemoryStream;
function GetJpgStream: TMemoryStream;
end;
implementation
{ TToolCapture }
constructor TToolCapture.Create;
begin
DesktopHDC := GetDC(GetDesktopWindow);
DesktopW := GetDeviceCaps(DesktopHDC, HORZRES);
DesktopH := GetDeviceCaps(DesktopHDC, VERTRES);
DesktopBMP := TBitmap.Create;
DesktopBMP.SetSize(DesktopW, DesktopH);
end;
destructor TToolCapture.Destroy;
begin
FreeAndNil(DesktopBMP);
DeleteDC(DesktopHDC);
inherited;
end;
procedure TToolCapture.RefreshBitmap;
begin
DesktopBMP.Canvas.Lock;
try
BitBlt(DesktopBMP.Canvas.Handle, 0, 0, DesktopW, DesktopH, DesktopHDC, 0, 0, SRCCOPY);
finally
DesktopBMP.Canvas.Unlock;
end;
end;
function TToolCapture.GetJpg: TJpegImage;
begin
RefreshBitmap;
Result := TJPEGImage.Create;
Result.CompressionQuality := 75;
Result.Performance := jpBestQuality;
Result.Assign(DesktopBMP);
end;
function TToolCapture.GetJpgStream: TMemoryStream;
var
Img: TJPEGImage;
begin
Img := GetJpg;
try
Result := TMemoryStream.Create;
Img.SaveToStream(Result);
finally
FreeAndNil(Img);
end;
end;
function TToolCapture.GetPng: TPngImage;
begin
RefreshBitmap;
Result := TPngImage.Create;
Result.Transparent := False;
Result.CompressionLevel := 5;
Result.AssignHandle(DesktopBMP.Handle, False, 0);
end;
function TToolCapture.GetPngStream: TMemoryStream;
var
Img: TPngImage;
begin
Img := GetPng;
try
Result := TMemoryStream.Create;
Img.SaveToStream(Result);
finally
FreeAndNil(Img);
end;
end;
end.
Вот так его можно использовать в программах FMX (Image - TImage):
var
Stream: TMemoryStream;
begin
Stream := FCapture.GetJpgStream;
try
Image.Bitmap.LoadFromStream(Stream);
finally
FreeAndNil(Stream);
end;