procedure CaptureScreen(AFileName: string);
const
  CAPTUREBLT = $40000000;
var
  hdcScreen: HDC;
  hdcCompatible: HDC;
  bmp, bmp1: TBitmap;
  png: TPNGObject;
  hbmScreen: HBITMAP;
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;

解决方案 »

  1.   

     不注释掉// bmp.SaveToFile('1');  就会跳出“Out of system resources ”  求大神指点
      

  2.   

    这代码写的...
    procedure CaptureScreen(const AFileName: string);
    var
      H: THandle;
      P: TPNGImage;
    begin
      H := GetDC(0);
      P := TPNGImage.CreateBlank(COLOR_RGB, 8, Screen.Width, Screen.Height);
      BitBlt(P.Canvas.Handle, 0, 0, P.Width, P.Height, H, 0, 0, SRCCOPY);
      ReleaseDC(0, H);
      P.SaveToFile(AFileName);
      P.Free;
    end;