关于截屏(100分)

用函数截屏时如何将鼠标一起截下来？

>>

先截屏，取Screen.Cursor然后用DrawIcon将鼠标一并画上去

或者去这里下载控件
http://www.torry.net/displaying.htm

截屏为BMP文件

program GetScrnBmp;

uses
Windows, Graphics;

{$R *.RES}

var
B: TBitmap;
S: string;

begin

B := TBitmap.Create;

B.Width := GetSystemMetrics(SM_CXSCREEN); {Screen.Width}
B.Height := GetSystemMetrics(SM_CYSCREEN); {Screen.Height}

BitBlt(B.Canvas.handle, 0, 0, B.Width, B.Height, GetDc(0), 0, 0, SRCCOPY);


if ParamStr(1) <> '' then
S := ParamStr(1) + '.bmp'
else
S := 'Screen.bmp';

b.SaveToFile (s);

b.Free;

end.

试试这个吧，不过鼠标位置可能会有几个像素的偏差
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;

procedure DrawCursor(var Dest:TBitmap;ObjectLeft,ObjectTop:Integer);
var GlobalCur:TIcon;
windowhld:hwnd;
threadld:dword;
Pos:TPoint;
begin
GetCursorPos(Pos);
windowhld:=GetForegroundWindow;
threadld:=GetWindowThreadProcessId(Windowhld,nil);
AttachThreadInput(GetCurrentThreadId,threadld,true);
GlobalCur:=TIcon.Create;
GlobalCur.handle:=GetCursor;
AttachThreadInput(GetCurrentThreadId,threadld,false);

Dest.canvas.brush.Style:=bsclear;

Dest.canvas.draw(Pos.x-ObjectLeft-10,
Pos.y-ObjectTop-10,GlobalCur);
end;

////////////////////////////////////////////////////////////////////

procedure BmpToJpeg(BmpPic:TBitmap;var JpegPic:TJpegImage;PicQuality:integer);
begin
JpegPic.Assign(BmpPic);
JpegPic.CompressionQuality:= PicQuality;
Jpegpic.Compress;
end;

procedure JpegToBmp(JpegPic:TJPEGImage;var Bmp:TBitmap);
begin
Bmp.Assign(JpegPic);
end;

procedure JpegFileToBmp(JpegPathName, BmpPathName: string);
var
JpegPic:TJPEGImage;
BmpPic:TBitmap;
begin
JpegPic:=TJPEGImage.Create;
BmpPic:=TBitmap.Create;
try
JpegPic.LoadFromFile(JpegPathName);
BmpPic.Assign(JpegPic);
BmpPic.SaveToFile(BmpPathName);
except
on E:Exception do
MessageBox(0,PChar(E.Message),'错误',MB_OK);
end;
JpegPic.Free;
BmpPic.Free;
end;



///////////////////////////////////////////////////////////////////////

function CapAndSaveToFile(PathName:AnsiString;CapMode:TCapMode;SaveType:TSaveType;
CapCursor:Boolean;PicQuality:word;SaveBit:TPixelFormat;
StretchMode:integer;StretchPer:integer;PicBreadth:integer;
PicHeight:integer):Boolean;
var
Bmp:Tbitmap;
TmpBmp:Tbitmap;
Rect1,Rect2:Trect;
begin
bmp:=TbitMap.Create;
try
case CapMode of
cmCapFullScr: CapFullScr(bmp,CapCursor);
cmCapWindow: CapWindow(Getforegroundwindow,bmp,CapCursor);
cmCapWindowClient: CapClient(Getforegroundwindow,bmp,CapCursor);
cmCapObject: CapObject(bmp,CapCursor);
end;

if not DirectoryExists(ExtractFilePath(PathName)) then
begin
Result:=False;
Exit;
end;

bmp.PixelFormat:=SaveBit;

//缩放处理
if StretchMode=0 then
begin
if StretchPer<>100 then
begin
tmpbmp:=tbitmap.Create;
tmpbmp.Assign(bmp);
Rect1:=Rect(0,0,Round(bmp.Width*StretchPer/100),Round(bmp.Height*StretchPer/100));
Rect2:=Rect(0,0,bmp.Width,bmp.Height);
bmp.Canvas.CopyMode:=cmSrcCopy;
bmp.Width:=rect1.Right;
bmp.Height:=Rect1.Bottom;
bmp.Canvas.CopyRect(rect1,tmpbmp.Canvas,rect2);
TmpBmp.Free;
end;
end
else
begin
tmpbmp:=tbitmap.Create;
tmpbmp.Assign(bmp);
Rect1:=Rect(0,0,PicBreadth,PicHeight);
Rect2:=Rect(0,0,bmp.Width,bmp.Height);
bmp.Canvas.CopyMode:=cmSrcCopy;
bmp.Width:=rect1.Right;
bmp.Height:=Rect1.Bottom;
bmp.Canvas.CopyRect(rect1,tmpbmp.Canvas,rect2);
TmpBmp.Free;
end;

