一个实用的Delphi屏幕拷贝程序的设计[1]

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