📄 075.htm
字号:
<HTML><HEAD><meta http-equiv="Content-Type" content="text/html; charset=GB2312"><TITLE>-->DELPHI专题文档－程序应用-->一个实用的Delphi屏幕拷贝程序的设计</TITLE>
<META NAME="keywords" CONTENT=" DELPHI专题文档－程序应用 一个实用的Delphi屏幕拷贝程序的设计">
<META NAME="description" CONTENT=" - DELPHI专题文档－程序应用 - 一个实用的Delphi屏幕拷贝程序的设计">
<style>
<!--
#page {position:absolute; z-index:0; left:0px; top:0px}
.tt3 {font: 9pt/12pt "宋体"}
.tt2 {font: 12pt/15pt "宋体"}
a {text-decoration:none}
a:hover {color: blue;text-decoration:underline}
-->
</style>
</HEAD>
<a href="index6.html">返回</a>
<body text="#000000" aLink=#9900ff link=#006699 vLink=#006699 bgcolor="#FFFFFF" leftmargin="3" topmargin="3" marginheight="3" marginwidth="3">
<TABLE WIDTH="100%" CELLPADDING=10 CELLSPACING=0 BORDER=0>
<TR>
<TD class="tt2" bgcolor="#F5F8F8" width="84%"><center><B><FONT style="FONT-SIZE: 16.5pt" COLOR="#FF6666" FACE="楷体_GB2312">一个实用的Delphi屏幕拷贝程序的设计</FONT></B></center>
<hr color="#EE9B73" size="1" width="94%">
----Borland公司（现改名为INPRISE公司）的DELPHI是当前最为方便的Windows程序设
计工具之一。许多人以为DELPHI是作为数据库开发工具出现的，其实用DELPHI
可以以极快的速度开发出高效的Windows程序。<br>
<br>
----现在我们就用DELPHI来编写一个实用的屏幕拷贝程序。瞧瞧，下面的画面就是所编程序运行后进行区域屏幕拷贝的例子，还不错吧！<br>
<br>
----Borland公司的天才设计师们用画布（Tcanvas）对象封装了Windows的大部分图形
输出功能，这使得我们可以通过他以更直观的方式和Windows的屏幕打交道，而不必关心令人头疼的WindowsAPI函数。下面的一小段程序就可以实现整个
屏幕的图象拷贝了。<br>
<br>
var//变量声明<br>
Fullscreen:Tbitmap;<br>
FullscreenCanvas:TCanvas;<br>
dc:HDC;<br>
//------------------------------------------------------------<br>
DC:=GetDC(0);//取得屏幕的DC，参数0指的是屏幕<br>
FullscreenCanvas:=TCanvas.Create;//创建一个CANVAS对象<br>
FullscreenCanvas.Handle:=DC;//将屏幕的DC赋给HANDLE<br>
Fullscreen.Canvas.CopyRect<br>
(Rect(0,0,screen.Width,screen.Height),<br>
fullscreenCanvas,<br>
Rect(0,0,Screen.Width,Screen.Height));<br>
//把整个屏幕复制到BITMAP中<br>
FullscreenCanvas.Free;//释放CANVAS对象<br>
ReleaseDC(0,DC);//释放DC<br>
//SCREEN对象是DELPHI预先定义的屏幕对象，直接使用就行了。<br>
<br>
<br>
----看了以上代码，你就会发现用DELPHI写屏幕拷贝程序的确很简单。<br>
<br>
----当然要写一个实用的屏幕拷贝程序，光靠上述代码是不够的，下面讲一下主要的编程思路：<br>
<br>
----1.全屏幕拷贝的实现<br>
<br>
----首先隐藏拷屏程序，延长一定时间后，利用上述的程序即可实现屏幕的
拷贝。<br>
<br>
----2.区域拷贝的实现<br>
<br>
----要实现区域拷贝要用个小技巧，首先调用全屏幕拷贝程序把整个屏幕拷
贝下来，然后把拷贝下来的图象显示在屏幕上，之后就可以让用户在上面
选择需要的区域，最后才将用户选定的区域复制下来。<br>
<br>
----编程实现：<br>
<br>
----1.首先用DELPHI3开一个工程。<br>
<br>
----2.在FORM上放置一个TPANEL元件，设置ALIGN=ALTOP，再选部件条ADDITIONAL上的TSCROLLBOX，放到FORM上，设置ALIGN=ALCLIENT，然后在SCROLLBOX上放置一个TIMAGE对象。<br>
<br>
----3.在PANEL上放置4个按钮，分别为FULLSCREEN，REGIN，SAVE，EXIT。<br>
<br>
----4.容易干的先干，在EXIT按钮的CLICK事件里写下代码<br>
<br>
procedure TForm1.ExitClick(Sender:TObject);<br>
begin<br>
close;<br>
end;<br>
----5.接着是实现全屏幕拷贝了，在FROM上放置一个记时器TTIMER，ENABLED设为FALSE，INTERVAL设为500，也就是半秒钟激活一次。双击TIMER部件，写上如下的代码。<br>
<br>
procedure TForm1.Timer1Timer(Sender:TObject);<br>
var<br>
Fullscreen:Tbitmap;<br>
FullscreenCanvas:TCanvas;<br>
dc:HDC;<br>
begin<br>
timer1.Enabled:=false;//取消时钟<br>
Fullscreen:=TBitmap.Create;//创建一个BITMAP来存放图象<br>
Fullscreen.Width:=screen.width;<br>
Fullscreen.Height:=screen.Height;<br>
DC:=GetDC(0);//取得屏幕的DC，参数0指的是屏幕<br>
FullscreenCanvas:=TCanvas.Create;//创建一个CANVAS对象<br>
FullscreenCanvas.Handle:=DC;<br>
<br>
Fullscreen.Canvas.CopyRect<br>
(Rect(0,0,screen.Width,screen.Height),fullscreenCanvas,<br>
Rect(0,0,Screen.Width,Screen.Height));<br>
//把整个屏幕复制到BITMAP中<br>
FullscreenCanvas.Free;//释放CANVAS对象<br>
ReleaseDC(0,DC);//释放DC<br>
//*******************************<br>
image1.picture.Bitmap:=fullscreen;//拷贝下的图象赋给IMAGE对象<br>
image1.Width:=fullscreen.Width;<br>
image1.Height:=fullscreen.Height;<br>
fullscreen.free;//释放bitmap<br>
form1.WindowState:=wsNormal;//复原窗口状态<br>
form1.show;//显示窗口<br>
messagebeep(1);//BEEP叫一声，报告图象已经截取好了。<br>
end;<br>
----6.接下去FULLSCREEN按钮上的代码就很简单了。<br>
<br>
procedure TForm1.FullscreenClick(Sender:TObject);<br>
begin<br>
form1.WindowState:=wsMinimized;//最小化程序窗口<br>
form1.hide;//把程序藏起来<br>
timer1.enabled:=true;//打开记时器<br>
end;<br>
----7.拷贝到了图象当然要存起来了，SAVE按钮就有了用武之地，我们写下如<br>
下代码。<br>
<br>
procedure TForm1.Save1Click(Sender:TObject);<br>
begin<br>
if savedialog1.Executethen<br>
begin<br>
form1.Image1.Picture.SaveToFile(savedialog1.filename)<br>
end;<br>
end;<br>
----8.下面是区域拷贝的实现。再New一个FORM,BorderStype设为bsNone,这样能够显示为全屏幕，上面放置一个TIMAGE部件，ALIGN设为ALCLIENT，另外放置一个TTIMER部件，TIMER部件的程序跟上面的很象，因为它首先要实现的是全屏幕的拷贝。<br>
<br>
procedure TForm2.Timer1Timer(Sender:TObject);<br>
var<br>
Fullscreen:Tbitmap;<br>
FullscreenCanvas:TCanvas;<br>
dc:HDC;<br>
begin<br>
timer1.Enabled:=false;<br>
Fullscreen:=TBitmap.Create;<br>
Fullscreen.Width:=screen.width;<br>
Fullscreen.Height:=screen.Height;<br>
DC:=GetDC(0);<br>
FullscreenCanvas:=TCanvas.Create;<br>
FullscreenCanvas.Handle:=DC;<br>
Fullscreen.Canvas.CopyRect(Rect<br>
(0,0,screen.Width,screen.Height),fullscreenCanvas,<br>
Rect(0,0,Screen.Width,Screen.Height));<br>
FullscreenCanvas.Free;<br>
ReleaseDC(0,DC);<br>
image1.picture.Bitmap:=fullscreen;<br>
image1.Width:=fullscreen.Width;<br>
image1.Height:=fullscreen.Height;<br>
fullscreen.free;<br>
form2.WindowState:=wsMaximized;<br>
form2.show;<br>
<br>
messagebeep(1);<br>
foldx:=-1;<br>
foldy:=-1;<br>
image1.Canvas.Pen.mode:=pmnot;//笔的模式为取反<br>
image1.canvas.pen.color:=clblack;//笔为黑色<br>
image1.canvas.brush.Style:=bsclear;//空白刷子<br>
flag:=true;<br>
end;<br>
----9.TIMAGE部件上有两个事件的程序需要编写，一个是ONMOUSEDOWN，另一个是ONMOUSEMOVE。<br>
<br>
----10.可以回头看看区域拷贝的思路，此时需要作区域拷贝的屏幕我们已经得到，也显示在屏幕上了，按下鼠标左键是区域的原点，此后移动鼠标，将有一个矩形在原点和鼠标之间，它会随着鼠标的移动而变化，再次按下鼠标的左键，此时矩形所包含的区域就是我们要得到的图象了。<br>
<br>
----11.所以MOUSEDOWN有两次响应的处理，见以下程序。<br>
<br>
procedure TForm2.Image1MouseDown<br>
(Sender:TObject;Button:TMouseButton;<br>
Shift:TShiftState;X,Y:Integer);<br>
var<br>
width,height:integer;<br>
newbitmap:Tbitmap;<br>
begin<br>
if (trace=false) then//TRACE表示是否在追踪鼠标<br>
begin//首次点击鼠标左键，开始追踪鼠标。<br>
flag:=false;<br>
with image1.canvasdo<br>
begin<br>
moveTo(foldx,0);<br>
LineTo(foldx,screen.height);<br>
moveto(0,foldy);<br>
lineto(screen.width,foldy);<br>
end;<br>
x1:=x;<br>
y1:=y;<br>
oldx:=x;<br>
oldy:=y;<br>
trace:=true;<br>
image1.Canvas.Pen.mode:=pmnot;//笔的模式为取反<br>
//这样再在原处画一遍矩形，相当于擦除矩形。<br>
image1.canvas.pen.color:=clblack;//笔为黑色<br>
image1.canvas.brush.Style:=bsclear;//空白刷子<br>
end<br>
else<br>
begin//第二次点击，表示已经得到矩形了，<br>
//把它拷贝到FORM1中的IMAGE部件上。<br>
x2:=x;<br>
y2:=y;<br>
trace:=false;<br>
image1.canvas.rectangle(x1,y1,oldx,oldy);<br>
width:=abs(x2-x1);<br>
height:=abs(y2-y1);<br>
form1.image1.Width:=Width;<br>
form1.image1.Height:=Height;<br>
<br>
newbitmap:=Tbitmap.create;<br>
newbitmap.width:=width;<br>
newbitmap.height:=height;<br>
newbitmap.Canvas.CopyRect<br>
(Rect(0,0,width,Height),form2.image1.canvas,<br>
Rect(x1,y1,x2,y2));//拷贝<br>
form1.image1.picture.bitmap:=newbitmap;//放到FORM的IMAGE上<br>
newbitmap.free;<br>
form2.hide;<br>
form1.show;<br>
end;<br>
end;<br>
----12.MOUSEMOVE的处理就是在原点和鼠标当前位置之间不断地画矩形和擦除矩形。<br>
<br>
procedure TForm2.Image1MouseMove<br>
(Sender:TObject;Shift:TShiftState;X,<br>
Y:Integer);<br>
begin<br>
if trace=true then//是否在追踪鼠标？<br>
begin//是，擦除旧的矩形并画上新的矩形<br>
with image1.canvasdo<br>
begin<br>
rectangle(x1,y1,oldx,oldy);<br>
Rectangle(x1,y1,x,y);<br>
oldx:=x;<br>
oldy:=y;<br>
end;<br>
end<br>
else if flag=truethen//在鼠标所在的位置上画十字<br>
begin<br>
with image1.canvasdo<br>
begin<br>
moveTo(foldx,0);//擦除旧的十字<br>
LineTo(foldx,screen.height);<br>
moveto(0,foldy);<br>
lineto(screen.width,foldy);<br>
moveTo(x,0);//画上新的十字<br>
LineTo(x,screen.height);<br>
moveto(0,y);<br>
lineto(screen.width,y);<br>
foldx:=x;<br>
foldy:=y;<br>
end;<br>
end;<br>
end;<br>
----13.好了，让我们回过头来编写REGION按钮的代码。<br>
<br>
procedure TForm1.RegionClick(Sender:TObject);<br>
begin<br>
form1.Hide;<br>
form2.hide;<br>
form2.Timer1.Enabled:=true;<br>
end;<br>
----好了，我们终于胜利完工了，赶快运行一遍，把漂亮的屏幕拷下来！瞧DELPHI不仅是一个优秀的数据库开发工具，而且是一个优秀的编写WINDOWS程序的好帮手。让我们不禁赞叹：伟大的DELPHI！</p>
<hr color="#EE9B73" size="1" width="94%">
</TD>
</TR>
</table>
</BODY></HTML>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -