Копирование экрана
Материал из DRKB
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.
Author: Зайцев О.В.
Author: Владимиров А.М.
Source: http://forum.sources.ru
ID: 03823