本例要使用Delphi制作一個抓圖程序，有的叫抓屏或截屏，你可以通過鼠標點擊“全屏拷貝”按鈕，將當前桌面拷貝下來，在程序的窗體上顯示出來；點擊“局部抓圖”按鈕，可以用鼠標選擇要抓圖的區域，並將其在窗體上顯示出來；點擊“保存圖像”按鈕，可以保存抓取的圖像文件；點擊“退出”按鈕，可以退出該程序。本抓圖程序運行界面如下圖所示。
設計思想：畫布（Canvas）對象封裝了Windows 的大部分圖形圖像輸出功能，這使得我們可以通過它以更直觀的方式和Windows 的屏幕打交道，而不必關心令人頭疼的Windows API 函數。
設計步驟：要編寫一個實用的抓圖程序，我們需要考慮三個問題：第一，全屏幕拷貝的實現，首先隱藏拷屏程序，延長一定時間後，利用相關代碼實現屏幕的拷貝；第二，實現區域拷貝要用個小技巧，首先調用全屏幕拷貝程序把整個屏幕拷貝下來，然後把拷貝下來的圖像顯示在屏幕上，之後就可以讓用戶在上面選擇需要的區域，最後才將用戶選定的區域復制下來；第三，要實現保存圖像文件功能，能夠將抓取的圖像保存到需要的位置。
1．新建工程
（1）啟動Delphi 6.0 程序。選擇“文件”菜單下的“新建”命令，從彈出的子菜單中選擇Application 選項，則出現新建工程的Form1 窗口。
（2）選擇“文件”菜單下的“工程另存為”命令，彈出Save Unit1 As 對話框。在“保存在”列表框中選擇需要存放該窗口文件所在的目錄名；在“文件名”編輯框中填寫文件名，這裡填寫“Unit1”，點擊“保存”按鈕，保存上面的選項。
（3）執行上一步後，將彈出“工程另存為”對話框。在“保存在”列表框中選擇需要存放該工程的目錄名，最好和第（2）步選取相同的目錄；在“文件名”編輯框中填寫保存處理該工程的源代碼的文件名，這裡填寫“Project1”，點擊“保存”按鈕，保存上面的選項。
2．修改窗口
（1）激活Unit1 窗口，在“屬性”面板中設置該窗體的Caption 屬性為“抓圖程序”，Name 屬性為“Form1”。
（2）選擇“標准”頁上的Panel 選項，在窗體中添加1 個Panel 控件。在“屬性”面板中設置“對齊”屬性為“alTop”。
（3）選擇Additional 頁上的Scrollbox 選項，在Form1 上添加一個Scrollbox 控件，在Object Inspecter 面板中設置其Align 屬性為“alClIEnt”。
（4）選擇“附加”頁上的Image 選項，在Scrollbox 控件中添加一個Image 控件，在Object Inspecter 面板中設置其Align 屬性為“alClIEnt”。
（5）選擇Addtional 頁上的BitBtn 選項，在Panel 控件上添加4 個BitBtn 控件，在“屬性”面板中設置其Caption 屬性分別為“全屏拷貝”、“局部抓圖”、“保存圖像”和“退出”，用鼠標點擊Glyph 屬性右邊的按鈕，從彈出的對話框中選擇合適的文件作為這些控件的圖標。
（6）還需要為窗體添加一個Timer 控件和一個SavePictureDialog 控件。
Delphi實戰抓圖程序代碼分析：
（1）實現退出事件最簡單，代碼如下：
procedure TForm1.BitBtn4Click(Sender: TObject); begin close; end;
（2）接著需要實現全屏拷貝，在Form 上我們放置了一個Timer 控件，在“屬性”面板中設置其Enable 屬性為“False”，Interval 屬性為500，也就是半秒鐘激活一次，雙擊Timer 控件，寫入下面的代碼：
procedure TForm1.Timer1Timer(Sender: TObject); var Fullscreen:Tbitmap; FullscreenCanvas:TCanvas; dc:HDC; begin Timer1.Enabled:=False; //取消時鐘 Fullscreen := Tbitmap.Create; //創建一個BITMAP 來存放圖像 Fullscreen.Width := screen.Width; Fullscreen.Height := screen.Height; DC := GetDC (0); //取得屏幕的 DC，參數0 指的是屏幕 FullscreenCanvas := TCanvas.Create; //創建一個CANVAS 對象 FullscreenCanvas.Handle := DC; Fullscreen.Canvas.CopyRect (Rect (0, 0, screen.Width, screen.Height), fullscreenCanvas, Rect (0, 0, Screen.Width, Screen.Height));//把整個屏幕復制到BITMAP 中 FullscreenCanvas.Free; //釋放CANVAS 對象 ReleaseDC (0, DC); //釋放DC Image1.picture.Bitmap:=fullscreen;//拷貝下的圖像賦給IMAGE 對象 Image1.Width:=fullscreen.Width; Image1.Height:=fullscreen.Height; fullscreen.free; //釋放BITMAP Form1.Windowstate:=wsNormal; //復原窗口狀態 Form1.show; //顯示窗口 messagebeep(1); //BEEP 叫一聲，報告圖像已經截取好了 end;
（3）這時編寫點擊“全屏拷貝”按鈕事件的代碼就很簡單了：
procedure TForm1.BitBtn1Click(Sender: TObject); begin Form1.Windowstate:=wsMinimized; //最小化程序窗口 Form1.hide; //把程序藏起來 Timer1.Enabled:=true; //打開計時器 end;
（4）拷貝了圖像，當然要保存起來，SavePictureDialog 控件就有了用武之地，“保存圖像”按鈕的點擊事件相應代碼如下編寫：
procedure TForm1.BitBtn3Click(Sender: TObject); begin if savePicturedialog1.Execute then begin Form1.Image1.Picture.SaveToFile(savepicturedialog1.FileName)//保存圖像文件 end; end;
（5）在窗體初始化時，我們指定了保存圖像的位置和保存圖像對話框的相關屬性，代碼如下：
procedure TForm1.FormCreate(Sender: TObject); begin Form1.SavePictureDialog1.title:=’保存抓取的圖像文件’;//保存對話框標題 Form1.SavePictureDialog1.InitialDir:=’C:\My Documents\My Pictures’;//設置初始保存路徑 end;
（6）下面需要實現局部區域的拷貝。我們需要新建一個窗體。選擇“文件”菜單下的“新建”命令，從彈出的子菜單中選擇Form，設置其BorderStyle 為“bsNone”，這樣能夠顯示為全屏幕，再在上面放置一個Image 控件，Align 屬性設置為“alClIEnt”，另外我們還需要在窗體上添加一個Timer 控件，Timer 控件的程序跟上面的很像，因為它首先要實現的是全屏幕的拷貝。
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), fullscreen Canvas,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:=wsMaximized; 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;
（7）Image 控件上有兩個事件的程序需要編寫，一個是OnMouseDown，另一個是OnMouseMove。可以回頭看看區域拷貝的思路，此時需要作區域拷貝的屏幕我們已經得到，也顯示在屏幕上了，按下鼠標左鍵是區域的原點，此後移動鼠標，將有一個矩形在原點和鼠標之間，它會隨著鼠標的移動而變化，再次按下鼠標的左鍵，此時矩形所包含的區域就是我們要得到的圖像了。所以OnMouseDown 有兩次響應的處理，見以下程序：
procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Width,Height:integer; newbitmap:Tbitmap; begin if (trace=False) then // trace 表示是否在追蹤鼠標 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 //第二次點擊，表示已經得到矩形了，把它拷貝到Form1 中的Image部件上 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; //放到Form 的Image 上 newbitmap.free; Form2.hide; Form1.show; end; end;
（8）MouseMove 的處理就是在原點和鼠標當前位置之間不斷地畫矩形和擦除矩形：
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;
（9）這時我們就可以編寫“局部抓圖”事件的代碼了：
procedure TForm1.BitBtn2Click(Sender: TObject); begin Form1.Hide; Form2.hide;//隱藏Form1,Form2 Form2.Timer1.Enabled:=true;//計時器開始工作 end;
Delphi抓圖程序完整代碼：
Unit1 代碼：
01
unit Unit1;
02
interface
03
uses
04
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
05
Dialogs, ExtDlgs, ExtCtrls, StdCtrls, Buttons;
06
type
07
TForm1 = class(TForm)
08
Panel1: TPanel;
09
ScrollBox1: TScrollBox;
10
Image1: TImage;
11
BitBtn1: TBitBtn;
12
BitBtn2: TBitBtn;
13
BitBtn3: TBitBtn;
14
BitBtn4: TBitBtn;
15
Timer1: TTimer;
16
SavePictureDialog1: TSavePictureDialog;
17
procedure BitBtn4Click(Sender: TObject);
18
procedure Timer1Timer(Sender: TObject);
19
procedure BitBtn1Click(Sender: TObject);
20
procedure BitBtn3Click(Sender: TObject);
21
procedure BitBtn2Click(Sender: TObject);
22
procedure FormCreate(Sender: TObject);
23
private
24
{ Private declarations }
25
public
26
{ Public declarations }
27
end;
28
var
29
Form1: TForm1;
30
implementation
31
uses Unit2;
32
{$R *.dfm}
33
procedure TForm1.BitBtn4Click(Sender: TObject);
34
begin
35
close;
36
end;
37
procedure TForm1.Timer1Timer(Sender: TObject);
38
var
39
Fullscreen:Tbitmap;
40
FullscreenCanvas:TCanvas;
41
dc:HDC;
42
begin
43
Timer1.Enabled:=False; //取消時鐘
44
Fullscreen := Tbitmap.Create; //創建一個BITMAP 來存放圖像
45
Fullscreen.Width := screen.Width;
46
Fullscreen.Height := screen.Height;
47
DC := GetDC (0); //取得屏幕的 DC，參數0 指的是屏幕
48
FullscreenCanvas := TCanvas.Create; //創建一個CANVAS 對象
49
FullscreenCanvas.Handle := DC;
50
Fullscreen.Canvas.CopyRect
51
(Rect (0, 0, screen.Width, screen.Height), fullscreenCanvas,
52
Rect (0, 0, Screen.Width, Screen.Height));//把整個屏幕復制到BITMAP 中
53
FullscreenCanvas.Free; //釋放CANVAS 對象
54
ReleaseDC (0, DC); //釋放DC
55
Image1.picture.Bitmap:=fullscreen;//拷貝下的圖像賦給IMAGE 對象
56
Image1.Width:=fullscreen.Width;
57
Image1.Height:=fullscreen.Height;
58
fullscreen.free; //釋放BITMAP
59
Form1.Windowstate:=wsNormal; //復原窗口狀態
60
Form1.show; //顯示窗口
61
messagebeep(1); //BEEP 叫一聲，報告圖像已經截取好了。
62
end;
63
procedure TForm1.BitBtn1Click(Sender: TObject);
64
begin
65
Form1.Windowstate:=wsMinimized; //最小化程序窗口
66
Form1.hide; //把程序藏起來
67
Timer1.Enabled:=true; //打開計時器
68
end;
69
procedure TForm1.BitBtn3Click(Sender: TObject);
70
begin
71
if savePicturedialog1.Execute then
72
begin
73
Form1.Image1.Picture.SaveToFile(savepicturedialog1.FileName)//保存圖像文件
74
end;
75
end;
76
procedure TForm1.BitBtn2Click(Sender: TObject);
77
begin
78
Form1.Hide;
79
Form2.hide;//隱藏Form1,Form2
80
Form2.Timer1.Enabled:=true;//計時器開始工作
81
end;
82
procedure TForm1.FormCreate(Sender: TObject);
83
begin
84
Form1.SavePictureDialog1.title:=’保存抓取的圖像文件’;//保存對話框標題
85
Form1.SavePictureDialog1.InitialDir:=’C:\My Documents\My Pictures’;//設置初始保存路徑
86
end;
87
end.
Unit2 代碼：
vIEw source
