带鼠标图形的截屏代码

时间:2010-01-27 09:04:18  来源:第二电脑网  作者:第二电脑网

  第二电脑网导读:rdercolordark="#ffffff" cellpadding="5" width="99%" bgcolor="#ffffc0" border="1">unit MyGraph;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls,Forms, Dialogs ,jpeg ,Registry ;typeTCapMode=(cmCapFullScr,cmCapWindow,cmCapWindowClient,cmCapObject);TSaveType=(st...
  正文:

截屏软件我们见过的有很多了,可是大多数软件截获后的图片是不能带鼠标图形的,这为我们的使用带来了很大的不便。下面这个单元可以实现带鼠标图形的截屏,并且有多种截屏模式可供选择。



unit MyGraph;

interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs ,jpeg ,Registry ;

type
TCapMode=(cmCapFullScr,cmCapWindow,cmCapWindowClient,cmCapObject);
TSaveType=(stBitMap,stJPEG);
TPic=class
private
PicInfoStr:string;
public
function LoadPic(PathName:string):TBitMap;
procedure SavePic(PathName:string;Pic:TBitMap;
SaveType:TSaveType;PicQuality:word);
function GetLastLoadPicInfoStr:string;
end;



////////////////////////////////////////////////////////////////////
//屏幕读取函数,分别抓取整个屏幕,当前窗口,
//当前窗口客户区,当前鼠标处对象
procedure CapFullScr(var Dest:TBitmap;IncludeCursor:boolean);
procedure CapWindow(WinHandle:HWND;var Dest:TBitmap;IncludeCursor:boolean);
procedure CapClient(WinHandle:HWND;var Dest:TBitmap;IncludeCursor:boolean);
procedure CapObject(var Dest:TBitmap;IncludeCursor:boolean);
procedure DrawCursor(var Dest:TBitmap;ObjectLeft,ObjectTop:Integer); //在以上函数中调用
function CapAndSaveToFile(PathName:AnsiString;CapMode:TCapMode;SaveType:TSaveType;CapCursor:Boolean;
PicQuality:word;SaveBit:TPixelFormat; StretchMode:integer;
StretchPer:integer;PicBreadth:integer;PicHeight:integer):Boolean;
//////////////////////////////////////////////////////////////////////

procedure BmpToJpeg(BmpPic:TBitmap;var JpegPic:TJpegImage;PicQuality:integer);
procedure JpegToBmp(JpegPic:TJPEGImage;var Bmp:TBitmap);
procedure JpegFileToBmp(JpegPathName, BmpPathName: string);

///////////////////////////////////////////////////////////////////////////
implementation

procedure CapFullScr(var Dest:TBitmap;IncludeCursor:boolean);

var
DC:HDC;

begin
  Dest.Width:=Screen.Width;
  Dest.Height:=Screen.Height;
  DC:=GetDC(0);
  bitblt(dest.canvas.handle,0,0,Screen.Width,Screen.Height,DC,0,0,SRCCOPY);
  if IncludeCursor then DrawCursor(Dest,0,0);
  ReleaseDC(0,DC);
end;

procedure CapWindow(WinHandle:HWND;var Dest:TBitmap;IncludeCursor:boolean);
var
DC:HDC;
r:TRect;

begin
  GetWindowRect(WinHandle,r);
  Dest.Width:=r.Right-r.Left;
  Dest.Height:=r.Bottom-r.Top;
  DC:=GetWindowDC(WinHandle);
  bitblt(dest.canvas.handle,0,0,Dest.Width,Dest.height,DC,0,0,SRCCOPY);
  if IncludeCursor then DrawCursor(Dest,r.Left,r.Top);
  ReleaseDC(WinHandle,DC);
end;

procedure CapClient(WinHandle:HWND;var Dest:TBitmap;IncludeCursor:boolean);
var
DC:HDC;
_r,r:TRect;

begin
  GetWindowrect(WinHandle,_r);
  GetClientRect(WinHandle,r);
  Dest.Width:=r.Right-r.Left;
  Dest.Height:=r.Bottom-r.Top;
  DC:=GetDC(WinHandle);
  bitblt(dest.canvas.handle,0,0,Dest.Width,Dest.height,DC,0,0,SRCCOPY);
  if IncludeCursor then DrawCursor(Dest,_r.Right-r.right,_r.bottom-r.bottom);
  ReleaseDC(WinHandle,DC);
end;

procedure CapObject(var Dest:TBitmap;IncludeCursor:boolean);
var
DC:HDC;
r:TRect;
Pos:TPoint;
WinHandle:HWND;
begin
  GetCursorPos(Pos);
  Winhandle:=WindowFromPoint(Pos);
  GetWindowRect(WinHandle,r);
  Dest.Width:=r.Right-r.Left;
  Dest.Height:=r.Bottom-r.Top;
  DC:=GetWindowDC(WinHandle);
  bitblt(dest.canvas.handle,0,0,Dest.Width,Dest.height,DC,0,0,SRCCOPY);
  Pos.x:=Pos.x-r.Left-10;
  pos.y:=pos.y-r.Top-10;
  if IncludeCursor then DrawCursor(Dest,r.Left,r.Top);
  ReleaseDC(WinHandle,DC);
end;
"带鼠标图形的截屏代码"由第二电脑网原创提供,转载请注明:http://www.002pc.com/master/College/Language/Delphi/2010-01-27/12459.html

 1/4    1 2 3 4 下一页 尾页


关键字:

关于《带鼠标图形的截屏代码》文章的评论

站内搜索: 高级搜索

热门搜索: Windows style 系统 tr IP QQ CPU 安装 function 注册 if td