Procedure CaptureScreen AFileName: (string);
Const
CAPTUREBLT=$40000000;
Var
HdcScreen: HDC;
HdcCompatible: HDC;
BMP, bmp1: TBitmap;
PNG: TPNGObject;
HbmScreen: HBITMAP;
The begin
HdcScreen:=CreateDC (' DISPLAY 'nil nil, nil);
HdcCompatible:=CreateCompatibleDC (hdcScreen);
HbmScreen:=CreateCompatibleBitmap (hdcScreen, GetDeviceCaps (hdcScreen, HORZRES), GetDeviceCaps (hdcScreen, VERTRES));
SelectObject (hdcCompatible hbmScreen);
BMP:=TBitmap. Create;
Bmp1:=TBitmap. Create;
PNG:=TPNGObject. Create;
BMP. Handle:=hbmScreen;
BitBlt (hdcCompatible, 0, 0, BMP. Width, BMP, Height, hdcScreen, 0, 0, SRCCOPY or CAPTUREBLT);
Bmp1. Assign (BMP);
//BMP. SaveToFile (' 1 ');
Bmp1. PixelFormat:=pf8bit;
PNG. Assign (bmp1);
PNG. SaveToFile (AFileName);
Bmp1. Free;
BMP. Free;
PNG. Free;
DeleteDC (hdcScreen);
DeleteDC (hdcCompatible);
end;

CodePudding user response:

Don't comment out//BMP SaveToFile (' 1 '); Will jump Out of the "Out of system resources" strives for the great god

CodePudding user response:

This code...

 
Procedure CaptureScreen (const AFileName: string); 
Var 
H: THandle; 
P: TPNGImage; 
The begin 
H:=GetDC (0); 
P:=TPNGImage CreateBlank (COLOR_RGB, 8, Screen. The Width, the Screen. The Height); 
BitBlt (P.C anvas. Handle, 0, 0, P.W idth and P.H eight, H, 0, 0, SRCCOPY); 
ReleaseDC (0 H); 
P. aveToFile (AFileName); 
P.F ree; 
end; 

CodePudding user response:

You this is "spillover" system resources!