区域抓图功能如何实现(100分)

新版的QQ具有区域抓图功能，不知是如何实现的。说说实现方法。能提供代码最好。

好

unit uCatchScreenShow;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;

type
TCatchScreenShowForm = class(TForm)
ChildImage: TImage;
ChildTimer: TTimer;
procedure ChildTimerTimer(Sender: TObject);
procedure ChildImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ChildImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
CatchScreenShowForm: TCatchScreenShowForm;
foldx,x1,y1,x2,y2,oldx,oldy,foldy : Integer;
Flag,Trace : Boolean;
implementation

uses UCatchScreen;

{$R *.DFM}

procedure TCatchScreenShowForm.ChildTimerTimer(Sender: TObject);
var
Fullscreen:Tbitmap;
FullscreenCanvas:TCanvas;
DC:HDC;
begin
ChildTimer.Enabled := False;
Fullscreen := TBitmap.Create;
Fullscreen.Width := Screen.width;
Fullscreen.Height := Screen.Height;
DC:=GetDC(0);
FullscreenCanvas := TCanvas.Create;
FullscreenCanvas.Handle := DC;
Fullscreen.Canvas.CopyRect(Rect(0,0,Screen.Width,Screen.Height),FullscreenCanvas,
Rect(0,0,Screen.Width,Screen.Height));
FullscreenCanvas.Free;
ReleaseDC(0,DC);
ChildImage.picture.Bitmap:=fullscreen;
ChildImage.Width := Fullscreen.Width;
ChildImage.Height:=Fullscreen.Height;
Fullscreen.free;
CatchScreenShowForm.WindowState := wsMaximized;
CatchScreenShowForm.show;
messagebeep(1);
foldx:=-1;
foldy:=-1;
ChildImage.Canvas.Pen.mode := Pmnot; //笔的模式为取反
ChildImage.Canvas.pen.color := clblack; //笔为黑色
ChildImage.Canvas.brush.Style := bsclear;//空白刷子
Flag := True;
end;


procedure TCatchScreenShowForm.ChildImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if trace=true then//是否在追踪鼠标？
begin//是，擦除旧的矩形并画上新的矩形
with ChildImage.canvas do
begin
rectangle(x1,y1,oldx,oldy);
Rectangle(x1,y1,x,y);
oldx:=x;
oldy:=y;
end;
end
else if flag=true then//在鼠标所在的位置上画十字
begin
with ChildImage.canvas do
begin
MoveTo(foldx,0);//擦除旧的十字
LineTo(foldx,Screen.Height);
MoveTo(0,foldy);
LineTo(Screen.Width,foldy);
MoveTo(x,0);//画上新的十字
LineTo(x,Screen.Height);
MoveTo(0,y);
LineTo(Screen.Width,y);
foldx:=x;
foldy:=y;
end;
end;
end;

procedure TCatchScreenShowForm.ChildImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Width,Height : Integer;
NewBitmap : TBitmap;
begin
if (Trace = False) then//TRACE表示是否在追踪鼠标
begin//首次点击鼠标左键，开始追踪鼠标。
Flag := False;
with ChildImage.canvas do
begin
MoveTo(foldx,0);
LineTo(foldx,screen.height);
MoveTo(0,foldy);
LineTo(screen.width,foldy);
end;
x1 := x;
y1 := y;
oldx := x;
oldy := y;
Trace := True;
ChildImage.Canvas.Pen.mode:=pmnot;//笔的模式为取反
//这样再在原处画一遍矩形，相当于擦除矩形。
ChildImage.canvas.pen.color := clblack;//笔为黑色
ChildImage.canvas.brush.Style := bsclear;//空白刷子
end
else
begin//第二次点击，表示已经得到矩形了，把它拷贝到FORM1中的IMAGE部件上。
x2 := x;
y2 := y;
Trace := False;
ChildImage.Canvas.Rectangle(x1,y1,oldx,oldy);
Width := abs(x2-x1);
Height := abs(y2-y1);
CatchScreenForm.ShowImage.Width := Width;
CatchScreenForm.ShowImage.Height := Height;

NewBitmap:=Tbitmap.create;
NewBitmap.Width := Width;
NewBitmap.Height := Height;
NewBitmap.Canvas.CopyRect
(Rect(0,0,width,Height),CatchScreenShowForm.ChildImage.Canvas,
Rect(x1,y1,x2,y2));//拷贝
CatchScreenForm.ShowImage.Picture.Bitmap := NewBitmap;//放到CatchScreenForm的ShowImage上
NewBitmap.Free;
CatchScreenShowForm.Hide;
CatchScreenForm.Show;
end;
end;

procedure TCatchScreenShowForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action := caFree;
end;

end.

//自定义函数,随机取得4位a到z之间字符串,作为JPG格式图像的文件名
function RandomFileName():String;
var
PicName : string;
I : Integer;
begin
Randomize;
for I := 1 to 4 do
PicName := PicName+chr(97+random(26));
RandomFileName:=PicName;
end;