TPic.Create.SavePic(PathName,bmp,SaveType,PicQuality);

bmp.Free;
Result:=True;

except
bmp.Free;
Result:=False;
end;
end;





{ TPic }

function TPic.GetLastLoadPicInfoStr: string;
begin
Result:=PicInfoStr;
end;

function TPic.LoadPic(PathName: string): TBitMap;
var
jpeg:TJPEGImage;
Ext:string;
PicTypeInfoStr:string;
begin
Result:=TBitMap.Create;
Ext:=ExtractFileExt(PathName);
try
if CompareText(Ext,'.bmp')=0 then
Result.LoadFromFile(PathName);
PicTypeInfoStr:='BMP位图';
////////////////////////////////////////////////////////////
if ( (ComPareText(Ext,'.jpg')=0) or (ComPareText(Ext,'.jpeg')=0) ) then
begin
jpeg:=TJPEGImage.Create;
try
jpeg.LoadFromFile(PathName);
Result.Assign(jpeg);
PicTypeInfoStr:='JPEG图象';
except
jpeg.Free;
raise;
end;
end;
/////////////////////////////////////////////////////////////

PicInfoStr:=IntToStr(Result.Width)+'x'+IntToStr(Result.Height);
case Result.PixelFormat of
pf1bit: PicInfoStr:=PicInfoStr+'x1位';
pf4bit: PicInfoStr:=PicInfoStr+'x4位';
pf8bit: PicInfoStr:=PicInfoStr+'x8位';
pf15bit: PicInfoStr:=PicInfoStr+'x15位';
pf16bit: PicInfoStr:=PicInfoStr+'x16位';
pf24bit: PicInfoStr:=PicInfoStr+'x24位';
pf32bit: PicInfoStr:=PicInfoStr+'x32位';
end;
PicInfoStr:=PicInfoStr+' '+PicTypeInfoStr ;
except
Result.Free;
raise;
end;
end;

procedure TPic.SavePic(PathName: string; Pic: TBitMap; SaveType: TSaveType;
PicQuality: Word);
var
jpeg:TJPEGImage;
begin
case SaveType of
stBitMap:
Pic.SaveToFile(PathName);
///////////////////////////////////////////////////////////////
stJPEG:
begin
Jpeg:=TJpegImage.Create;
try
Jpeg.Assign(Pic);
Jpeg.CompressionQuality:=PicQuality;
Jpeg.Compress;
Jpeg.SaveToFile(PathName);
except
Jpeg.Free;
raise;
end;
end;
///////////////////////////////////////////////////
end;
end;

end.

dafuwen的不对啊,呵呵...

如何在截屏时不截到程序本身的窗口？

抓 图 实 际 上 是 位 图 的 复 制 ， Windows在 复 制 位 图 时 是 不 会 受 鼠 标
光 标 的 影 响 的 。 可 以 先 抓 图 ， 然 后 在 使 用 DrawIcon将 鼠 标 光 标 画 上 去 。
procedure TForm1.FormClick(Sender: TObject);
var
winHWND, hCur:integer;
winDC:integer;
rect:TRect;
pt:TPoint;
fBitmap:TBitmap;
begin
hCur := GetCursor(); // 获 得 光 标 句 柄
GetCursorPos(pt); // 记 录 光 标 位 置
winHWND := GetDesktopWindow();
winDC := GetDC(winHWND);
GetWindowRect(winHWND, rect);
fBitmap := TBitmap.create;
fBitmap.width := rect.right-rect.left;
fBitmap.height := rect.bottom-rect.top;
BitBlt(fBitmap.canvas.handle, 0, 0, fBitmap.width, fBitmap.height, winDC, 0, 0, SRCCOPY);
DrawIcon(fBitmap.canvas.handle, pt.x, pt.y, hCur); // 画 光 标
ReleaseDC(winHWND, winDC);
Image1.Picture.Bitmap.Assign(fBitmap);
fBitmap.Free;
end;

我试过了,可以成功,但有几个问题:实际鼠标箭头不是漏斗,
但截屏后是漏斗,还于实际差了几像素,请您解决,谢谢!

补充几点：
1、不能直接用GetCursor()，此函数是捕捉当前进程（是抓屏程序）的鼠标指针句柄
如果你要得到其他程序/线程的cursor,必须要先把它的输入处理(input process)
getcursorpos(mp);
hld:=Windowfrompoint(mp);
threadld:=GetWindowThreadProcessId(hld,nil);
AttachThreadInput(GetCurrentThreadId,threadld,true);//输入
ico:=ticon.Create;
ico.Handle:=getcursor;
AttachThreadInput(GetCurrentThreadId,threadld,false);//释放
2、关于错几个像素
鼠标指针所指的真正位置（点）并不一定是ico图片的右上角，而是由Hotspot决定
用GetIconInfo函数能得到xHotspot;yHotspot;
DrawIcon(fBitmap.canvas.handle, pt.x-xHotspot, pt.y-yHotspot, hCur);

谢谢各位
特别是千堆雪和凤凰
今后多联系
已经给分!