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;