熱點推薦:
您现在的位置: 電腦知識網 >> 編程 >> Delphi編程 >> 正文

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

2022-06-13   來源: Delphi編程 

  Borland 公 司( 現 改 名 為INPRISE 公 司) 的DELPHI 是 當 前 最 為 方 便 的Windows 程 序 設計 工 具 之 一 許 多 人 以 為DELPHI 是 作 為 數 據 庫 開 發 工 具 出 現 的 其 實 用DELPHI可 以 以 極 快 的 速 度 開 發 出 高 效 的Windows 程 序

  現 在 我 們 就 用DELPHI 來 編 寫 一 個 實 用 的 屏 幕 拷 貝 程 序

  Borland 公 司 的 天 才 設 計 師 們 用 畫 布(Tcanvas) 對 象 封 裝 了Windows 的 大 部 分 圖 形輸 出 功 能 這 使 得 我 們 可 以 通 過 他 以 更 直 觀 的 方 式 和Windows 的 屏 幕 打 交 道而 不 必 關 心 令 人 頭 疼 的Windows API 函 數 下 面 的 一 小 段 程 序 就 可 以 實 現 整 個屏 幕 的 圖 象 拷 貝 了

  var //變量聲明

  Fullscreen:Tbitmap;

  FullscreenCanvas:TCanvas;

  dc:HDC;

  DC := GetDC (); //取得屏幕的 DC參數指的是屏幕

  FullscreenCanvas := TCanvasCreate; //創建一個CANVAS對象

  FullscreenCanvasHandle := DC; //將屏幕的DC賦給HANDLE

  FullscreenCanvasCopyRect (Rect ( screenWidthscreenHeight)

  fullscreenCanvasRect ( ScreenWidth ScreenHeight));

  //把整個屏幕復制到BITMAP中

  FullscreenCanvasFree; //釋放CANVAS對象

  ReleaseDC ( DC); //釋放DC

  //SCREEN對象是DELPHI預先定義的屏幕對象直接使用就行了

  看 了 以 上 代 碼 你 就 會 發 現 用DELPHI 寫 屏 幕 拷 貝 程 序 的 確 很 簡 單 當 然 要 寫 一 個 實 用 的 屏 幕 拷 貝 程 序 光 靠 上 述 代 碼 是 不 夠 的 下 面 講 一下 主 要 的 編 程 思 路

   全 屏 幕 拷 貝 的 實 現

  首 先 隱 藏 拷 屏 程 序 延 長 一 定 時 間 後 利 用 上 述 的 程 序 即 可 實 現 屏 幕 的拷 貝

   區 域 拷 貝 的 實 現

  要 實 現 區 域 拷 貝 要 用 個 小 技 巧 首 先 調 用 全 屏 幕 拷 貝 程 序 把 整 個 屏 幕 拷貝 下 來 然 後 把 拷 貝 下 來 的 圖 象 顯 示 在 屏 幕 上 之 後 就 可 以 讓 用 戶 在 上 面選 擇 需 要 的 區 域 最 後 才 將 用 戶 選 定 的 區 域 復 制 下 來

  編 程 實 現

   首 先 用DELPHI 開 一 個 工 程

   在FORM 上 放 置 一 個TPANEL 元 件 設 置ALIGN=ALTOP 再 選 部 件 條ADDITIONAL 上的TSCROLLBOX 放 到FORM 上 設 置ALIGN=ALCLIENT 然 後 在SCROLLBOX 上 放 置 一 個TIMAGE 對 象

   在PANEL 上 放 置 個 按 鈕 分 別 為FULL SCREENREGINSAVEEXIT

   容 易 干 的 先 干 在EXIT 按 鈕 的CLICK 事 件 裡 寫 下 代 碼

  procedure TFormExitClick(Sender: TObject);

  begin

  close;

  end;

   接 著 是 實 現 全 屏 幕 拷 貝 了 在FROM 上 放 置 一 個 記 時 器TTIMERENABLED 設 為FALSEINTERVAL 設 為 也 就 是 半 秒 鐘 激 活 一 次 雙 擊TIMER 部 件 寫 上 如 下 的代 碼

  procedure TFormTimerTimer(Sender: TObject);

  var

  Fullscreen:Tbitmap;

  FullscreenCanvas:TCanvas;

  dc:HDC;

  begin

  timerEnabled:=false; //取消時鐘

  Fullscreen := TBitmapCreate; //創建一個BITMAP來存放圖象

  FullscreenWidth := screenwidth;

  FullscreenHeight := screenHeight;

  DC := GetDC (); //取得屏幕的 DC參數指的是屏幕

  FullscreenCanvas := TCanvasCreate; //創建一個CANVAS對象

  FullscreenCanvasHandle := DC;

  FullscreenCanvasCopyRect (Rect ( screenWidth screenHeight) fullscreenCanvasRect ( ScreenWidth ScreenHeight));

  //把整個屏幕復制到BITMAP中

  FullscreenCanvasFree; //釋放CANVAS對象

  ReleaseDC ( DC); //釋放DC

  imagepictureBitmap:=fullscreen;//拷貝下的圖象賦給IMAGE對象

  imageWidth:=fullscreenWidth;

  imageHeight:=fullscreenHeight;

  fullscreenfree; //釋放bitmap

  formWindowState:=wsNormal; //復原窗口狀態

  formshow; //顯示窗口

  messagebeep(); //BEEP叫一聲報告圖象已經截取好了

  end;

   接 下 去FULLSCREEN 按 鈕 上 的 代 碼 就 很 簡 單 了

  procedure TFormFullscreenClick(Sender: TObject);

  begin

  formWindowState:=wsMinimized; //最小化程序窗口

  formhide; //把程序藏起來

  timerenabled:=true; //打開記時器

  end;

   拷 貝 到 了 圖 象 當 然 要 存 起 來 了SAVE 按 鈕 就 有 了 用 武 之 地 我 們 寫 下 如下 代 碼

  procedure TFormSaveClick(Sender: TObject);

  begin

  if savedialogExecute then

  begin

  formImagePictureSaveToFile(savedialogfilename)

  end;

  end;

   下 面 是 區 域 拷 貝 的 實 現 再New 一 個FORMBorderStype 設 為 bsNone 這 樣 能 夠 顯 示為 全 屏 幕 上 面 放 置 一 個TIMAGE 部 件ALIGN 設 為ALCLIENT 另 外 放 置 一 個TTIMER部 件TIMER 部 件 的 程 序 跟 上 面 的 很 象 因 為 它 首 先 要 實 現 的 是 全 屏 幕 的 拷貝

  procedure TFormTimerTimer(Sender: TObject);

  var

  Fullscreen:Tbitmap;

  FullscreenCanvas:TCanvas;

  dc:HDC;

  begin

  timerEnabled:=false;

  Fullscreen := TBitmapCreate;

  FullscreenWidth := screenwidth;

  FullscreenHeight := screenHeight;

  DC := GetDC ();

  FullscreenCanvas := TCanvasCreate;

  FullscreenCanvasHandle := DC;

  FullscreenCanvasCopyRect (Rect ( screenWidth screenHeight) fullscreenCanvasRect ( ScreenWidth ScreenHeight));

  FullscreenCanvasFree;

  ReleaseDC ( DC);

  imagepictureBitmap:=fullscreen;

  imageWidth:=fullscreenWidth;

  imageHeight:=fullscreenHeight;

  fullscreenfree;

  formWindowState:=wsMaximized;

  formshow;

  messagebeep();

  foldx:=;

  foldy:=;

  imageCanvasPenmode:=pmnot; //筆的模式為取反

  imagecanvaspencolor:=clblack; //筆為黑色

  imagecanvasbrushStyle:=bsclear; //空白刷子

  flag:=true;

  end;

  TIMAGE 部 件 上 有 兩 個 事 件 的 程 序 需 要 編 寫 一 個 是ONMOUSEDOWN 另 一 個是ONMOUSEMOVE

   可 以 回 頭 看 看 區 域 拷 貝 的 思 路 此 時 需 要 作 區 域 拷 貝 的 屏 幕 我 們 已 經得 到 也 顯 示 在 屏 幕 上 了 按 下 鼠 標 左 鍵 是 區 域 的 原 點 此 後 移 動 鼠 標 將有 一 個 矩 形 在 原 點 和 鼠 標 之 間 它 會 隨 著 鼠 標 的 移 動 而 變 化 再 次 按 下 鼠標 的 左 鍵 此 時 矩 形 所 包 含 的 區 域 就 是 我 們 要 得 到 的 圖 象 了

   所 以MOUSEDOWN 有 兩 次 響 應 的 處 理 見 以 下 程 序

  procedure TFormImageMouseDown

  (Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X Y: Integer);

  var

  widthheight:integer;

  newbitmap:Tbitmap;

  begin

  if (trace=false) then // TRACE表示是否在追蹤鼠標

  begin //首次點擊鼠標左鍵開始追蹤鼠標

  flag:=false;

  with imagecanvas do

  begin

  moveTo(foldx);

  LineTo(foldxscreenheight);

  moveto(foldy);

  lineto(screenwidthfoldy);

  end;

  x:=x;

  y:=y;

  oldx:=x;

  oldy:=y;

  trace:=true;

  imageCanvasPenmode:=pmnot; //筆的模式為取反

  //這樣再在原處畫一遍矩形相當於擦除矩形

  imagecanvaspencolor:=clblack; //筆為黑色

  imagecanvasbrushStyle:=bsclear;//空白刷子

  end

  else

  begin //第二次點擊表示已經得到矩形了

  //把它拷貝到FORM中的IMAGE部件上

  x:=x;

  y:=y;

  trace:=false;

  imagecanvasrectangle(xyoldxoldy);

  width:=abs(xx);

  height:=abs(yy);

  formimageWidth:=Width;

  formimageHeight:=Height;

  newbitmap:=Tbitmapcreate;

  newbitmapwidth:=width;

  newbitmapheight:=height;

  newbitmapCanvasCopyRect

  (Rect ( width Height)formimagecanvas

  Rect (x yxy)); //拷貝

  formimagepicturebitmap:=newbitmap; //放到FORM的IMAGE上

  newbitmapfree;

  formhide;

  formshow;

  end;

  end;

  MOUSEMOVE 的 處 理 就 是 在 原 點 和 鼠 標 當 前 位 置 之 間 不 斷 地 畫 矩 形 和 擦除 矩 形

  procedure TFormImageMouseMove

  (Sender: TObject; Shift: TShiftState; X

  Y: Integer);

  begin

  if trace=true then //是否在追蹤鼠標?

  begin //是擦除舊的矩形並畫上新的矩形

  with imagecanvas do

  begin

  rectangle(xyoldxoldy);

  Rectangle(xyxy);

  oldx:=x;

  oldy:=y;

  end;

  end

  else if flag=true then //在鼠標所在的位置上畫十字

  begin

  with imagecanvas do

  begin

  moveTo(foldx); //擦除舊的十字

  LineTo(foldxscreenheight);

  moveto(foldy);

  lineto(screenwidthfoldy);

  moveTo(x); //畫上新的十字

  LineTo(xscreenheight);

  moveto(y);

  lineto(screenwidthy);

  foldx:=x;

  foldy:=y;

  end;

  end;

  end;

   好 了 讓 我 們 回 過 頭 來 編 寫REGION 按 鈕 的 代 碼

  procedure TFormRegionClick(Sender: TObject);

  begin

  formHide;

  formhide;

  formTimerEnabled:=true;

  end;

  好 了 我 們 終 於 勝 利 完 工 了 趕 快 運 行 一 遍 把 漂 亮 的 屏 幕 拷 下 來 ! 瞧DELPHI 不 僅 是 一 個 優 秀 的 數 據 庫 開 發 工 具 而 且 是 一 個 優 秀 的 編 寫WINDOWS程 序 的 好 幫 手 讓 我 們 不 禁 贊 歎 偉 大 的DELPHI !


From:http://tw.wingwit.com/Article/program/Delphi/201311/8540.html
    推薦文章
    Copyright © 2005-2022 電腦知識網 Computer Knowledge   All rights reserved.