procedure ScreenShot(
var ADestBitmap: TBitmap;
var AWindowTitle:
string;
const AActiveWindow: Boolean = True;
const ARemoveBorder: Boolean = True);
function GetWindowTitle(
{$IFDEF MSWINDOWS}const AHWND: HWND
{$ENDIF}):
string;
var
LTitle:
string;
LLen: Integer;
begin
Result := '
';
{$IFDEF MSWINDOWS}LLen := GetWindowTextLength(AHWND) + 1;
{$ENDIF}
SetLength(LTitle, LLen);
{$IFDEF MSWINDOWS}GetWindowText(AHWND, PChar(LTitle), LLen);
{$ENDIF}
Result := Trim(LTitle);
end;
var
{$IFDEF MSWINDOWS}ShotWindow: HWND;
{$ENDIF}
{$IFDEF MSWINDOWS}ShotRect: TRect;
{$ENDIF}
{$IFDEF MSWINDOWS}ShotDC: HDC;
{$ENDIF}
ShotCanvas: TCanvas;
ShotBitmap: TBitmap;
ImageHeight,
ImageWidth,
BorderHeight,
BorderWidth: Integer;
begin
if AActiveWindow
then
// get handle of the focused window
{$IFDEF MSWINDOWS}ShotWindow := GetForegroundWindow
{$ENDIF}
else
// get handle of the desktop
{$IFDEF MSWINDOWS}ShotWindow := GetDesktopWindow
{$ENDIF};
try
AWindowTitle := GetWindowTitle(ShotWindow);
// get size of handle
{$IFDEF MSWINDOWS}GetWindowRect(ShotWindow, ShotRect)
{$ENDIF};
// remove "invisible" area around a window frame
if (AActiveWindow
and ARemoveBorder)
then
begin
{$IFDEF MSWINDOWS}
BorderHeight := GetSystemMetrics(SM_CXDLGFRAME) + GetSystemMetrics(SM_CXSIZEFRAME) + GetSystemMetrics(SM_CXEDGE);
BorderWidth := GetSystemMetrics(SM_CYDLGFRAME) + GetSystemMetrics(SM_CYSIZEFRAME) + GetSystemMetrics(SM_CYEDGE);
ShotRect.Right := ShotRect.Right - BorderWidth;
ShotRect.Left := ShotRect.Left + BorderWidth;
ShotRect.Bottom := ShotRect.Bottom - BorderHeight;
{$ENDIF}
end;
// calculate image size
{$IFDEF MSWINDOWS}
ImageWidth := ShotRect.Right - ShotRect.Left;
ImageHeight := ShotRect.Bottom - ShotRect.Top;
{$ENDIF}
// open a canvas
ShotCanvas := TCanvas.Create;
try
// get handle to device context
{$IFDEF MSWINDOWS}ShotDC := GetDCEx(0, 0, DCX_WINDOW
or DCX_PARENTCLIP
or DCX_CLIPSIBLINGS
or DCX_CLIPCHILDREN)
{GetDC(0)};
{$ENDIF} // (0) = what you see is what you get :-)
try
ShotBitmap := TBitmap.Create;
try
ShotBitmap.PixelFormat := TPixelFormat.pfDevice;
ShotBitmap.Width := ImageWidth;
ShotBitmap.Height := ImageHeight;
// connect canvas to device context
{$IFDEF MSWINDOWS}ShotCanvas.Handle := ShotDC;
{$ENDIF}
ShotBitmap.Canvas.CopyMode := cmSrcCopy;
// copy to image whatever content is in that moment on the screen at given location
ShotBitmap.Canvas.CopyRect(
Rect(0, 0, ImageWidth, ImageHeight),
// dimension of target
{$IFDEF MSWINDOWS}ShotCanvas
{$ENDIF},
// source to use
Rect(
{$IFDEF MSWINDOWS}ShotRect.Left
{$ENDIF},
{$IFDEF MSWINDOWS}ShotRect.Top
{$ENDIF},
{$IFDEF MSWINDOWS}ShotRect.Right
{$ENDIF},
{$IFDEF MSWINDOWS}ShotRect.Bottom
{$ENDIF}));
// location of source
finally
ADestBitmap.Assign(ShotBitmap);
ShotBitmap.Free;
end;
finally
{$IFDEF MSWINDOWS}ReleaseDC(0, ShotDC)
{$ENDIF};
end;
finally
ShotCanvas.Free;
end;
finally
end;
end;
procedure Tfmain.WMHotKey(
Var Msg: TMessage);
var
MyBitmap: TBitmap;
MyClipboard: TClipboard;
MyTitle:
string;
begin
case Msg. WParam
of
id3:
begin
MyBitmap := TBitmap.Create;
Screenshot(MyBitmap, MyTitle);
Image1.Picture.Bitmap.Assign(MyBitmap);
MyClipboard := TClipBoard.Create;
MyClipboard.Assign(MyBitmap);
MyClipBoard.Free;
MyBitmap.Free;
lbStatus.Caption := '
Bild in Zwischenablage kopiert : ' + FormatDateTime('
hh:nn:ss', Now) + '
(' + MyTitle + '
)';
end;
end;
end;