var //變量聲明
Fullscreen:Tbitmap;
FullscreenCanvas:TCanvas;
dc:HDC;
//------------------------------------------------------------
DC := GetDC (0); //取得屏幕的 DC，參數(shù)0指的是屏幕
FullscreenCanvas := TCanvas.Create; //創(chuàng)建一個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預(yù)先定義的屏幕對象，直接使用就行了。

---- 看 了 以 上 代 碼， 你 就 會 發(fā) 現(xiàn) 用DELPHI 寫 屏 幕 拷 貝 程 序 的 確 很 簡 單。

---- 當 然 要 寫 一 個 實 用 的 屏 幕 拷 貝 程 序， 光 靠 上 述 代 碼 是 不 夠 的， 下 面 講 一
下 主 要 的 編 程 思 路：

---- 1. 全 屏 幕 拷 貝 的 實 現(xiàn)

---- 首 先 隱 藏 拷 屏 程 序， 延 長 一 定 時 間 后， 利 用 上 述 的 程 序 即 可 實 現(xiàn) 屏 幕 的
拷 貝。

---- 2. 區(qū) 域 拷 貝 的 實 現(xiàn)

---- 要 實 現(xiàn) 區(qū) 域 拷 貝 要 用 個 小 技 巧， 首 先 調(diào) 用 全 屏 幕 拷 貝 程 序 把 整 個 屏 幕 拷
貝 下 來， 然 后 把 拷 貝 下 來 的 圖 象 顯 示 在 屏 幕 上， 之 后 就 可 以 讓 用 戶 在 上 面
選 擇 需 要 的 區(qū) 域， 最 后 才 將 用 戶 選 定 的 區(qū) 域 復 制 下 來。

---- 編 程 實 現(xiàn)：

---- 1. 首 先 用DELPHI3 開 一 個 工 程。

---- 2. 在FORM 上 放 置 一 個TPANEL 元 件， 設(shè) 置ALIGN=ALTOP， 再 選 部 件 條ADDITIONAL 上
的TSCROLLBOX， 放 到FORM 上， 設(shè) 置ALIGN=ALCLIENT， 然 后 在SCROLLBOX 上 放 置 一 個
TIMAGE 對 象。

---- 3. 在PANEL 上 放 置4 個 按 鈕， 分 別 為FULL SCREEN，REGIN，SAVE，EXIT。

---- 4. 容 易 干 的 先 干， 在EXIT 按 鈕 的CLICK 事 件 里 寫 下 代 碼

procedure TForm1.ExitClick(Sender: TObject);
begin
close;
end;
---- 5. 接 著 是 實 現(xiàn) 全 屏 幕 拷 貝 了， 在FROM 上 放 置 一 個 記 時 器TTIMER，ENABLED 設(shè) 為
FALSE，INTERVAL 設(shè) 為500， 也 就 是 半 秒 鐘 激 活 一 次。 雙 擊TIMER 部 件， 寫 上 如 下 的
代 碼。

procedure TForm1.Timer1Timer(Sender: TObject);
var
Fullscreen:Tbitmap;
FullscreenCanvas:TCanvas;
dc:HDC;
begin
timer1.Enabled:=false; //取消時鐘
Fullscreen := TBitmap.Create; //創(chuàng)建一個BITMAP來存放圖象
Fullscreen.Width := screen.width;
Fullscreen.Height := screen.Height;
DC := GetDC (0); //取得屏幕的 DC，參數(shù)0指的是屏幕
FullscreenCanvas := TCanvas.Create; //創(chuàng)建一個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; //復原窗口狀態(tài)
form1.show; //顯示窗口
messagebeep(1); //BEEP叫一聲，報告圖象已經(jīng)截取好了。
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. 下 面 是 區(qū) 域 拷 貝 的 實 現(xiàn)。 再New 一 個FORM,BorderStype 設(shè) 為 bsNone, 這 樣 能 夠 顯 示
為 全 屏 幕， 上 面 放 置 一 個TIMAGE 部 件，ALIGN 設(shè) 為ALCLIENT， 另 外 放 置 一 個TTIMER
部 件，TIMER 部 件 的 程 序 跟 上 面 的 很 象， 因 為 它 首 先 要 實 現(xiàn) 的 是 全 屏 幕 的 拷
貝。

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. 可 以 回 頭 看 看 區(qū) 域 拷 貝 的 思 路， 此 時 需 要 作 區(qū) 域 拷 貝 的 屏 幕 我 們 已 經(jīng)
得 到， 也 顯 示 在 屏 幕 上 了， 按 下 鼠 標 左 鍵 是 區(qū) 域 的 原 點， 此 后 移 動 鼠 標， 將
有 一 個 矩 形 在 原 點 和 鼠 標 之 間， 它 會 隨 著 鼠 標 的 移 動 而 變 化， 再 次 按 下 鼠
標 的 左 鍵， 此 時 矩 形 所 包 含 的 區(qū) 域 就 是 我 們 要 得 到 的 圖 象 了。

---- 11. 所 以MOUSEDOWN 有 兩 次 響 應(yīng) 的 處 理， 見 以 下 程 序。

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 //第二次點擊，表示已經(jīng)得到矩形了，
//把它拷貝到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 不 僅 是 一 個 優(yōu) 秀 的 數(shù) 據(jù) 庫 開 發(fā) 工 具， 而 且 是 一 個 優(yōu) 秀 的 編 寫WINDOWS
程 序 的 好 幫 手。 讓 我 們 不 禁 贊 嘆： 偉 大 的DELPHI ！