如何截取当前屏幕的图像？

Question

up

Answer 1

unit ScreenCapture_san;interface
uses
  Windows,classes,sysutils,Graphics,jpeg,ExtCtrls;
//////////////
const
DefaultJPEGCompressionQuality=80;
//////////////
type
  TScreenCapture_San=class
  private
  protected
    BMP:Tbitmap;
    CVS:TCanvas;
    procedure CaptureIt(ARect:TRect);
    function GetScreenWidth:integer;
    function GetScreenHeight:integer;
    function GetScreenRect:TRect;
    function GetBMPRect:TRect;
    //////////
   // function GetOnlyName:string;
  public
    Scale:boolean;
     ///////////////////    procedure Capture(ABmp:TBitMap);overload;
    procedure Capture(ABmp:TBitMap;ARect:TRect);overload;
//////////////////////////////////////////
    procedure Capture(ACanvas:TCanvas);overload;
    procedure Capture(ACanvas:TCanvas;ARect:TRect);overload;    
    procedure Capture(Image:TImage);overload;
    procedure Capture(Image:TImage;ARect:TRect);overload;
    ////////////
    procedure CaptureToStream(Stream:TStream);overload;
    procedure CaptureToScream(Stream:TStream;ARect:TRect);overload;
    ////////////
    function CaptureToFile(FileName:string;ARect:TRect):boolean; overload;
    function CaptureToFile(FileName:string):boolean;overload;
    ////////////
    procedure CaptureJPEG(AJPG:TJpegImage;Quality:TJPEGQualityRange=DefaultJPEGCompressionQuality);overload;
    procedure CaptureJPEG(AJPG:TJpegImage;ARect:TRect;Quality:TJPEGQualityRange=DefaultJPEGCompressionQuality);overload;
    procedure CaptureJPEG(Image:TImage;Quality:TJPEGQualityRange=DefaultJPEGCompressionQuality);overload;
    procedure CaptureJPEG(Image:TImage;ARect:TRect;Quality:TJPEGQualityRange=DefaultJPEGCompressionQuality);overload;    ///////////
    procedure CaptureJPEGToStream(Stream:TStream;Quality:TJPEGQualityRange=DefaultJPEGCompressionQuality);overload;
    procedure CaptureJPEGToStream(Stream:TStream;ARect:TRect;Quality:TJPEGQualityRange=DefaultJPEGCompressionQuality);overload;
    //////////
    function CaptureJPEGToFile(FileName:string;Quality:TJPEGQualityRange=DefaultJPEGCompressionQuality):boolean;overload;
    function CaptureJPEGToFile(FileName:string;ARect:TRect;Quality:TJPEGQualityRange=DefaultJPEGCompressionQuality):boolean;overload;    //////////////////////////    constructor Create;
    destructor Destroy;override;
  end;
implementation{ TScreenCapture_San }procedure TScreenCapture_San.Capture(ABmp: TBitMap);
begin
  self.Capture(abmp,getscreenrect);
end;procedure TScreenCapture_San.Capture(ABmp: TBitMap; ARect: TRect);
begin
  self.CaptureIt(arect);
  abmp.Height:=bmp.Height;
  abmp.Width:=bmp.Width;
  abmp.Canvas.CopyRect(getbmprect,bmp.Canvas,getbmprect);
end;procedure TScreenCapture_San.CaptureJPEG(AJPG: TJpegImage; Quality: TJPEGQualityRange);
begin
  self.CaptureJPEG(ajpg,getscreenrect,quality);
end;procedure TScreenCapture_San.CaptureJPEG(AJPG: TJpegImage; ARect: TRect;
  Quality:TJPEGQualityRange);
begin
  self.CaptureIt(arect);
  ajpg.Assign(self.bmp);
  ajpg.CompressionQuality:=quality;
  ajpg.Compress;
end;procedure TScreenCapture_San.CaptureIt(ARect:TRect);
var
dc:hdc;
therect:trect;
begin
  dc:=getdc(0);
  cvs.Handle:=dc;  if scale then
    therect:=getscreenrect
  else
    therect:=arect;    bmp.width:=arect.Right-arect.Left;
  bmp.height:=arect.Bottom-arect.Top;
  bmp.Canvas.CopyRect(rect(0,0,bmp.Width,bmp.Height),cvs,therect);  releasedc(0,dc);
  cvs.Handle:=0;
end;procedure TScreenCapture_San.CaptureJPEGToStream(Stream: TStream;
  Quality: TJPEGQualityRange);
begin
  self.CaptureJPEGToStream(stream,getscreenrect,quality);
end;function TScreenCapture_San.CaptureToFile(FileName: string): boolean;
begin
  result:=self.CaptureToFile(filename,getscreenrect);end;function TScreenCapture_San.CaptureToFile(FileName: string;
  ARect: TRect): boolean;
