Главная / 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 GetSystemPalette : HPalette;
var
 PaletteSize  : integer;
 LogSize      : integer;
 LogPalette   : PLogPalette;
 DC           : HDC;
 Focus        : HWND;
begin
 result:=0;
 Focus:=GetFocus;
 DC:=GetDC(Focus);
 try
   PaletteSize:=GetDeviceCaps(DC, SIZEPALETTE);
   LogSize:=SizeOf(TLogPalette)+(PaletteSize-1)*SizeOf(TPaletteEntry);
   GetMem(LogPalette, LogSize);
   try
     with LogPalette^ do
     begin
       palVersion:=$0300;
       palNumEntries:=PaletteSize;
       GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);
     end;
     result:=CreatePalette(LogPalette^);
   finally
     FreeMem(LogPalette, LogSize);
   end;
 finally
   ReleaseDC(Focus, DC);
 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;
  Palette:=GetSystemPalette;
 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.

Copyright ©   "Мастера DELPHI"   E-mail:   delphi@mastak.com  http://www.delphimaster.ru

Источник получения информации: http://www.delphimaster.ru