说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

利用delphi美化你的菜单

HTML文档下载 WORD文档下载 PDF文档下载
利用delphi美化你的菜单

windows下的很多程序都有十分漂亮的菜单,例如windows“开始”菜单左方从上到下的长条形的windows banner 又或者是向word那样在每一个菜单条左边都有一个小图标,看到这些很cool的菜单,你是否觉得自己的菜单显得单调乏味呢?不需要第三方控件,利用delphi就可以实现上面的功能。

如果要实现自定义菜单就需要在绘制菜单时改变菜单的大小以适应在菜单上绘制图形,然后再在上面绘制自己所需要的菜单效果。在delphi中,每一个菜单项对应一个tmenuitem控件,这类控件都有两个事件:ondrawitem和onmeasureitem,要实现自定义菜单,首先要介绍一下这两个事件:

onmeasureitem事件的定义如下:

type tmenumeasureitemevent = procedure (sender: tobject; acanvas: tcanvas;

var width

height: integer) of object;

property onmeasureitem: tmenumeasureitemevent;

该事件在菜单条监测自身的尺寸时产生,其中参数acanvas定义绘制的绘图对象,参数width、height制定菜单项的默认尺寸,注意到这两个定义前的var了吗,说明你可以在onmeasureitem事件处理函数中改变这两个值,也就是改变菜单的大小。

ondrawitem事件的定义如下:

type tmenudrawitemevent = procedure (sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean) of object;

property ondrawitem: tmenudrawitemevent;

该事件在菜单绘制时引发,其中参数acanvas定义菜单绘制对象,参数arect制定菜单的绘制区域,参数selected定义当前菜单项是否被选中。

从上面的介绍可以看到,要实现自定义的菜单,只要在onmeasureitem事件中编写代码改变菜单项的尺寸,然后在ondrawitem事件中绘制自己需要的效果就可以了。

下面我痛过具体的范例来做说明,这个范例是使自己的菜单实现象windows开始菜单一样的显示banner条的功能。同时这个程序还能实现对被选中的菜单条进行渐变色填充(就象3721中文网址软件的任务栏菜单那样)。程序的思路是这样的,首先建立一个长条型的位图,然后在每一个菜单条的onmeasureitem事件中根据要显示在菜单上的文本和图像以及程序的需要改变菜单项的宽度和高度,然后在ondrawitem事件中将位图中的相应部分拷贝到菜单项上。如果该菜单条被选中,首先要改变acanvas参数的画刷颜色,然后再依次填充菜单条上的相应部分,这样就实现了对选中的菜单条实现渐变色填充。最后将文本输出到菜单条上。

下面来介绍具体的程序,首先利用图像软件建立一个长条型的位图文件(你可以根据你的需要设定图像的高宽比,在我的图像中是10:1)。在delphi中建立一个新的工程,在form1中加入一个timage控件,将控件的autosize属性设置为true。然后在form1中加入一个tmainmenu控件,将它的ownerdraw属性设置为true(这一点很重要,否则程序无法实现)在该tmainmenu下加入6个tmenuitem对象(鼠标右健点击tmainmenu控件,然后点击弹出菜单的menu designer 项,就可以在设计窗口中添加菜单条了),将它们的name属性分别设置为 caption1、caption2、…、caption6。

下面是具体的程序清单:

unit ownermenu;

interface

uses

windows

messages

sysutils

classes

graphics

controls

forms

dialogs

menus

extctrls

stdctrls

imglist;

type

tform1 = class(tform)

mainmenu1: tmainmenu;

main1: tmenuitem;

caption1: tmenuitem;

caption2: tmenuitem;

caption3: tmenuitem;

caption4: tmenuitem;

caption5: tmenuitem;

caption6: tmenuitem;

image1: timage;

procedure caption1measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

procedure caption2measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

procedure caption3measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

procedure caption4measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

procedure caption5measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

procedure caption6measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

procedure caption1drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

procedure caption2drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

procedure caption3drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

procedure caption4drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

procedure caption5drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

procedure caption6drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

private

{ private declarations }

public

procedure drawitem(sender: tmenuitem; acanvas: tcanvas;arect: trect;

selected: boolean;strout:string);

{ public declarations }

end;

var

form1: tform1;

i

ih

ind

iw

irate:integer;

rtemp:trect;

ig1

ig2:integer;

implementation

{$r *.dfm}

