📄 copy_screen.htm
字号:
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>一个实用的Delphi屏幕拷贝程序的设计</title>
</head>
<body bgcolor="#FFFFFF" text="#000000">
<p align="center"> <font color="#0000c0"></p>
<h2 align="center">一 个 实 用 的Delphi 屏 幕 拷 贝 程 序 的 设 计 </font></h2>
<h3 align="center">宁 波 市 游 河 巷 贾 学 杰 </h3>
<p><font color="#ffffff">----</font> Borland 公 司（ 现 改 名 为INPRISE 公 司）
的DELPHI 是 当 前 最 为 方 便 的Windows 程 序 设<br>
计 工 具 之 一。 许 多 人 以 为DELPHI 是 作 为 数 据 库 开 发 工 具
出 现 的， 其 实 用DELPHI<br>
可 以 以 极 快 的 速 度 开 发 出 高 效 的Windows 程 序。 </p>
<p><font color="#ffffff">----</font> 现 在 我 们 就 用DELPHI 来 编 写 一 个 实
用 的 屏 幕 拷 贝 程 序。 瞧 瞧， 下 面 的 画 面<br>
就 是 所 编 程 序 运 行 后 进 行 区 域 屏 幕 拷 贝 的 例 子， 还 不
错 吧 ！ </p>
<p><font color="#ffffff">----</font> Borland 公 司 的 天 才 设 计 师 们 用 画
布（Tcanvas） 对 象 封 装 了Windows 的 大 部 分 图 形<br>
输 出 功 能， 这 使 得 我 们 可 以 通 过 他 以 更 直 观 的 方 式 和Windows
的 屏 幕 打 交 道，<br>
而 不 必 关 心 令 人 头 疼 的Windows API 函 数。 下 面 的 一 小 段 程
序 就 可 以 实 现 整 个<br>
屏 幕 的 图 象 拷 贝 了。 </p>
<pre> 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预先定义的屏幕对象，直接使用就行了。
</pre>
<p><font color="#ffffff">----</font> 看 了 以 上 代 码， 你 就 会 发 现 用DELPHI
写 屏 幕 拷 贝 程 序 的 确 很 简 单。 </p>
<p><font color="#ffffff">----</font> 当 然 要 写 一 个 实 用 的 屏 幕 拷 贝
程 序， 光 靠 上 述 代 码 是 不 够 的， 下 面 讲 一<br>
下 主 要 的 编 程 思 路： </p>
<p><font color="#ffffff">----</font> 1. 全 屏 幕 拷 贝 的 实 现 </p>
<p><font color="#ffffff">----</font> 首 先 隐 藏 拷 屏 程 序， 延 长 一 定
时 间 后， 利 用 上 述 的 程 序 即 可 实 现 屏 幕 的<br>
拷 贝。 </p>
<p><font color="#ffffff">----</font> 2. 区 域 拷 贝 的 实 现 </p>
<p><font color="#ffffff">----</font> 要 实 现 区 域 拷 贝 要 用 个 小 技
巧， 首 先 调 用 全 屏 幕 拷 贝 程 序 把 整 个 屏 幕 拷<br>
贝 下 来， 然 后 把 拷 贝 下 来 的 图 象 显 示 在 屏 幕 上， 之 后
就 可 以 让 用 户 在 上 面<br>
选 择 需 要 的 区 域， 最 后 才 将 用 户 选 定 的 区 域 复 制 下
来。 </p>
<p><font color="#ffffff">----</font> 编 程 实 现： </p>
<p><font color="#ffffff">----</font> 1. 首 先 用DELPHI3 开 一 个 工 程。 </p>
<p><font color="#ffffff">----</font> 2. 在FORM 上 放 置 一 个TPANEL 元 件， 设
置ALIGN=ALTOP， 再 选 部 件 条ADDITIONAL 上<br>
的TSCROLLBOX， 放 到FORM 上， 设 置ALIGN=ALCLIENT， 然 后 在SCROLLBOX 上 放
置 一 个<br>
TIMAGE 对 象。 </p>
<p><font color="#ffffff">----</font> 3. 在PANEL 上 放 置4 个 按 钮， 分 别 为FULL
SCREEN，REGIN，SAVE，EXIT。 </p>
<p><font color="#ffffff">----</font> 4. 容 易 干 的 先 干， 在EXIT 按 钮 的CLICK
事 件 里 写 下 代 码 </p>
<pre>procedure TForm1.ExitClick(Sender: TObject);
begin
close;
end;</pre>
<p><font color="#ffffff">----</font> 5. 接 着 是 实 现 全 屏 幕 拷 贝 了， 在FROM
上 放 置 一 个 记 时 器TTIMER，ENABLED 设 为<br>
FALSE，INTERVAL 设 为500， 也 就 是 半 秒 钟 激 活 一 次。 双 击TIMER 部
件， 写 上 如 下 的<br>
代 码。 </p>
<pre>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;</pre>
<p><font color="#ffffff">----</font> 6. 接 下 去FULLSCREEN 按 钮 上 的 代 码 就
很 简 单 了。 </p>
<pre>procedure TForm1.FullscreenClick(Sender: TObject);
begin
form1.WindowState:=wsMinimized; //最小化程序窗口
form1.hide; //把程序藏起来
timer1.enabled:=true; //打开记时器
end;</pre>
<p><font color="#ffffff">----</font> 7. 拷 贝 到 了 图 象 当 然 要 存 起 来
了，SAVE 按 钮 就 有 了 用 武 之 地， 我 们 写 下 如<br>
下 代 码。 </p>
<pre>procedure TForm1.Save1Click(Sender: TObject);
begin
if savedialog1.Execute then
begin
form1.Image1.Picture.SaveToFile(savedialog1.filename)
end;
end;</pre>
<p><font color="#ffffff">----</font> 8. 下 面 是 区 域 拷 贝 的 实 现。 再New
一 个FORM,BorderStype 设 为 bsNone, 这 样 能 够 显 示<br>
为 全 屏 幕， 上 面 放 置 一 个TIMAGE 部 件，ALIGN 设 为ALCLIENT， 另
外 放 置 一 个TTIMER<br>
部 件，TIMER 部 件 的 程 序 跟 上 面 的 很 象， 因 为 它 首 先 要 实
现 的 是 全 屏 幕 的 拷<br>
贝。 </p>
<pre>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;</pre>
<p><font color="#ffffff">----</font> 9.TIMAGE 部 件 上 有 两 个 事 件 的 程 序
需 要 编 写， 一 个 是ONMOUSEDOWN， 另 一 个<br>
是ONMOUSEMOVE。 </p>
<p><font color="#ffffff">----</font> 10. 可 以 回 头 看 看 区 域 拷 贝 的 思
路， 此 时 需 要 作 区 域 拷 贝 的 屏 幕 我 们 已 经<br>
得 到， 也 显 示 在 屏 幕 上 了， 按 下 鼠 标 左 键 是 区 域 的 原
点， 此 后 移 动 鼠 标， 将<br>
有 一 个 矩 形 在 原 点 和 鼠 标 之 间， 它 会 随 着 鼠 标 的 移 动
而 变 化， 再 次 按 下 鼠<br>
标 的 左 键， 此 时 矩 形 所 包 含 的 区 域 就 是 我 们 要 得 到 的
图 象 了。 </p>
<p><font color="#ffffff">----</font> 11. 所 以MOUSEDOWN 有 两 次 响 应 的 处
理， 见 以 下 程 序。 </p>
<pre>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;
</pre>
<p><font color="#ffffff">----</font> 12.MOUSEMOVE 的 处 理 就 是 在 原 点 和 鼠
标 当 前 位 置 之 间 不 断 地 画 矩 形 和 擦<br>
除 矩 形。 </p>
<pre>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;
</pre>
<p><font color="#ffffff">----</font> 13. 好 了， 让 我 们 回 过 头 来 编 写REGION
按 钮 的 代 码。 </p>
<pre>procedure TForm1.RegionClick(Sender: TObject);
begin
form1.Hide;
form2.hide;
form2.Timer1.Enabled:=true;
end;</pre>
<p><font color="#ffffff">----</font> 好 了， 我 们 终 于 胜 利 完 工 了， 赶
快 运 行 一 遍， 把 漂 亮 的 屏 幕 拷 下 来 ！ 瞧<br>
DELPHI 不 仅 是 一 个 优 秀 的 数 据 库 开 发 工 具， 而 且 是 一 个
优 秀 的 编 写WINDOWS<br>
程 序 的 好 帮 手。 让 我 们 不 禁 赞 叹： 伟 大 的DELPHI ！ </p>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -