Delphi 截屏函数（包含截取鼠标形状）

本文整理自网络，侵删。

 
//--------------------------------------------------------------------------------------------
 function getDateFilename():string;
  var
    s:string;
  begin
    DateTimeToString(s,'yyyymmddhhnnsss',now());
    result:=s;
  end;
//截屏
function captureScreen(x1:integer;y1:integer;x2:integer;y2:integer):tbitmap;
var
  dc:HDC;
  bmp:tbitmap;
  fullCanvas:TCanvas;
begin
  dc:=GetDC(0);
  fullCanvas:=TCanvas.Create;
  fullCanvas.Handle:=dc;
  bmp:=TBitmap.Create;
  try
    bmp.Width:=abs(x2-x1);
    bmp.Height:=abs(y2-y1);
    bmp.Canvas.CopyRect(Rect(0,0,bmp.Width,bmp.Height),fullCanvas,Rect(x1,y1,x2,y2));
    //bmp.SaveToFile('c:\tmp\1.bmp');
  finally
  end;
  result:=bmp;
end;
 
 
//*************** Draw Cursor on the bitmap ******************
Function DrawCursor(Bit : TBitmap) : TBitmap;
Var
Cur : TCursorInfo;
Icn : TIcon;
IcnInfo : TIconInfo;
Rec : TRect;
begin
Icn := TIcon.Create;
Rec := Bit.Canvas.ClipRect;
try
Cur.cbSize := SizeOf(Cur);
if GetCursorInfo(Cur) then
if Cur.flags = CURSOR_SHOWING then
begin
Icn.Handle := CopyIcon(Cur.hCursor);
if GetIconInfo(Icn.Handle, IcnInfo) then
Bit.Canvas.Draw(Cur.ptScreenPos.X - Integer(IcnInfo.XHotSpot) - Rec.Left,
Cur.ptScreenPos.Y - Integer(IcnInfo.YHotSpot) - Rec.Top,
Icn);
end;
finally
Icn.Free;
end;
Result := Bit;
end;
//************ End of cursor drawing *************************
 

相关阅读 >>

Delphi 比较两个日期是否大于n天

Delphi xe 版本 示例原码下载

Delphi firedac 连接access mdb数据库的方法

Delphi memo 过滤重复字符 indexof

Delphi三种弹窗

Delphi使用idhttp 获取 httpsurl内容

Delphi cpu窗口的扩展学习

Delphi 2009 之 tcategorypanelgroup[1]: chevronalignment 等

Delphi 关于rs485总线通信协议开发注意事项

Delphi 让程序主窗口不响应“显示桌面”

更多相关阅读请进入《Delphi》频道 >>

转载请注明出处：木庄网络博客 » Delphi 截屏函数（包含截取鼠标形状）