📄 图形控制技巧.htm
字号:
<html><head><style type="text/css"><!--.p9 { font-family: "宋体"; font-size: 9pt}a {text-transform: none; text-decoration: none;}a:hover {text-decoration: underline; color: #FF0000;}--></style><title></title></head><body background="di2001.jpg"><h3 align="center"><font COLOR="#AOAO99">图形控制技巧</font></h3><table width="100%"> <tr> <td><font color="0000FF"><a name="1">Delphi 3 图形VCL中Bug修改方案:<br> 傅贵</a></font></td> </tr> <tr> <td> 所有用Delphi 3的TJpegImage开发过Web ISAPI程序的人都知道：刚开始程序运行是正<br> 确的，但是运行不出几次，程序就会出问题：Web Server产生页面错误！ 但是仔细检查自己的程序，发现还是没有问题，到底为什么？<br> 经仔细检查Delphi 3 VCL 的源程序，发现实际上错误发生在Delphi 3的图形处理文件<br> Graphics中，Borland公司的开发人员锁住了BitmapCanvasList但是未解锁，使得程序在多线程的程序中会产生错误。<br> 具体如下：(下面的程序在Delphi 3\Source\VCL\Graphics.pas中) procedure FreeMemoryContexts;<br> var I: Integer; begin with BitmapCanvasList.LockList do begin<br> try for I := Count-1 downto 0 do<br> with TBitmapCanvas(Items[I]) do if TryLock then try<br> FreeContext; finally Unlock; end; finally<br> BitmapCanvasList.UnLockList; end end; end; ...<br> procedure DeselectBitmap(AHandle: HBITMAP); var I: Integer; begin<br> if AHandle = 0 then Exit; with BitmapCanvasList.LockList do try<br> for I := Count - 1 downto 0 do with TBitmapCanvas(Items[I]) do<br> if (FBitmap <> nil) and (FBitmap.FImage.FHandle = AHandle) then<br> FreeContext; finally BitmapCanvasList.UnLockList; end end;<br> 在以上的程序中红色为补充的程序，桔红色为发生错误的程序。 修改的方法为修改以上的程序，然后编译生成DCU文件，覆盖在Lib中的DCU文件，重<br> 新编译你所有用到图形的程序。<br> </td> </tr> <tr> <td><font color="0000FF"><a name="2">基于Delphi的图像漫游<br> 向晖</a></font></td> </tr> <tr> <td>在开发多媒体应用中,经常会遇到需要在有限区域内显示大图像的情况,有不少文章对此提出过解决方法,如通过调用Windows的API函数,直接读写内存等。这些方法有某些优点,但实现起来较为复杂,且易出错。笔者在实践中通过仔细摸索,利用Delphi的强大的面向对象可视化开发环境开发了一种交互式图像漫游方法。Delphi中,鼠标的消息响应是通过元件的OnMouseDown、OnMouseUp和OnMouseMove事件实现的,通过对此三个事件编程,可控制图像在有限区域内移动。考虑到所移动的图像的边界应总在该区域外,因此图像的左上角坐标应小于该区域对应坐标,图像右下角坐标应大于该区域对应坐标(除非图像大小比该区域小)。图1具体方法是:<br> 1、新建一工程Project1,在Form1中依次放入Panel1、Panel2和Image1元件,注意Pa nel2和Image1分别在Panel1和Panel2上,再将一Label1元件加入Panel2中,调整Panel1尺寸为适当大小,并修改各元件属性为:<br> 元件<br> 属性名<br> 属性值<br> Panel1<br> BevelInner:<br> bvRaised<br> BevelOuter: bvNone<br> BorderStyle: bsSingle<br> Panel2<br> Align:<br> alClient<br> Image1<br> AutoSize:<br> True<br> Picture:<br> "Apple.bmp"<br> Label1<br> Align:<br> alClient<br> Transparent : True<br> 注意:此处Label1的作用不是显示字符,而是利用它响应鼠标消息,如果不用Label1而直接利用Image1的鼠标事件响应,则会由于其OnMouseDown事件的激活与Image1的自身坐标移动事件冲突而使图像发生闪烁甚至不能移动。<br> 2、在implementation后加入变量声明:<br> origin:Tpoint;<br> image_left:integer;<br> image_top:integer;<br> visa1:Tpoint; (鼠标当前位置相对图像右下角的坐标)<br> visa2:Tpoint; (鼠标当前位置相对图像左上角的坐标)<br> canmove:boolean;<br> 编写Label1鼠标响应事件:<br> procedure TForm1.Label1MouseDown(Sender: TObject; Button<br> : TMouseButton;S hift: TShiftState; X, Y: Integer);<br> begin<br> if Button=mbLeft then<br> begin<br> origin.x:=X;<br> origin.y:=Y;<br> image_left:=image1.left;<br> image_top:=image1.top;<br> visa1.x:=X-(image1.width-panel2.width+image1.left);<br> visa1.y:=Y-(image1.height-panel2.height+image1.top);<br> visa2.x:=X-image1.left;<br> visa2.y:=Y-image1.top;<br> canmove:=true;<br> end;<br> end;<br> procedure TForm1.Label1MouseMove(Sender: TObject; Shift:<br> TShiftState; X, Y: Integer);<br> begin<br> if canmove then<br> begin<br> if X<visa1.x then X:="visa1.x;<Br"> if X>visa2.x then X:=visa2.x;<br> if Y<visa1.y then Y:="visa1.y;<Br"> if Y>visa2.y then Y:=visa2.y;<br> image1.left:=image_left+(X-origin.x);<br> image1.top:=image_top+(Y-origin.y);<br> end;<br> end;<br> procedure TForm1.Label1MouseUp(Sender: TObject; Button:<br> TMouseButton;Shi ft: TShiftState; X, Y: Integer);<br> begin<br> canmove:=false;<br> end;<br> 上述程序在Delphi 2.0中编译通过,经过扩充和修改还可应用于多媒体数据库的图像显示,对于开发友好界面有一定借鉴作用。<br> </td> </tr> <tr> <td><font color="0000FF"><a name="3">界面色彩渐变效果的实现<br> 山东 杨波 </a></font></td> </tr> <tr> <td> 界面色彩渐变效果是通过用渐变的画刷刷绘依次相邻的矩形块实现的。下面列举实例说明:<br> 1.新建一个表单,假设其Width为500,设置一个按钮Button1,按此按钮将把表单置为由左向右由黄变白的渐变效果。<br> 2.Button1按钮的代码如下:<br> procedure TForm1.Button1Click(Sender: TObject);<br> var i,j:Integer;<br> Dct:TRect;<br> begin<br> j:=Form1.height;<br> //获得表单高度<br> for i:=0 to 255 do<br> //此处设置RGB()中一个颜色值<br> begin<br> Canvas.Brush.Color:=RGB(255,255,i);<br> //每次画矩形的画刷颜色<br> Dct:=Rect(i＊2,0,(i＋1)＊2,j);<br> //每次刷绘的矩形区域<br> Canvas.FillRect(Dct);<br> //填充颜色<br> end;<br> end;<br> 上例在Windows95,Delphi3.0环境下运行通过。<br> </td> </tr> <tr> <td><font color="0000FF"><a name="4">图形整体拉出效果<br> 山东 杨波</a></font></td> </tr> <tr> <td> 单纯的图形整体拉出效果比较简单,动态地改变图形区域的大小就可以实现,但事先应将图形的“Stretch”设置为“True”。<br> 举例说明下拉效果:<br> 1.在表单上放置一图片,高度为200,属性“Height”设为0,“Stretch”设置为True。添加“Timer”构件, “Interval”设为200,“Enable”设为Ture。<br> 2.在Timer1Timer中添加代码:<br> procedure TForm1.Timer1Timer(Sender: TObject);<br> begin<br> Image1.Height:=Image1.Height＋20;<br> //设置增量<br> if image1.Height=200 then Timer1.Enabled:=FALSE;<br> //图形整体拉出完毕<br> end;<br> 上例在Windows95,Delphi3.0环境下运行通过。<br> </td> </tr></table><p align="center"> </p></body></html>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -