Снимок окна

{ Функции копирования экрана в < 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.