Снимок окна

var
bmp: TBitmap;
 DC: HDC;
h:hwnd;
 
begin
 bmp:=TBitmap.Create;
 
 bmp.Height:=Screen.Height;//задаю размер
 bmp.Width:=Screen.Width;
//GetForegroundWindow; //типа получить активное окно, наверно не нужно здесь
 DC:=GetDC(h);   //подставляю хэндл
 bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,          //////////////
       DC, 0, 0, SRCCOPY);
 bmp.SaveToFile('Screen.bmp');
 
 ReleaseDC(0, DC);
end;

{ Функции копирования экрана в < Delphi > }
unit ScrnCap;
 
interface
uses WinTypes, WinProcs, Forms, Classes, 
Graphics, Controls;
 
function CaptureScreenRect( ARect: TRect ): 
TBitmap;
function CaptureScreen: TBitmap;
function CaptureClientImage( Control: TControl )
: TBitmap;
function CaptureControlImage( Control: TControl )
: TBitmap;
 
implementation
 
{ Копирование прямоугольной области экрана... }
function CaptureScreenRect( ARect: TRect )
: TBitmap;
var
  ScreenDC: HDC;
begin
  Result := TBitmap.Create;
  with Result, ARect do
  begin
    Width := Right - Left;
    Height := Bottom - Top;
 
    ScreenDC := GetDC( 0 );
    try
      < BitBlt >( Canvas.Handle, 0, 0, Width, 
      Height, ScreenDC,
        Left, Top, SRCCOPY );
    finally
      ReleaseDC( 0, ScreenDC );
    end;
  end;
end;
 
{ Копирование всего экрана... }
function CaptureScreen: TBitmap;
begin
  with Screen do
    Result := CaptureScreenRect( Rect( 0, 0, 
    Width, Height ));
end;
 
{ Копирование клиентской области формы или 
элемента... }
function CaptureClientImage( Control: TControl )
: TBitmap;
begin
  with Control, Control.ClientOrigin do
    Result := CaptureScreenRect( Bounds( X, Y, 
    ClientWidth,
                ClientHeight ));
end;
 
{ Копирование всей формы или элемента... }
function CaptureControlImage( Control: TControl )
: TBitmap;
begin
  with Control do
    if Parent = nil then
      Result := CaptureScreenRect( Bounds( Left, 
      Top, Width,
                  Height ))
    else
      with Parent.ClientToScreen( Point( Left, 
      Top )) do
        Result := CaptureScreenRect( Bounds( X, 
        Y, Width,
                    Height ));
end;
 
end.

{ Копирование прямоугольной области экрана... }
function CaptureScreenRect( ARect: TRect )
: TBitmap;
var
  ScreenDC: HDC;
begin
  Result := TBitmap.Create;
  with Result, ARect do
  begin
    Width := Right - Left;
    Height := Bottom - Top;
 
    ScreenDC := GetDC( 0 );
    try
      < BitBlt >( Canvas.Handle, 0, 0, Width, 
      Height, ScreenDC,
        Left, Top, SRCCOPY );
    finally
      ReleaseDC( 0, ScreenDC );
    end;
  end;
end;