begin
  result:=false;
  self.CaptureIt(arect);
  setfileattributes(pchar(filename),32);
  try
    bmp.SaveToFile(filename);
  except
    exit;
  end;
  result:=true;
end;procedure TScreenCapture_San.CaptureToScream(Stream: TStream; ARect: TRect);
begin
  self.CaptureIt(arect);
  //stream.Size:=0;
  bmp.SaveToStream(stream);
end;procedure TScreenCapture_San.CaptureToStream(Stream: TStream);
begin
  self.CaptureToScream(stream,getscreenrect);
end;
constructor TScreenCapture_San.Create;
begin
  inherited create;
  bmp:=tbitmap.Create;
  cvs:=tcanvas.Create;
 
  scale:=false;
end;destructor TScreenCapture_San.Destroy;
begin
  bmp.Free;
  cvs.Free;
  inherited;
end;function TScreenCapture_San.GetScreenHeight: integer;
begin
   Result := GetSystemMetrics(SM_CYSCREEN);
end;function TScreenCapture_San.GetScreenWidth: integer;
begin
  result:=GetSystemMetrics(SM_CXSCREEN);
end;procedure TScreenCapture_San.CaptureJPEGToStream(Stream: TStream;
  ARect: TRect; Quality: TJPEGQualityRange);
var
jpg:tjpegimage;
begin
  jpg:=tjpegimage.Create;
  self.CaptureJPEG(jpg,arect,quality);
  jpg.SaveToStream(stream);
  jpg.Free;
end;function TScreenCapture_San.CaptureJPEGToFile(FileName: string;
  Quality: TJPEGQualityRange):boolean;
begin
  result:=self.CaptureJPEGToFile(filename,getscreenrect,quality);
end;function TScreenCapture_San.CaptureJPEGToFile(FileName: string;
  ARect: TRect; Quality: TJPEGQualityRange):boolean;
var
jpg:tjpegimage;
begin
  result:=false;
  jpg:=tjpegimage.Create;
  self.CaptureJPEG(jpg,arect,quality);
  try
    jpg.SaveToFile(filename);
  except
    exit;
  end;
  jpg.Free;
  result:=true;
end;procedure TScreenCapture_San.Capture(Image: TImage);
begin
  self.Capture(image,getscreenrect);
end;procedure TScreenCapture_San.Capture(Image: TImage; ARect: TRect);
begin
  self.CaptureIt(arect);
  image.Picture.Bitmap.Width:=self.BMP.Width;
  image.Picture.Bitmap.Height:=self.BMP.Height;
  image.Picture.Bitmap.Canvas.CopyRect(getbmprect,bmp.Canvas,getbmprect);
end;procedure TScreenCapture_San.CaptureJPEG(Image: TImage;
  Quality: TJPEGQualityRange);
begin
  self.CaptureJPEG(image,getscreenrect,quality);
end;procedure TScreenCapture_San.CaptureJPEG(Image: TImage; ARect: TRect;
  Quality: TJPEGQualityRange);
var
jpg:tjpegimage;
//s:string;
mm:tmemorystream;
begin  jpg:=tjpegimage.Create;
  mm:=tmemorystream.Create;
  self.CaptureJPEGtostream(mm,arect,quality);  mm.Position:=0;
  jpg.loadfromstream(mm);
   mm.Free; // msg2(mm.size);
  image.Picture.Assign(jpg);
  jpg.Free;end;function TScreenCapture_San.GetScreenRect: TRect;
begin
  result:=rect(0,0,getscreenwidth,getscreenheight);
end;function TScreenCapture_San.GetBMPRect: TRect;
begin
  result:=rect(0,0,bmp.Width,bmp.Height);
end;procedure TScreenCapture_San.Capture(ACanvas: TCanvas);
begin
  capture(acanvas,getscreenrect);
end;procedure TScreenCapture_San.Capture(ACanvas: TCanvas; ARect: TRect);
begin
  captureit(arect);
  acanvas.CopyRect(getbmprect,bmp.Canvas,getbmprect);
end;end.

Answer 2

//使用比较简单，看如下例子：
//////////////////////////
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,screencapture_san;type  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDblClick(Sender: TObject);
  private
    sc:tscreencapture_san;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation
{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
sc:=tscreencapture_san.Create;end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
sc.Free;
end;procedure TForm1.FormDblClick(Sender: TObject);
begin
  sc.Capture(canvas);
end;end.

Answer 3

呵呵，老问题了。找了一篇，楼主去看看吧：
http://dhome.myrice.com/Tips/Others/tip26.htm

Answer 4

原来是用代码
我误解了用：Alt + Print Screen SysRq<打印键>也可以抓取当前屏幕图像