ScreenShot 连带鼠标的抓屏单元
来源:互联网 发布:那个软件电影票便宜 编辑:程序博客网 时间:2024/06/08 00:44
unit ScreenShot;interfaceuses Windows, SysUtils, Classes, Graphics, Jpeg; function CatchScreen(const FileName: string):boolean;implementationfunction 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.