unit2.pas

你用此软件,你可以把窗口中的的任何图像抓取下来.你还可以为抓取下来的图像保存成为任何一种格式.

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Timer1: TTimer;
    Image1: TImage;
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  foldx,foldy,oldx,oldy,x1,x2,y1,y2:integer;
  flag,trace:boolean;
implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.Timer1Timer(Sender: TObject);
var
 fullscreen:Tbitmap;
 fullscreenCanvas:TCanvas;
 dc:HDC;
begin
  Timer1.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);
  image1.Picture.Bitmap:=fullscreen;
  image1.Width:=fullscreen.Width;
  image1.Height:=fullscreen.Height;
  fullscreen.Free;
  Form2.WindowState:=wsNormal;
  form2.Show;
  messagebeep(1);
  foldx:=-1;
  foldy:=-1;
  image1.Canvas.Pen.Mode:=pmnot;
  image1.Canvas.Pen.Color:=clblack;
  image1.Canvas.brush.Style:=bsclear;
  flag:=true;
end;


procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
  width,height:integer;
  newbitmap:Tbitmap;
  begin
  if trace=false then
   begin
     flag:=false;
     with image1.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;
   image1.Canvas.Pen.Mode:=pmnot;
   image1.Canvas.Pen.color:=clblack;
   image1.Canvas.brush.Style:=bsClear;
   end
   else
   begin
   x2:=x;
   y2:=y;
   trace:=false;
   image1.Canvas.rectangle(x1,y1,oldx,oldy);
   width:=abs(x2-x1);
   height:=abs(y2-y1);
   form1.Image1.Width:=width;
   form1.Image1.Height:=height;
   newbitmap:=Tbitmap.create;
   newbitmap.Width:=width;
   newbitmap.Height:=height;
   newbitmap.Canvas.CopyRect(Rect(0,0,width,Height) ,
   form2.Image1.Canvas,Rect(x1,y1,x2,y2));
   form1.Image1.Picture.bitmap:=newbitmap;
   newbitmap.Free;
   form2.Hide;
   form1.Show;
   end;
  end;


procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if trace=true then
 begin
  with image1.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 image1.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;

end.