Delphi实现截屏功能

* 功能: 截取屏幕中的指定区域

** 输入参数：

**　　　　　LeftPos ：左坐标

**　　　　　TopPos ：上坐标

** RightPos：右坐标

** BottomPos ：底部坐标

** author : liubin

** datetime : 2010-10-01

***********************************}

procedure ScreenCap(LeftPos,TopPos,RightPos,BottomPos:integer);

var

RectWidth,RectHeight:integer;

SourceDC,DestDC,Bhandle:integer;

Bitmap:TBitmap;

MyJpeg: TJpegImage;

Stream:TMemoryStream;

begin

MyJpeg:= TJpegImage.Create;

RectWidth:=RightPos-LeftPos;

RectHeight:=BottomPos-TopPos;

SourceDC:=CreateDC('DISPLAY','','',nil);

DestDC:=CreateCompatibleDC(SourceDC);

Bhandle:=CreateCompatibleBitmap(SourceDC,

RectWidth,RectHeight);

SelectObject(DestDC,Bhandle);

BitBlt(DestDC,0,0,RectWidth,RectHeight,SourceDC,

LeftPos,TopPos,SRCCOPY);

Bitmap:=TBitmap.Create;

Bitmap.Handle:=BHandle;

Stream := TMemoryStream.Create;

Bitmap.SaveToStream(Stream);

Stream.Free;

try

MyJpeg.Assign(Bitmap);

MyJpeg.CompressionQuality:=70;

MyJpeg.Compress;

MyJpeg.SaveToFile('C:\MyJPEGImage.JPG');

finally

MyJpeg.Free;

Bitmap.Free;

DeleteDC(DestDC);

ReleaseDC(Bhandle,SourceDC);

end;

end;