本文整理自网络,侵删。
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.
相关阅读 >>
Delphi firedac 连接access mdb数据库的方法
Delphi tmsweb core webhttprequest1提交json数据
Delphi getprocessisadmin()判断exe是否以管理员身份启动
更多相关阅读请进入《Delphi》频道 >>