分享
 
 
 

利用Delphi消息处理建立类似Windows开始菜单

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

www.applevb.com

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有