ScreenShot 连带鼠标的抓屏单元

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.