procedure TCatchScreenForm.BMPToJPG(BmpFileName:string);
var
Jpeg : TJPEGImage;
Bmp : TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile(BmpFileName);
Jpeg := TJPEGImage.Create;
try
Jpeg.Assign(Bmp);
Jpeg.Compress;
//以随机文件名保存在与EXE文件同目录下
Jpeg.SaveToFile(ExtractFilePath(Application.ExeName)+RandomFileName+'.jpg');
finally
Jpeg.Free;
end;
finally
Bmp.Free;
end;
end;

procedure TCatchScreenForm.MainTimerTimer(Sender: TObject); //抓取屏幕，并保存到Image控件中
var
Fullscreen : TBitmap;
FullscreenCanvas : TCanvas;
DC : HDC;
begin
MainTimer.Enabled := False;//取消时钟
Fullscreen:=TBitmap.Create;//创建一个BITMAP来存放图象
Fullscreen.Width := Screen.Width;
Fullscreen.Height := Screen.Height;
DC:=GetDC(0);//取得屏幕的DC，参数0指的是屏幕
FullscreenCanvas := TCanvas.Create;//创建一个CANVAS对象
FullscreenCanvas.Handle := DC;

Fullscreen.Canvas.CopyRect
(Rect(0,0,Screen.Width,Screen.Height),FullScreenCanvas,
Rect(0,0,Screen.Width,Screen.Height));
//把整个屏幕复制到BITMAP中
FullScreenCanvas.Free;//释放CANVAS对象
ReleaseDC(0,DC);//释放DC
//*******************************
ShowImage.Picture.Bitmap := FullScreen;//拷贝下的图象赋给IMAGE对象
ShowImage.Width := FullScreen.Width;
ShowImage.Height := FullScreen.Height;
FullScreen.Free;//释放bitmap
CatchScreenForm.WindowState := wsNormal;//复原窗口状态
CatchScreenForm.Show;//显示窗口
MessageBeep(1);//BEEP叫一声，报告图象已经截取好了。
end;

procedure TCatchScreenForm.AllScreenSpeedBtnClick(Sender: TObject);//全屏抓图
begin
CatchScreenForm.WindowState := wsMinimized;//最小化程序窗口
CatchScreenForm.Hide;//把程序藏起来
MainTimer.Enabled := True;//打开记时器
end;

procedure TCatchScreenForm.QuYueSreenSpeedBtnClick(Sender: TObject);//区域抓图
begin
try
begin
CatchScreenForm.Hide;
CatchScreenShowForm.Hide;
CatchScreenShowForm.ChildTimer.Enabled := True;
end
except
MsgBox;
end;
end;

procedure TCatchScreenForm.SaveSpeedBtnClick(Sender: TObject);//保存图片
begin
if SaveDialog.Execute then
begin
CatchScreenForm.ShowImage.Picture.SaveToFile(SaveDialog.FileName);
BMPToJPG(SaveDialog.FileName);
end;
end;

procedure TCatchScreenForm.ExitSpeedBtnClick(Sender: TObject);
begin
Close;
end;

procedure TCatchScreenForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action := caFree;
//AutoScreenForm.Free;
end;

procedure TCatchScreenForm.OpenDlgSpeedBtnClick(Sender: TObject);
begin
try
begin
OpenDialog.Filter := '窗体换肤文件(*.skn)|*.skn';
if OpenDialog.Execute then
SkinData.SkinFile := OpenDialog.FileName;
end
except
MsgBox;
end;
end;

procedure TCatchScreenForm.MsgBox;
begin
with Application do
MessageBox('程序内部错误',PChar(Title),MB_OK+MB_ICONERROR);
end;

procedure TCatchScreenForm.SystemTimerTimer(Sender: TObject);
var
DateTime : TDateTime;
begin
DateTime := Now;
StatusBar.Panels[1].Text := DateTimeToStr(DateTime);
end;

procedure TCatchScreenForm.FormCreate(Sender: TObject);
var
RegF:TRegistry;
begin
//读取注册表,根据是否设置了开机自动运行,而设置N9的状态
RegF:=TRegistry.Create;
RegF.RootKey:=HKEY_LOCAL_MACHINE;
try
RegF.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run',True);
if RegF.ValueExists('ScreenCapture') then
N9.Checked:=True
else
N9.Checked:=False;
except
MsgBox;
end;
RegF.CloseKey;
RegF.Free;
end;
procedure TCatchScreenForm.N9Click(Sender: TObject);
var RegF : TRegistry;
begin
RegF:=TRegistry.Create;
RegF.RootKey:=HKEY_LOCAL_MACHINE;
try
RegF.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run',True);
//设置开机是否自动运行
if N9.Checked then
begin
RegF.DeleteValue('ScreenCapture');
RegF.WriteString('ScreenCapture',Application.ExeName);
end
else
RegF.DeleteValue('ScreenCapture');
except
MsgBox;
end;
RegF.CloseKey;
RegF.Free;
end;

procedure TCatchScreenForm.AutoScreenSpeedBtnClick(Sender: TObject);
begin
AutoScreenForm := TAutoScreenForm.Create(Application);
AutoScreenForm.Show;
SetWindowPos(AutoScreenForm.Handle, HWND_TOPMOST, AutoScreenForm.Left, AutoScreenForm.Top, AutoScreenForm.Width, AutoScreenForm.Height,0)
end;

end.

希望以上的代码对你有所帮助.

刀剑兄能不能给个MSN联系方式什么的，我想更你学呀