Сохранение изображения экрана в файле

Code:

program ScrShop;

uses

Windows;

procedure ApiScrCapture(FileName: String);

type

  TScr = array [0..1] of Byte;

  PScr = ^TScr;

var

  hBmp       : hBitmap;

  DeskDC     : hDC;

  DC         : hDC;

  BFH        : BITMAPFILEHEADER;

  BIH        : tagBITMAPINFO;

  ScrX, ScrY : Integer;

  F          : File;

  ScrSize    : Cardinal;

  Bits       : PScr;

begin

  SCRX     := GetSystemMetrics(SM_CXSCREEN);

  SCRY     := GetSystemMetrics(SM_CYSCREEN);

  ScrSize  := ScrX * ScrY * 3;

  GetMem(Bits, ScrSize);

  DeskDC   := GetDC(0);

  hBmp     := CreateCompatibleBitmap(DeskDC, ScrX, ScrY);

  DC       := CreateCompatibleDC(DeskDC);

  SelectObject(DC, hbmp);

  BitBlt(DC, 0, 0, SCRX, SCRY, DeskDC, 0, 0, SrcCopy);

  with BFH do

  begin

    bfType      := $4D42;

    bfSize      := SCRX * SCRY * 3 + SizeOf(BFH) + SizeOf(BIH);

    bfReserved1 := 0;

    bfReserved2 := 0;

    bfOffBits   := SizeOf(BFH) + SizeOf(BIH);

  end;

  with BIH.bmiHeader do

  begin

   biSize         := sizeof(BIH);

   biWidth        := SCRX;

   biHeight       := SCRY;

   biPlanes       := 1;

   biBitCount     := 24;

   biCompression  := BI_RGB;

   biSizeImage    := ScrSize;

   biClrImportant := 0;

  end;

  GetDiBits(DC, hbmp, 0, SCRY, Bits, BIH, DIB_RGB_COLORS);

  DeleteObject(hbmp);

  AssignFile(F, FileName);

  Rewrite(F, 1);

  Blockwrite(F, BFH, SizeOf(BFH));

  Blockwrite(F, BIH, SizeOf(BIH));

  Blockwrite(F, bits^, ScrSize);

  CloseFile(F);

  FreeMem(Bits);

end;

begin

  ApiScrCapture('1.bmp');

end.