Содержание материала

сode:

var

Image3: TImage;

 

procedure TSaverForm.CopyScreen;

var

 

DeskTopDC: HDc;

DeskTopCanvas: TCanvas;

DeskTopRect: TRect;

begin

 

Image3 := TImage.Create(SaverForm);

with Image3 do

begin

   Height := Screen.Height;

   Width := Screen.Width;

end;

Image3.Canvas.copymode := cmSrcCopy;

DeskTopDC := GetWindowDC(GetDeskTopWindow);

DeskTopCanvas := TCanvas.Create;

DeskTopCanvas.Handle := DeskTopDC;

Image3.Canvas.CopyRect(Image3.Canvas.ClipRect, DeskTopCanvas,

   DeskTopCanvas.ClipRect);

Image2.Picture.Assign(Image3.Picture);

{image2 расположен на целевой форме и выровнен по области клиента}

end;

 

procedure TSaverForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

 

Image3.Free;

end;

 


 

Попробуйте следующий HAX 244, взятый из Авг/Сен номера журнала Visual Developer. Это работает, и работает хорошо.

 

Code:

{ смотри текстовое описание за последним END. }

unit Scrncap;

 

interface

uses WinTypes, WinProcs, Forms, Classes, Graphics;

 

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.

 

{

Источник:  Visual Developer, HAX #244,

 

захват экрана с помощью Delphi

 

В Delphi, если вы хотите получить изображение клиентской области формы,

необходимо вызвать GetFormlmage. Но иногда возникает необходимость

получения снимка формы целиком, вместе с заголовком, контуром и всем

содержимым. Или целиком всего экрана. Если бы у вас был дефицит времени,

мы бы в этом случае посоветовали показывать диалоговое окно с надписью

"Теперь нажмите кнопку Print Screen!", после чего работать с

изображением, помещенным в буфер обмена.

 

Но мы никуда не спешим. Комбинирование хостов Delphi с несколькими

функциями GDI сводят задачу получения снимка экрана всего к одной

строчке кода.

 

CaptureScreenRect, в листинге 1, демонстрирует это. Код получает

экранный контекст устройства с помощью GetDC(O), и затем копирует

прямоугольную область этого DC на холст изображения (Bitmap). Для

копирования используется BitBlt. Смысл использования BitBlt (и

любой функции GDI) в том, что Delphi помнит, что дескриптор холста

есть DC, необходимый Windows.

 

Остальные функции копирования экрана в листинге 1 захватывают

прямоугольник и отдает реальную работу на откуп CaptureScreenRect.

CaptureScreen захватывает для прямоугольника целый экран.

CaptureClientImage и CaptureControlImage захватывают прямоугольник

области клиента и элемента управления, соответственно.

 

Эти четыре функции могут быть использованы для захвата любой

произвольной области экрана, а также экранных областей форм,

кнопок, полей редактирования, ComboBox'ов и пр.. Не забывайте

после работы освобождать используемые вами картинки (Bitmap). }

 

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить