unit1.~pas

电脑上抓取当前屏幕的一个小程序

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    Image1: TImage;
    SaveDialog1: TSavePictureDialog;
    Panel2: TPanel;
    Button1: TButton;
    Button3: TButton;
    Button4: TButton;
    Button2: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure Button4Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.DFM}

procedure TForm1.Button4Click(Sender: TObject);
begin
  // 关闭程序  
  close;
end;

//抓取屏幕，并保存到Image控件中
procedure TForm1.Timer1Timer(Sender: TObject);
var
  Fullscreen:Tbitmap;
  FullscreenCanvas:TCanvas;
  dc:HDC;
begin
  //取消时钟
  timer1.Enabled:=false;
  //创建一个BITMAP来存放图象  
  Fullscreen:=TBitmap.Create;
  Fullscreen.Width:=screen.width;
  Fullscreen.Height:=screen.Height;
  //取得屏幕的DC，参数0指的是屏幕  
  DC:=GetDC(0);
  //创建一个CANVAS对象  
  FullscreenCanvas:=TCanvas.Create;
  FullscreenCanvas.Handle:=DC;
  
  //把整个屏幕复制到BITMAP中
  Fullscreen.Canvas.CopyRect
  (Rect(0,0,screen.Width,screen.Height),fullscreenCanvas,
  Rect(0,0,Screen.Width,Screen.Height));
  //释放CANVAS对象
  FullscreenCanvas.Free;
  //释放DC
  ReleaseDC(0,DC);

  //拷贝下的图象赋给IMAGE对象
  image1.picture.Bitmap:=fullscreen;
  //指定图片大小
  image1.Width:=fullscreen.Width;
  image1.Height:=fullscreen.Height;
  //释放bitmap
  fullscreen.free;
  //复原窗口状态
  form1.WindowState:=wsNormal;
  //显示窗口  
  form1.show;
  //BEEP叫一声，报告图象已经截取好了。   
  messagebeep(1);
end;

procedure TForm1.Button1Click(Sender: TObject); //全屏抓图
begin
  //最小化程序窗口
  form1.WindowState:=wsMinimized;
  //把主窗口藏起来
  form1.hide;
  //打开记时器
  timer1.enabled:=true;
end;

procedure TForm1.Button3Click(Sender: TObject); //保存图片
begin
if savedialog1.Execute then
begin
  form1.Image1.Picture.SaveToFile(savedialog1.filename)
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Image1.Picture.SaveToFile('c:\1.bmp');
   Form2.show;
end;

procedure Convert2Gray(Cnv: TCanvas);
var X, Y: Integer;
  Color: LongInt;
  R, G, B, Gr : Byte;
begin
  with Cnv do
    for X := Cliprect.Left to Cliprect.Right do
      for Y := Cliprect.Top to Cliprect.Bottom do
      begin
        Color := ColorToRGB(Pixels[X, Y]);
        B := (Color and $FF0000) shr 16;
        G := (Color and $FF00) shr 8;
        R := (Color and $FF);
        Gr := HiByte(R * 77 + G * 151 + B * 28);
        // Gr := Trunc(B*0.11+G*0.59+R*0.3);
        Pixels[X, Y] := RGB(Gr, Gr, Gr);
      end;

end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  Convert2Gray(Image1.Picture.Bitmap.Canvas);
  Screen.Cursor := crDefault;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
   Image1.Picture.SaveToFile('c:\1.bmp');
   Form3.show;
end;

end.