procedure ScreenShot(hWindow: HWND; bm: TBitmap);
var
 Left, Top, Width, Height: Word;
 R: TRect;
 dc: HDC;
 lpPal: PLOGPALETTE;
begin
 {Check if valid window handle}
 if not IsWindow(hWindow) then Exit;
 {Retrieves the rectangular coordinates of the specified window}
 GetWindowRect(hWindow, R);
 Left := R.Left;
 Top := R.Top;
 Width := R.Right - R.Left;
 Height := R.Bottom - R.Top;
 bm.Width  := Width;
 bm.Height := Height;
 {get the screen dc}
 dc := GetDc(0);
 if (dc = 0) then
  begin
   Exit;
 end;
 {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
    begin
     {create the palette}
     bm.Palette := CreatePalette(lpPal^);
   end;
   FreeMem(lpPal, SizeOf(TLOGPALETTE) +
   (255 * SizeOf(TPALETTEENTRY)));
 end;
 {copy from the screen to the bitmap}
 BitBlt(bm.Canvas.Handle,
   0,
   0,
   Width,
   Height,
   Dc,
   Left,
   Top,
   SRCCOPY);
 {release the screen dc}
 ReleaseDc(0, dc);
end;

procedure GetWindowBitmap(Wnd: HWND; Bmp: TBitmap);
var
R: TRect;
begin
GetWindowRect(Wnd, R);
Bmp.Width:= R.Right - R.Left;
Bmp.Height:= R.Bottom - R.Top;
Bmp.Canvas.Lock;
try
  SendMessage(Wnd, WM_PRINT, Integer(Bmp.Canvas.Handle), PRF_NONCLIENT or PRF_CHECKVISIBLE or
    PRF_CLIENT or PRF_ERASEBKGND or PRF_CHILDREN);
finally
  Bmp.Canvas.Unlock;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 Bitmap: TBitmap;
begin
 Bitmap:=TBitmap.Create;
 try
   GetWindowBitmap(Handle,Bitmap);
   Bitmap.SaveToFile('C:\1.bmp');
 finally
   Bitmap.Free;
 end;
end;