利用Delphi消息处理建立类似Windows开始菜单
利用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.
- · Delphi中的图形显示技巧
- · Form产生时的事件次序;
- · Delphi中布尔类型辨析
- · AccesS密码的打击
- · Delphi嵌入式汇编一例
- · 在Delphi中实现任意形状的窗体
- · sql server 2005中的DDL触发器
- · asp.net 2.0下嵌套masterpage页的可视化编辑
- · PHP程序加速探索之缓存输出
- · 用C#代码编写的SN快速输入工具
- · (PHP)模板引擎Smarty介绍
- · 用PHP操纵Oracle的LOB类型的数据
- · C# 2.0中泛型编程初级入门教程
- · asp.net 2.0中加密web.config
- · ADO.NET操纵数据库
- · 关于asp.net c#中对cookie的操作
- · asp.net 2.0里当readonly遇上enableviewstate=false
- · C# 2.0与泛型
- · 让3721也无奈的弹出窗口(代码)
- · 玩透9种网页弹出窗口(精)
- · 网站左右两边浮动广告JS代码
- · 一个IP只提示一次设为首页的代码
- · 常用ASP脚本程序集锦*精(适合初学者)
- · 鼠标自动移动/点击
- · PHP程序加速探索之加速工具软件
- · SQLServer2000数据访问基类
- · 图解MySQL数据库的安装和操作
- · 一些ASP初学者常用的代码
- · ASP经典问答收藏之一
- · 一段防注入的通用脚本
- · 简单的防盗链(代码)
- · PHP窜红:革命尚未成功 Java仍需努力
- · 使用PHP编写基于Web的文件管理系统
- · 理解PHP中的MVC编程之控制器
- · 理解PHP中的MVC编程之MVC框架简介
- · SQL Server Express 数据库自动部署问题及解决
- · 用PHP文件上传的具体思路及实现
- · 回顾与展望PHP 5.0的变化与PHP 6.0展望
- · 一个产生中文累计数的代码片断
- · 在SQL Server 2005中解决死锁
- · 30分钟正则表达式指导
- · 不算不知道 44% 数据库开发者使用MySQL
- · 立即释放.net下的com组件
- · XHTML的目标,规则和细节
- · SQL Server 2005 提供的分页查询支持
- · ASP.NET程序中常用的三十三种代码
- · Sql server存储过程和C#分页类简化你的代码
- · SQL Server 2005新功能-TSQL
- · 在SQL Server 2005中编辑SQL Server 2000 DTS
- · .NET 连接到 Oracle的oci.dll加载错误解决方案
- · 如何在调用线程的时候传递参数
- · 专家预言:PHP将比Java更好更受欢迎
- · 在IIS6.0下ASP .NET 的版本冲突问题
- · 解决SqlTransaction用尽的问题(SQL处理超时)
- · 以前编写Like谓词被忽略的使用方法
- · 在编写存储过程时使用 Set NoCount On
- · ASP.NET 2.0运行时简要分析
- · .Net中如何操作IIS(原理篇)
- · 用.net开发不同操作系统下应用的winform的size大小问题
- · SQL Server数据库文件恢复技术

