Alexey_Gawrilow
Advanced Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
MagistrAnatol
unit ScrCap;
interface
uses
Windows, Forms, Classes, Graphics, Controls;
Function CaptureScreenRect(ARect : TRect) : TBitmap;
Function CaptureScreen : TBitmap;
Function CaptureClientImage(AControl : TControl) : TBitmap;
Function CaptureControlImage(AControl : TControl) : TBitmap;
implementation
// Захват прямоугольной области экрана
Function CaptureScreenRect(ARect : TRect) : TBitmap;
Var
wScrDC : HDC;
begin
Result := TBitmap.Create;
with Result, ARect do
begin
Width := Right - Left;
Height := Bottom- Top;
wScrDC := GetDC(0);
try
BitBlt(Canvas.Handle, 0, 0, Width, Height, wScrDC, Left, Top, SRCCOPY);
finally
ReleaseDC(0, wScrDC);
end;
end;
end;
// Захват экрана
Function CaptureScreen : TBitmap;
begin
with Screen do
Result := CaptureScreenRect(Rect(0, 0, Width, Height));
end;
// Захват клиентской области формы или элемента управления
Function CaptureClientImage(AControl : TControl) : TBitmap;
begin
with AControl, AControl.ClientOrigin do
Result := CaptureScreenRect(Bounds(X, Y, ClientWidth, ClientHeight));
end;
// Захват формы или элемента управления
Function CaptureControlImage(AControl : TControl) : TBitmap;
begin
with AControl 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.
|
Спасибо всем большое! 