procedure tform1.drawitem(sender: tmenuitem; acanvas: tcanvas;arect: trect;

selected: boolean;strout:string);

var

j:integer;

begin

i:=arect.bottom -arect.top; //获得贴图的高度和宽度

ind:=sender.menuindex;

ih:=round(image1.height/6*ind); //获得贴图位置

//将image上相应位置的位图复制到菜单上

stretchblt(acanvas.handle

arect.left

arect.top

iw

i

image1.canvas.handle

0

ih

image1.width

round(image1.height/6)

srccopy);

if selected then begin //该菜单项被选中

acanvas.font.color := clwhite;

rtemp:=arect;

rtemp.left := rtemp.left+iw;

ig1:=round((rtemp.right - rtemp.left)/10);

rtemp.right := rtemp.left +ig1;

for j:= 0 to 9 do begin //通过循环设置色彩渐变效果

acanvas.brush.color := rgb(0

0

j*25);

acanvas.fillrect(rtemp);

rtemp.left := rtemp.left +ig1;

rtemp.right := rtemp.left +ig1;

end;

end

else begin //该菜单项没有被选中

acanvas.brush.color := cl3dlight; //设置背景色为浅灰

rtemp:=arect;

rtemp.left := rtemp.left+iw;

acanvas.fillrect(rtemp);

acanvas.font.color := clblack;

end;

//设置canvas的画笔填充模式为透明

acanvas.brush.style:=bsclear;

//在菜单上输出文字

acanvas.textout(arect.left+iw+5

arect.top

strout);

end;

procedure tform1.caption1measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

begin

//在onmeasureitem事件中改变菜单的宽度和高度,下面5个程序同

//改变菜单的宽度和高度以容纳文本

height:=acanvas.textheight('caption1')+5;

width:=acanvas.textwidth('caption1')+5;

irate:=round(image1.height/(height*6));

iw:=round(image1.width /irate);

width:=width+iw; //根据计算改变菜单宽度以容纳附加的文本

end;

procedure tform1.caption2measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

begin

height:=acanvas.textheight('caption1')+5;

width:=acanvas.textwidth('caption1')+5;

irate:=round(image1.height/(height*6));

iw:=round(image1.width /irate);

width:=width+iw;

end;

procedure tform1.caption3measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

begin

height:=acanvas.textheight('caption1')+5;

width:=acanvas.textwidth('caption1')+5;

irate:=round(image1.height/(height*6));

iw:=round(image1.width /irate);

width:=width+iw;

end;

procedure tform1.caption4measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

begin

height:=acanvas.textheight('caption1')+5;

width:=acanvas.textwidth('caption1')+5;

irate:=round(image1.height/(height*6));

iw:=round(image1.width /irate);

width:=width+iw;

end;

procedure tform1.caption5measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

begin

height:=acanvas.textheight('caption1')+5;

width:=acanvas.textwidth('caption1')+5;

irate:=round(image1.height/(height*6));

iw:=round(image1.width /irate);

width:=width+iw;

end;

procedure tform1.caption6measureitem(sender: tobject; acanvas: tcanvas;

var width

height: integer);

begin

height:=acanvas.textheight('caption1')+5;

width:=acanvas.textwidth('caption1')+5;

irate:=round(image1.height/(height*6));

iw:=round(image1.width /irate);

width:=width+iw;

end;

procedure tform1.caption1drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

begin

drawitem(tmenuitem(sender)

acanvas

arect

selected

'caption1');

end;

procedure tform1.caption2drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

begin

drawitem(tmenuitem(sender)

acanvas

arect

selected

'caption2');

end;

procedure tform1.caption3drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

begin

drawitem(tmenuitem(sender)

acanvas

arect

selected

'caption3');

end;

procedure tform1.caption4drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

begin

drawitem(tmenuitem(sender)

acanvas

arect

selected

'caption4');

end;

procedure tform1.caption5drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

begin

drawitem(tmenuitem(sender)

acanvas

arect

selected

'caption5');

end;

procedure tform1.caption6drawitem(sender: tobject; acanvas: tcanvas;

arect: trect; selected: boolean);

begin

drawitem(tmenuitem(sender)

acanvas

arect

selected

'caption6');

end;

end.

