Получение изображения экрана

Code:

// Capture the entire screen

procedure ScreenShot(x: Integer;

  y: Integer; //(x, y) = Left-top coordinate

Width: Integer;

  Height: Integer; //(Width-Height) = Bottom-Right coordinate

bm: TBitMap); //Destination

var

  dc: HDC;

  lpPal: PLOGPALETTE;

begin

  {test width and height}

  if ((Width = 0) or

    (Height = 0)) then

    Exit;

  bm.Width  := Width;

  bm.Height := Height;

  {get the screen dc}

  dc := GetDc(0);

  if (dc = 0) then

    Exit;

  {do we have a palette device?}

  if (GetDeviceCaps(dc, RASTERCAPS) and

    RC_PALETTE = RC_PALETTE) then

  begin

    {allocate memory for a logical palette}

    GetMem(lpPal,

      SizeOf(TLOGPALETTE) +

    (255 * SizeOf(TPALETTEENTRY)));

    {zero it out to be neat}

    FillChar(lpPal^,

      SizeOf(TLOGPALETTE) +

    (255 * SizeOf(TPALETTEENTRY)),

      #0);

    {fill in the palette version}

    lpPal^.palVersion := $300;

    {grab the system palette entries}

    lpPal^.palNumEntries :=

      GetSystemPaletteEntries(dc,

      0,

      256,

      lpPal^.palPalEntry);

    if (lpPal^.PalNumEntries <> 0) then

      {create the palette}

      bm.Palette := CreatePalette(lpPal^);

    FreeMem(lpPal, SizeOf(TLOGPALETTE) +

    (255 * SizeOf(TPALETTEENTRY)));

  end;

  {copy from the screen to the bitmap}

  BitBlt(bm.Canvas.Handle,

    0,

    0,

    Width,

    Height,

    Dc,

    x,

    y,

    SRCCOPY);

  {release the screen dc}

  ReleaseDc(0, dc);

end;

// Example:

procedure TForm1.Button1Click(Sender: TObject);

begin

ScreenShot(0,0,Screen.Width, Screen.Height, Image1.Picture.Bitmap);

end;