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.

原创粉丝点击