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

利用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.

北森CTO张庆化:利用Spark实现数据驱动价值 大公网冯咀志:站内搜索系统的PowerLinux迁移实践 2014移动开发者必备的十大应用测试工具 前《连线》主编Chris Anderson:创客就要DIT UC多屏战略 推出电脑版和电视版浏览器 “全国云计算大数据创新项目评选”征集活动正式启动 【走近院士】李伯虎:云制造技术的应用及发展 一周热点: Twitter的下一代分布式数据库Manhattan 专访微软陆奇:大转型中最难的是文化的改变 【CTO俱乐部走进腾讯】问题征集进行中 颠覆移动营销世界的女王Yunha Kim为女性CEO正名 Google揭露“仙女座”虚拟网络,及分散和集中架构之辩 DHTMLX Touch:开源的HTML5和JavaScript框架 Supercell下一城:《海岛奇兵》续写芬兰手游传奇 开发者盛宴 2014 Unity亚洲开发者大会盛大开幕 微软全球中国云业务总经理:云落地中国的最大难题 PTVS 2.1 Beta版发布 Visual Studio的Python工具 【走近院士】李兰娟:云计算与大数据将成为医疗改革利器 迭代不等于学习,聚类分析也不等于机器学习 Office大肆杀戮,已攻下Chrome Web Store Bug都补好了?Google发布Android 4.4.3更新 微软被传收购Xamarin 强势推进移动新战略 挑战传统金融业务 Facebook进军移动支付领域 亚马逊AWS需解决的五项问题 腾讯自曝:大数据平台的秘密 继Cloudera之后,MapR宣布对Spark的完全支持 企业实施商务智能的6个致命错误 《近匠》HBuilder:如何用JS调用几十万原生API? littleBits新推Cloud Module,普通人也能DIY智能硬件 如何创建浮动式标签模式? Office 365正式落地中国——移动为先,云为先 《根据数据库表中记录自动构造一棵结构树的一种高效算法》的原程序怎么用? NetBios在Windows98、WindowsNt、Windows2000中的编程差异! 求一个能批量修改目录名和文件名的工具 推荐mobbs当斑竹,大家来支持巴 Is Oracle Free? 在单机上调试WINSOCK网络程序也不好使呀,该怎么办??谢谢!!! 有没有对机器要求不高的c#的编译器? NetScape 4.7 !!! 如何把这个delphi程序移到vc++上?? 没 找到工作来送分…! 刚下了个installshield,请问怎样做一个数据库的安装盘? 关于Midas的一个简单问题,高手来指点指点 直接调用函数和通过CLASS调用函数有什么区别吗? 可以在atl中使用mfc的消息机制吗? 救命!!!!!了各位(大GG,JJ,MM,DD)帮下忙 这是什么错误??? ★★请教AVI文件的API函数★★(关于将位图存成avi时写入的一点问题:急问) 请问各位大大北大青鸟APTECH认证培训有什么优缺点,对找工作有帮助吗? 我想通过点击SELECT里的内容之后打开一个新窗口,应该怎么写?里面有代码,怎么修改? 这有人用VB做嵌入式开发吗? 朋友,帮帮我,About python C 需要一个方法去判断?谁能说说? 请问各位大大北大青鸟APTECH认证培训有什么优缺点,对找工作有帮助吗? 在DELPHI 6中怎样在TADODatset中 锁定一条记录,使它不能移动? 请教:rmi中的server为什么不能注册? 要在机房度过24小时!问:怎么过?(null) 我要在 dos 下用语言描一正玄波形想请教除了描点还有什么好的办法 能不能用PHP在图片上写汉字?!?! 我用<a href="Javascript:History.go(-1);">back</a> 提示 :运行出现错误 ,history 未定义。怎么办? 老问题:为何连接sql anywhere数据库时出现unable to connect database server:unable to start specified database. 一个困扰了我很久的问题,关于对话框关闭的问题! 怎样得到Windows系统的临时路径. 愿用1000求解的,高深问题??? test 关于数据库设计中的权限管理问题? 过六一了,节日快乐!为庆祝塞内加尔胜利散200分 请问!如何对一文本文件一次一行的读出!!! 如何制作类似于marquee的效果 编译问题:为何第一次编译总是出现如下问题? 这段程序我是从书上抄下来的,请问这么会语法错误,100分 100分求如何响应鼠标离开的事件 Delphi的帮助用得我真难受:( 数据库软件在我的机上正常,但在其他机上不正常? 谁有地方下《Delphi高级开发指南》的电子书? 请介绍一下如何在vc++6.0中使用msxml 编译问题:为何第一次编译总会出现以下问题? 将分组字段作为输入参数的存储过程咋写? 怎么样对一个查询结果的某字段作汇总? 报表啊!!!报表。。。----:::::::::::::((((((((((((((((( delphi用BDE控件的SQL语句建立的dbf表,或者batchmove产生的dbf表,无法被其他软件识别,比如foxpro,excel.请问如何解决该问题,在线等待 这是什么原因产生地 汽车电路怎么维修我是学修车的 对电路也懂一点 但是维修起来感觉力不从心 比如说一辆车开空调电子风扇不转 我该从哪查起呢 功率放大三极管工作在何种状态 ABS电镀和不锈钢有什么区别? 我找了个汽车电路维修的师傅教,学大卡车,铲土机那些的,现在学晚吗?我的朋友有的说好有的说不好,学两年的时候且没有工资,我之前是想学汽车的,别人说先学大车先,好多朋友说学完已经晚 EXCEL求公式,描述如下有一列数字,是公式得出来的,假设公式是***现在需要:把所有大于15的数字都变成红色,把所有小于5的数字变成蓝色,并且变成5 我家里的铜生锈了啊?会生锈的不是铁吗? 汽车电路修理我有一辆货车,现在突然天冷了,想开一下暖风,增加一下驾驶室的温度,.下面水管都好的,开关也是通的,拔下皮管有热水流出,可就上面小水箱是晾的,风扇也是好的.吹出来的风很冷 请问这个EXCEL公式怎么表达求V5=H2-H3+H4,条件1:当V5>16的话,-16 条件2:当V5 arcgis怎么用随机坐标画地形图 对MOS管冲击电流要求 今天大连天气晴朗吗?还是下雨? 怎么用arcgis在专题地图中添加饼状图每个区域的人口性别,成分想用饼状图, 电力系统中的无功电流 有功电流的含义,最好能联系发电机讲解下,现在分低,但一定会追加的昂 若电池反应:Cu + 2H+ ==H2 + Cu2+1.该池属于____(电解、原电)池.2.写出各电极的材料和电解质溶液我的答案是:1.2.铜棒阳极 碳棒阴极 硫酸铜作电解液请回答:1.我的答案对么 开水重复烧有坏处吗?隔夜的茶叶茶能喝吗,听说隔夜茶能致癌,不知道是不是真的 mos管在电路中应用如题,不知道有啥具体应用,能用最通俗的语言介绍下嘛,最好能介绍点可以怎么使用的易懂的模块应用, 电解CuCl2和NaCl的混合溶液,阴极和阳极上分别析出的物质是( )A H2和Cl2 BCu和Cl2C Cu和O2D H2和O2 有一支温度计刻度不准,将温度计放在冰水混合物中时的读数是-3摄氏度,放在一标准气压下沸水97摄氏度若放在空气中的读数是20摄氏度,则空气实际温度是 关于电力系统,有功无功的理解这样算正确吗?看你几个无功的解释,感觉就是一个拿板砖砸人的例子最形象,说:拿板砖砸人,首先要把板砖举起来,然后再拍.举起板砖可以看做是无功,拍的时候 盐酸酸洗后表面易生锈 怎么能解决呢? 杜甫最简单的诗 如何用CAD画下面的电路图?(有图)我现在用的是2004中文版的CAD,下面是星三角电路图的左边一小部分,下面带箭头的“空气开关”和“接触头”两部分怎么画?因为我看书很多都看不懂,现在只 惰性电极电解硫酸铜溶液,测得导线上通过0.2mol电子,那么溶液的ph值怎么算? 土地石漠化的原因麻烦大家用地理学中关于土壤形成的相关知识解释土地石谟化的原因.谢谢!~ CAD图纸 电气设计说明图电气设计说明图 符号“AL1” “AL2” "ALF"是什么意思啊,这几个符号一般都在图的左上角,并且字母下面有几条横线 铜绿中滴盐酸可观察到_______和_______.铜器在潮湿的空气中容易生锈,如何去除铜器表面的锈__________ 杜甫有哪些诗? 藏地高原在西藏的哪个位置 做汽车驱动桥设计时,半轴长度是如何确定 的呀? 杜甫的诗杜甫描写自己生活贫困的诗句(除了《茅屋为秋风所破歌》)谢谢! 谁有高原的介绍? 电压和电流关系有电压是否有电流,有电流是否有电压 啥叫土地石漠化讲得简单点让我这个低智商高中生能看懂谢啦 高原藏族血压高还是低 国内做纯实木地热地板最好的是哪个品牌? 形容陈设或者建筑物富丽堂皇,光彩夺目的词语 我国表藏高原的形成是什么原因 在反射弧中神经中枢受损导致既无感觉也无效应这句话对吗? 形容建筑物异常华丽,光彩夺目 这个的词语是神魔? 什么在现代生活中具有重要作用.电流通过用电器后,电能可以转化成 开关电源带负载时为什么得降低MOS管的开关频率?此设计为PWM控制的推挽式开关电源,空载频率可达100KHZ,满载频率可达30KHZ.为什么加大负载必须降低频率呢? 利用mapGIS或arcGIS进行地形位指数分析(只有一张MAPgis工程图)本研究中选用地形位指数作为评价地形的指标.首先建立东坡区数字高程模型,从中提取高程、坡度,然后采用式①进行合成,得到地 几首诗中蕴含的人生哲理列出几首诗 并说说其中的哲理 谢谢了~ 藏族人很喜欢汉族的人吗?听他们说的,如果是的话原因在哪里? 反射弧的神经中枢处受损有感觉吗?= - 学校老师把我搞懵了.求正确的解. 电力容器的主要作用 功率因数 透过蓝色眼镜看白色的纸,纸是什么颜色?为什么? 柴油车启动后关闭电源总开关会有什么后果?会不会烧坏全车线路? 求一首很有哲理的诗歌? 藏族女人与汉族女人的不同西藏的女人和内地的女人有什么不同呀!比如说在物质方面的追求,在精神方面的追求. 是否存在一个温度值使华氏温度计和摄氏温度计的读数一样?若有 该温度值是多少?求详解 藏头新年祝诗(张娜璇) 我是汉族,老婆是藏族,小孩可以是藏族吗? 求汽油车发电机电路图小解放488发动机的发电机不发电,电瓶指示灯不亮, 一课三练藏族人是怎样过藏历新年的? 我是藏族可以改为汉族吗妈妈是汉族爸爸藏族.我和妈妈一个户口爸爸另外一个.我想高考后改成汉族可以吗会不会资料已经入方案改了后会麻烦.明年高考我现在可以改吗.如果现在改高考会不 隔夜的开水,再次烧开能用吗? 新春藏头诗那位帮忙给我写个藏头诗啊 就用“新”“春”“快”“乐”吧 W20NK50Z MOS管可以工作在放大状态吗?他的频率是多少? 一只温度计,刻度均匀,但读数不准,沸水95摄氏度,冰水6摄氏度,室内温度32摄氏度,实际多少摄氏度
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