delphi截图程序无窗口版


program ScreenShot;

uses Windows, Classes, Graphics, Jpeg;

procedure DrawCursor(Bmp: TBitmap);
var
  r: TRect;
  CI: TCursorInfo;
  Icon: TIcon;
  II: TIconInfo;
begin
  r := Bmp.Canvas.ClipRect;
  Icon := TIcon.Create;
  try
   CI.cbSize := SizeOf(CI);
   if GetCursorInfo(CI) then
   if CI.Flags = CURSOR_SHOWING then
   begin
   Icon.Handle := CopyIcon(CI.hCursor);
   if GetIconInfo(Icon.Handle, II) then
   begin
   Bmp.Canvas.Draw(
   ci.ptScreenPos.x - Integer(II.xHotspot) - r.Left,
   ci.ptScreenPos.y - Integer(II.yHotspot) - r.Top,
   Icon
   );
   end;
   end;
  finally
   Icon.Free;
  end;
end;

procedure SaveScreenToFile(FileName: String);
var
  Bmp: TBitmap;
  Jpg: TJpegImage;
begin
  Bmp := TBitmap.Create;
  Jpg := TJpegImage.Create;
  try
   Bmp.Width := GetSystemMetrics(SM_CXSCREEN);
   Bmp.Height := GetSystemMetrics(SM_CYSCREEN);
   BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, GetDc(0), 0, 0, SRCCOPY);
   DrawCursor(Bmp);
   Jpg.Assign(Bmp);
   Jpg.CompressionQuality := 60;
   Jpg.Compress;
   Jpg.SaveToFile(FileName);
  finally
   Bmp.free;
   Jpg.free;
  end;
end;

begin
SaveScreenToFile('SHOT.JPG');
end.


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678