程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 一個實用的Delphi屏幕拷貝程序的設計

一個實用的Delphi屏幕拷貝程序的設計

編輯：Delphi

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 ！
　　