unit ScreenShot;
interface
uses
Windows, SysUtils, Classes, Graphics, Jpeg;
function CatchScreen(const FileName: string):boolean;
implementation
function CatchScreen(const FileName: string):boolean;
var
DC: HDC;
SrcHandle: HWND;
Bmp: TBitmap;
JPG: TJpegImage;
Cvs: TCanvas;
SrcRect: TRect;
CI: TCursorInfo;
Icon: TIcon;
II: TIconInfo;
begin
SrcHandle := GetDesktopWindow;
DC := GetWindowDC(SrcHandle);
Cvs := TCanvas.Create;
Cvs.Handle := DC;
GetWindowRect(SrcHandle,SrcRect);
Bmp := TBitmap.Create;
JPG := TJPEGImage.Create;
try
try
Bmp.Width := SrcRect.Right - SrcRect.Left;
Bmp.Height := SrcRect.Bottom - SrcRect.Top;
Bmp.Canvas.CopyMode := cmSrcCopy;
Bmp.Canvas.CopyRect(SrcRect,Cvs,SrcRect);
finally
Cvs.Free;
ReleaseDC(SrcHandle, DC);
end;
CI.cbSize := sizeof(CI);
GetCursorInfo(CI);
if CI.flags = CURSOR_SHOWING then
begin
Icon := TIcon.Create;
Icon.Handle := CopyIcon(CI.hCursor);
if GetIconInfo(ICon.Handle,II) then
begin
Bmp.Canvas.Draw(CI.ptScreenPos.X,CI.ptScreenPos.Y,Icon);
DeleteObject(II.hbmMask);
DeleteObject(II.hbmColor);
end;
end;
//Bmp.SaveToFile('C:\test.bmp');
JPG.Assign(Bmp);
Jpg.SaveToFile(FileName);
finally
Bmp.Free;
Jpg.Free;
end;
result := true;
end;
end.
ScreenShot 连带鼠标的抓屏单元
最新推荐文章于 2021-08-12 16:30:01 发布