Borland 公司（ 現改名為INPRISE 公司） 的DELPHI 是目前最方便的Windows 程式設
計工具之一。 許多人以為DELPHI 是作為資料庫開發工具出現的， 其實用DELPHI
可以以極快的速度開發出高效率的Windows 程式。
現在我們就用DELPHI 來寫一個實用的螢幕拷貝程式。 瞧瞧， 下面的畫面
就是所編程式運作後進行區域螢幕拷貝的例子， 還不錯吧！
Borland 公司的天才設計師們用畫布（Tcanvas） 物件封裝了Windows 的大部分圖形
輸出功能， 這使得我們可以透過他以更直觀的方式和Windows 的螢幕打交道，
而不必關心令人頭痛的Windows API 函數。 下面的一小段程式就可以實現整個
螢幕的圖象拷貝了。
var //變數聲明
Fullscreen:Tbitmap;
FullscreenCanvas:TCanvas;
dc:HDC;
//------------------------------------------------ ------------
DC := GetDC (0); //取得螢幕的DC，參數0指的是螢幕
FullscreenCanvas := TCanvas.Create; //建立一個CANVAS對象
FullscreenCanvas.Handle := DC; //將螢幕的DC賦給HANDLE
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
//SCREEN物件是DELPHI預先定義的螢幕對象，直接使用就行了。
看了以上程式碼， 你會發現用DELPHI 寫螢幕拷貝程式的確很簡單。
當然要寫一個實用的螢幕拷貝程序， 光靠上述代碼是不夠的， 下面講一
下主要的編程思路：
1. 全螢幕拷貝的實現
首先隱藏拷問程序， 延長一定時間後， 利用上述的程序即可實現螢幕的
拷貝。
2. 區域拷貝的實現
要實現區域拷貝要用個小技巧， 首先呼叫全螢幕拷貝程式把整個螢幕拷貝
貝下來， 然後把拷貝下來的圖象顯示在螢幕上， 之後就可以讓使用者在上面
選擇需要的區域， 最後才將使用者選定的區域複製下來。
程式實現：
1. 先用DELPHI3 開工程。
2. 在FORM 上放置一個TPANEL 元件， 設定ALIGN=ALTOP， 再選零件條ADDITIONAL 上
的TSCROLLBOX， 放到FORM 上， 設定ALIGN=ALCLIENT， 然後在SCROLLBOX 上放置一個
TIMAGE 物件。
3. 在PANEL 上放置4 個按鈕， 分別為FULL SCREEN，REGIN，SAVE，EXIT。
4. 容易乾的先乾， 在EXIT 按鈕的CLICK 事件裡寫下程式碼
procedure TForm1.ExitClick(Sender: TObject);
begin
close;
end;
5. 接著是實現全螢幕拷貝了， 在FROM 上放置一個記時器TTIMER，ENABLED 設為
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;
6. 接下去FULLSCREEN 按鈕上的程式碼就很簡單了。
procedure TForm1.FullscreenClick(Sender: TObject);
begin
form1.WindowState:=wsMinimized; //最小化程式視窗
form1.hide; //把程式藏起來
timer1.enabled:=true; //開啟記時器
end;
7. 拷貝到了圖象當然要存起來了，SAVE 按鈕就有了用武之地， 我們寫下如
下代碼。
procedure TForm1.Save1Click(Sender: TObject);
begin
if savedialog1.Execute then
begin
form1.Image1.Picture.SaveToFile(savedialog1.filename)
end;
end;
8. 下面是區域拷貝的實作。 再New 一個FORM,BorderStype 設為bsNone, 這樣能夠顯示
為全螢幕， 上方放置一個TIMAGE 部件，ALIGN 設為ALCLIENT， 另外放置一個TTIMER
部件，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), 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:=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;
9.TIMAGE 部件上有兩個事件的程式要寫， 一個是ONMOUSEDOWN， 另一個
是ONMOUSEMOVE。
10. 可以回頭看看區域拷貝的思路， 此時需要作區域拷貝的屏幕我們已經
得到， 也顯示在螢幕上了， 按下滑鼠左鍵是區域的原點， 此後移動滑鼠， 將
有一個矩形在原點和滑鼠之間， 它會隨著滑鼠的移動而變化， 再次按下老鼠
標的左鍵， 此時矩形所包含的區域就是我們要得到的圖象了。
11. 所以MOUSEDOWN 有兩次回應的處理， 請看以下程序。
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;
12.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;
13. 好了， 讓我們回過頭來寫REGION 按鈕的程式碼。
procedure TForm1.RegionClick(Sender: TObject);
begin
form1.Hide;
form2.hide;
form2.Timer1.Enabled:=true;
end;
好了， 我們終於勝利完工了， 趕快運行一遍， 把漂亮的屏幕拷下來！ 瞧
DELPHI 不僅是優秀的資料庫開發工具， 而且是優秀的編寫WINDOWS
程序的好幫手。 讓我們不禁讚歎： 偉大的DELPHI ！
寧波市遊河巷賈學傑