Копирование экрана
Для копирования изображений, находящихся в клиентской части формы,
в Delphi используется метод GetFormImage. Но иногда бывает нужно «сфотографировать» всю форму вместе с заголовком, рамкой и т. д. или даже весь экран. В крайнем случае можно выдать окно сообщения «НЕМЕДЛЕННО нажмите клавишу Print Screen!» и потом как-нибудь вытащить копию экрана из буфера.
К счастью, дело обстоит не настолько плохо. Совместное использование холстов (canvas) Delphi с несколькими функциями GDI превращает копирова ние экрана в совершенно тривиальную задачу. Функция CaptureScreenRect (см. листинг 9.11) показывает, как это делается. Сначала мы получаем для экрана контекст устройства (DC) функцией GetDC(0), а затем копируем прямоугольную область из DC на холст растрового изображения. Копирование выполняется функцией BitBlt. Чтобы воспользоваться в Delphi функцией BitBlt (или любой другой функцией GDI), необходимо лишь помнить о том, что логический номер (handle) холста — это и есть DC, необходимый для вызова функций Windows.
Листинг 9.11. Модуль SCRNCAP.PAS
{ Функции копирования экрана в 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.Остальные функции копирования экрана в листинге 9.11 лишь определяют нужные прямоугольники, а всю основную работу оставляют на долю CaptureScreenRect. Функция CaptureScreen определяет прямоугольник для всего экрана, а CaptureClientImage и CaptureControlImage — прямоугольники для клиентской области и всего элемента соответственно.
С помощью этих четырех функций можно «сфотографировать» любую часть экрана — например, получить экранные изображения форм, кнопок, memo-полей, выпадающих списков и т. д. Только не забудьте сказать: «А сейчас вылетит птичка…» и уничтожить растры после того, как надобность в них отпадет.
