Delphi经典实例4------区域抓取和屏幕抓取

1.区域抓取：

如下图所示建立工程：

代码如下：

unit mainunit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls,ShellApi; type TForm1 = class(TForm) Image1: TImage; Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Button2Click(Sender: TObject); private { Private declarations } public procedure CaptureParScr(StartPoint,EndPoint:TPoint); { Public declarations } end; var Form1: TForm1; ClickCount:Integer; StartPoint,EndPoint:TPoint; implementation {$R *.dfm} procedure CopyCurrentDesktop(IncludeCur:Boolean); var DesktophWnd:hWnd; DesktopDC:hWnd; CursorhWnd:hWnd; CurPos:Tpoint; Rect:TRect; Bitmap:TBitmap; begin DesktophWnd := GetDesktopWindow(); DesktopDC := GetDC(DesktophWnd); GetWindowRect(DesktophWnd, Rect); if IncludeCur then begin CursorhWnd:=GetCursor(); //捕获当前鼠标指针句柄 GetCursorPos(CurPos); end; //获取当前鼠标指针的位置坐标 Bitmap := TBitmap.Create;//生成一个Tbitmap类型的实例对象 Bitmap.Width := Rect.Right-Rect.Left; Bitmap.Height := Rect.Bottom-Rect.Top; BitBlt(Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, DesktopDC, 0, 0, SRCCOPY); //在抓取到的位图对象上绘制鼠标 if IncludeCur then DrawIcon(Bitmap.Canvas.Handle, CurPos.X, CurPos.Y, CursorhWnd); ReleaseDC(DesktophWnd, DesktopDC); Bitmap.SaveToFile('C:/Desktop.bmp'); //使用类方法SaveToFile保存文件 Bitmap.Free; end; procedure TForm1.CaptureParScr(StartPoint,EndPoint:TPoint); var Bitmap:TBitmap; begin Bitmap := TBitmap.Create;//生成一个Tbitmap类型的实例对象 Bitmap.Width := Abs(StartPoint.x-EndPoint.x); Bitmap.Height := Abs(StartPoint.y-EndPoint.y); bitblt(BitMap.Canvas.Handle,0,0,Bitmap.Width, Bitmap.Height, Image1.Canvas.Handle, StartPoint.x, StartPoint.y, SRCCOPY); Bitmap.SaveToFile('C:/PartDesktop.bmp'); //使用类方法SaveToFile保存文件 Bitmap.Free; Button2.Click; Form1.Close; end; procedure TForm1.Button1Click(Sender: TObject); begin Form1.Button2.Enabled:=False; if MessageDlg('是否连同鼠标指针一起抓取?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin CopyCurrentDesktop(True); end else begin CopyCurrentDesktop(False); end; Button1.Visible:=False; Button2.Visible:=False; Form1.Left:=0; Form1.Top:=0; Form1.Width:=Screen.Width; Form1.Height:=Screen.Height; Form1.BorderStyle:=bsNone; Form1.Image1.Left:=0; Form1.Image1.Top:=0; Form1.Image1.Width:=Screen.Width; Form1.Image1.Height:=Screen.Height; ShowMessage('请您在此用鼠标选择要拷贝的屏幕区域起点和终点!'); Form1.Image1.Picture.LoadFromFile('C:/Desktop.bmp'); ClickCount:=0; Form1.Image1.Enabled:=True; end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin ClickCount:=ClickCount+1; if ClickCount=1 then begin StartPoint.X:=X; StartPoint.Y:=Y; ShowMessage('您已经选择了区域起点坐标!请继续选择区域终点坐标.'); end; if ClickCount=2 then begin EndPoint.X:=X; EndPoint.Y:=Y; if MessageDlg('您已经选择了区域终点坐标,是否抓取由这两点决定的区域?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin ClickCount:=0; CaptureParScr(StartPoint,EndPoint); Form1.Image1.Enabled:=False; end else ClickCount:=0; end; end; procedure TForm1.Button2Click(Sender: TObject); begin ShellExecute(handle,'open','C:/PartDesktop.bmp',nil,nil,SW_Normal); end; end.

 

2.屏幕抓取：

如下所示建立工程：

代码如下：

unit mainunit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,ShellApi; type TForm1 = class(TForm) GroupBox1: TGroupBox; RadioButton1: TRadioButton; RadioButton2: TRadioButton; Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure CopyCurrentDesktop(IncludeCur:Boolean); var DesktophWnd:hWnd; DesktopDC:hWnd; CursorhWnd:hWnd; CurPos:Tpoint; Rect:TRect; Bitmap:TBitmap; begin DesktophWnd := GetDesktopWindow(); DesktopDC := GetDC(DesktophWnd); GetWindowRect(DesktophWnd, Rect); if IncludeCur then begin CursorhWnd:=GetCursor(); //捕获当前鼠标指针句柄 GetCursorPos(CurPos); end; //获取当前鼠标指针的位置坐标 Bitmap := TBitmap.Create;//生成一个Tbitmap类型的实例对象 Bitmap.Width := Rect.Right-Rect.Left; Bitmap.Height := Rect.Bottom-Rect.Top; BitBlt(Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, DesktopDC, 0, 0, SRCCOPY); //在抓取到的位图对象上绘制鼠标 if IncludeCur then DrawIcon(Bitmap.Canvas.Handle, CurPos.X, CurPos.Y, CursorhWnd); ReleaseDC(DesktophWnd, DesktopDC); Bitmap.SaveToFile('C:/Desktop.bmp'); //使用类方法SaveToFile保存文件 Bitmap.Free; ShowMessage('成功抓取屏幕并保存图像至C:/Desktop.bmp文件!'); end; procedure TForm1.Button1Click(Sender: TObject); begin Button2.Enabled:=False; if RadioButton1.Checked then CopyCurrentDesktop(True) else CopyCurrentDesktop(False); Button2.Enabled:=True; end; procedure TForm1.Button2Click(Sender: TObject); begin ShellExecute(handle,'open','C:/Desktop.bmp',nil,nil,SW_Normal); end; end.