非access数据库在vb中的编程及应用 关闭程序中所有创建的数据库连接。 -VB资料 关闭所有的数据连接 -VB资料 关于数据报表的打印设置-VB资料 VB建立、改变及重构Access数据库-VB资料 结构化查询语言(SQL)详解之一-VB资料 利用VB使ACCESS数据库在网络使用中保持同步 返回 连接Data到多个表单-VB资料 列出 SQL Server 数据库中所有的存储过程-VB资料 列出MDB档当中所有table的名称-VB资料 您想知道有谁正在使用您的 Access 文件吗?(多人环境中)-VB资料 主题:浅谈Excel 的VB编程 巧用VB6的DataGrid实现通用电子表格 VB取得正确的 RecordCount 值 主題:如何动态新增、移除 ODBC DSN? -VB资料 VB如何将表中的数据导出到电子表格中 VB如何将文本文件转换为ACCESS数据库 VB如何將 Excel 的文件导入 Access文件? VB如何判断数据中是否存在某一表或查询 VB如何删除FoxPro数据库的数据? VB如何设置对VB数据库连接的动态路径 VB如何使用 ADO 來压缩或修复 Microsoft Access 文件 VB如何修改Foxpro数据库(不是用VB实现的,不过也可以看看) VB如何在 SQL 语句中使用日期? 返回 VB如何在表中保存单引号? VB如何抓出 Access 的 Table 欄位中的【敘述】部份呢? 实现Access数据库的Web查询-VB资料 使用Visual Basic访问数据库几个注意的问题 数据库查询-VB资料 数据约束控件和 RecordSet-VB资料 锁住数据库中的表 -VB资料 CHtmlView的刷新问题 关于asp.net加密的讨论 怎么样把两个ArrayList合并成一个??我在文档里找了半天也没找到!急~~!!!!!!!! 》》》菜鸟发问:SQL SERVER2000 可以对 office 文档进行全文检索吗? How to alter DBGrid Scrollheader Color? c怎样访问数据库啊?一定给分! from里的参数传递为ENCTYPE="multipart/form-data"时的问题? 网吧问题 如何在txt文件中查找字符 请问如何实现当进入一个combox时自动下拉列表框(不用用鼠标去点) 关于volatile 修饰词 过去用Delphi开发数据库都是用Access,现在急需使用SQL Server。请问:我必须掌握SQL Server中的那些内容。 如果我想删除日志文件的所有记录该怎么办?????? 怎么样把两个ArrayList合并成一个??我在文档里找了半天也没找到!急~~!!!!!!! 请问,NT4.0下怎样配置网关和路由? 请问如何知道一个弹出菜单是否以经关闭 升级后问题,奇怪,请指教? 什么是存储过程? 大侠们帮忙看看,简单问题 急:因出差,明天(12.20,第二期)的“微软.net高级程序员培训”转让(包括资料)!今晚6:00前联系,13910321169. 请问怎样才能在Access中选取指定行数的记录如第5-10条. 关于XML命名空间的疑问?请教各位高手帮帮忙!谢谢! 请问哪里有《情深深雨蒙蒙》下载??? ******斑竹快出来啊 看看我这个贴子啊!!!!!!!!!!!!!! 如何读取寄存器中的数据? 请问在数据库中如何操作日期型字段: Help,如何把本机加入主域服务器? 急:因出差,明天(12.20,第二期)的“微软.net高级程序员培训”转让(包括资料)!今晚6:00前联系,13910321169 怎么用vbscript定义一个函数阿。我想作一个下拉框的onchange事件,请指教 如何确定adoquery的数据是否被修改了? 有关程序调试的问题 全都转行卖大白菜。 对于各个.h和.cpp文件分工如何,我的各种函数各个变量到底该放在哪个文件中的哪个class中? 如何停止asp调用的dll文件,我调用my_dll.dll文件一次之后就不能对my_dll.dll更改了,为什么?怎样解决? 急:因出差,明天(12.20,第二期)的“微软.net高级程序员培训”转让(包括资料)!今晚6:00前联系,13910321169.. 关于附件下载过程中权限控制的问题 如何编辑LILO文件? 糊涂啦。。。看看汉字库(hzk24)吧? 请问在listbox控件中如何设置特定行的颜色? 问一个关于ODBC的问题 急:因出差,明天(12.20,第二期)的“微软.net高级程序员培训”转让(包括资料)!今晚6:00前联系,13910321169.... 各位大侠,哪有设计专家系统的c语言的源代码阿(全分奉送)? 请问:如何处理MFC提供的CList类模板产生的异常问题呢? 散分!快抢! 调用对象 阿呆,只有你能救我了~~!!!!! 100大洋~~!!! Excel报表的汇总 请问VC有像Delphi或者C++Builder那样的作报表的工具吗? delphi怎么调用CHM文件啊? win98 登陆win nt Java远程调用的合法类型(legal types for Java RMI)都有哪些? 一个平行四边形的面积是3.5平方米,和它等底等高的三角形的面积是()平方米 高中数学 椭圆的焦点三角形面积公式为椭圆S=b^2tan(a/2) 其中的b是指短轴长吗? 无论焦点在x轴或y轴吗那么对于双曲线的焦点三角形面积公式呢 其中的b是? 一个平行四边形,面积是九分之八平方米,高二米,这个平行四边形的底是多少米 一个三角形的面积是16平方分米,底是4分米,高与底的比是( ) 怎么用声音辨别汽车发动机是4缸?6岗?8缸?12缸?如题. 告诉我大量关于三角形面积公式继续,不管常用不常用若有推到过程加分(除海伦公式,内切圆) 一个三角形的面积是16分之1平方分米,它的高是2分之1分米,这个三角形的底是多少分米? 求助一个关于汽车发动机排量与缸数的问题打个比方一个5.0升的v10发动机5.0升直列1缸发动机,其他因素都一样,说说在使用中的不同,5.0升直列1缸发动机又没有可能启动不起来 运送液体的车,液体最上方的中间有气泡,当车开动时,气泡向哪运动,刹车时气泡向哪运动 科学家根据星球光谱的红移现象推断宇宙正在膨胀,星球正在离我们越来越远.其实在日常生活中声音也有类似的现象,在火车从我们身边疾驶而过的瞬间,尽管火车发出的汽笛声频率是不变的, 汽车发动机说的冲缸是啥意思~!~!谢谢修车高手~! 如图所示,一个装水的玻璃管中有一个气泡,当玻璃管突然向左运动时,气泡会向()运动,这是因为()具有惯性 饮水机是一种常用的家用电器,其工作电路可简化为如图25所示电路,其中S是温控开关. (1)用公式分析饮水机的加热状态和保温状态. (2)如果饮水机在加热状态时加热板的电功率是400瓦, 如何判断是否冲缸垫 已知三角形三边求面积的公式是? 两个相同容器都盛满水,甲中有一个体积为50cm³,密度为0.5×10³kg/m³的木块漂浮在水面.为什么说,如果把木块全部压入水中两容器底部受水的压力和压强都相等? 用椭圆公式求三角形面积?点P是椭圆x^2/4+y^2/3=1上的一点,F1、F2是它的左右焦点,若角PF1F2=120度,求三角形PF1F2的面积 知道三角形三边怎样求面积?用什么公式? 一条水河流的流量是420m²/min,如果建一水坝,使安装在水坝下的水轮机的功率达到1.4×10的3次方kW,且水的动能转化为水轮机动能的效率为80%,则大坝至少应建多高?(g=10N/kg) 一块梯形玻璃,它的面积是80平方分米,如果下底是9分米,上底是多少?2/1没学 一个平行四边形的面积是128平方分米,底是高的2倍,底是多少分米,高是多少分米? 初中物理一道题,急,在线等.放在一辆足够长表面光滑的平板车上的两个物体,随车一起沿水平方向匀速直线运动,当车突然停止时,这两个物体在车上将会(不考虑一切阻力)A.一定不相碰B.一定 运输液体货物的槽车,液体中有一气泡,如图所示,当车向左加速运动时,气泡相对于槽车向—运动. 写出一个一次函数的表达式,使其图像与两坐标轴围成的3角形面积等于3 关于初中物理的一道题身高1·5米的小明,在某个时刻,灯光下的影长为1·5米.若他以每秒钟1米的速度匀速沿平直路面远离路灯而去,2秒后影长为2米,则路灯离平直路面的高度为( )米 运输液体的槽车,液体上有气泡,当车开动时,气泡将怎么运动;刹车时,气泡将怎么运动,其原因是什么? 已知一次函数的图象经过点(2,2),它与两坐标轴所围成的三角形的面积等于1,求这个一次函数的表达式 初中物理的一道题均匀木板重750牛,长3米.现用两个支点将其支起,一个支点在左端A点,另一个支点距B端距离为一米.为不使木板失去平衡,一重750牛的人在木板上行走的最大范围是多少?我是初二 运送液体货物的槽车,液体上方有气泡,如图所示.当车向右开动时,气泡将向___运动答案是向右,但是我认为,气泡有惯性,运动状态瞬间保持不变,不跟着车向右移动,所以我觉得是向左.气泡也有惯 已知一次函数的图像经过(2.2),它与坐标轴的三角形面积等于1,则这个一次函数表达式是 一个实心的小球分别被放入成有足够水和酒精的容器中,小球受到的浮力分别为0.9和0.8N.已知水和就近的密度之比为5:4.求小球密度 运输液体货物的槽车,液体上有个气泡,当车突然开动时,气泡为什么向前运动? 一次函数Y=-2X+b的图像与两坐标轴所围成的三角形的面积等于4,求此一次函数表达式 平行四边形和一个三角形等底等高三角形的面积是平行四边形的( )平行四边形的面积比三角形面积多( )%急~急~急~急!@ 运输液体的槽车,液体上有气泡,当车开动时,气泡向前运动,为什么? 汽车有几种刹车,我就知道气刹和油刹.还有气刹和油刹原理? 椭圆的焦点三角形面积公式的证明过程 一块平行四边形的玻璃,底为28厘米,高是底2倍.这块玻璃面积是多少平方厘米? 汽车刹车分为机械刹车 油刹车 气刹车 电子刹车 请问现在哪些分别运用了这些系统? 求焦点在y轴上的椭圆上的一动点与两焦点围成的三角形的面积公式假设动点为P,并且角F1PF2=X度,那么ΔF1PF2的面积公式是什么?不需要推导过程! 有一块平行四边形的茶色玻璃,它的底长是15.6分米,高是10分米,这块玻璃的面积是多少?如果每平方米玻璃的价钱是0.50元,买这块玻璃要多少钱? 1.一个平行四边形的高为5.6平方分米,若底不变,高增加1.7平方分米,面积就增加23.8平方分米,那么原面积?A.78.4 B.33.32 C.7.225(直接说答案)2.小明计算除法,把除数54写成45,得到商10,余数36,正确商 椭圆焦点三角形面积公式是啥 一块平行四边形玻璃,面积是20平方米,底是高的5倍,这块玻璃的底对应的高是多少? 一个平行四边形面积是4点5平方分米底5分米高多少分米. 1、一块平行四边形玻璃,底为15米,高为4米,每平方米售价48元.买这块玻璃要多少元?2、已知等腰三角形的周长为16厘米,腰长5厘米,底边上的高是4厘米,三角形的面积是多少? 3、笑笑的书房长是4.2 一块平行四边形的玻璃,底长4cm,高比底短8分之1.这块玻璃的高是多少?面积是多少脑袋坏掉纯属随便乱发 一个平行四边形,若底不变,高减少3分米,面积就减少9平方分米.若高不变,底增加3分米,面积则增加15平方不能列方程 公司新建的门市房要配一批同样大小的平行四边形玻璃,每块底为8dm,高为50cm,每平方分米玻璃价钱为0.28元粗心的小张没有认真计算一下,就带了100元钱去玻璃店, 直角三角形的面积公式怎么计?左边的是7分米,右边有一条斜边的是9分米,底下的是4.8分米,怎么算,这个9用不用算? 下面图中的两个平行四边形的高相等,其中阴影部分的面积是4平方分米,底是2.平行四边形的高是4分米,图形的总面积是多少? 初三物理惯性课后练习题1·把纸条放在桌子上,上面压上一块石子.迅速抽出纸条,石子给随一起运动么?看到什么现象?谢 有一块平行四边形的玻璃,它的底是25dm,高是10dm.已知每平方米的玻璃价格是12元,买这块玻璃要花多少钱? 直角三角形计算公式已知2条边和一个直角有办法求出另一条边么 冬天我的汽车启动后排气管不冒白烟,我看别的车都冒.以前排气管被别人堵过,请问是什么问题? 汽车的玻璃水喷不出来怎么办?早晨开车时使用玻璃水想清洁一下,发现刚刚加过的玻璃水居然喷不出来了,问了同事他们说可能是冻上了,但能看出来罐里是液体.听声音电机也是正常的.是出水 运输液体货物的车,如果车厢中有一气泡,当车启动时,气泡为什么向前运动 一个平行四边形的面积是4分之3平方米,和它等底等高的三角形的面积是多少平方米? 玻璃水是假的车喷水器冻了? 一张平行四边形材质的第一场八分之三米地势高的八分之五,这张平行四边形彩纸的面积是多少平方米?
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn