美化你的菜单
TechnoFantasy
www.applevb.com
Windows下的很多程序都有十分漂亮的菜单，例如Windows“开始”菜单左方从上到下的长条形的Windows
Banner 又或者是向Word那样在每一个菜单条左边都有一个小图标，看到这些很Cool的菜单，你是否觉得自己的
菜单显得单调乏味呢？不需要第三方控件，利用Delphi就可以实现上面的功能。
如果要实现自定义菜单就需要在绘制菜单时改变菜单的大小以适应在菜单上绘制图形，然后再在上面绘制自
己所需要的菜单效果。在Delphi中，每一个菜单项对应一个TmenuItem控件，这类控件都有两个事件：OnDrawIt
em和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制定菜单的绘制区域，参数Selecte
d定义当前菜单项是否被选中。
从上面的介绍可以看到，要实现自定义的菜单，只要在OnMeasureItem事件中编写代码改变菜单项的尺寸，然后
在OnDrawItem事件中绘制自己需要的效果就可以了。
下面我痛过具体的范例来做说明，这个范例是使自己的菜单实现象Windows开始菜单一样的显示Banner条的功能
。同时这个程序还能实现对被选中的菜单条进行渐变色填充（就象3721中文网址软件的任务栏菜单那样）。程
序的思路是这样的，首先建立一个长条型的位图，然后在每一个菜单条的OnMeasureItem事件中根据要显示在菜
单上的文本和图像以及程序的需要改变菜单项的宽度和高度，然后在OnDrawItem事件中将位图中的相应部分拷
贝到菜单项上。如果该菜单条被选中，首先要改变Acanvas参数的画刷颜色，然后再依次填充菜单条上的相应部
分，这样就实现了对选中的菜单条实现渐变色填充。最后将文本输出到菜单条上。
下面来介绍具体的程序，首先利用图像软件建立一个长条型的位图文件（你可以根据你的需要设定图像的高宽
比，在我的图像中是10:1）。在Delphi中建立一个新的工程，在Form1中加入一个TImage控件，将控件的AutoSi
ze属性设置为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.
-----------------------------
在网上有很多文章都提到怎样在菜单中加入背景图片，可是都没有一个完整的回答，也没有一个比较完整的例
子。当然csdn曾经有一个高人说过这个问题，而且在程序员大本营2000版中也有收藏。我参考了一些方法和技
巧，当然包括国外的了，写下了如下的代码，希望能够满足大家的要求，不过不是很完善，如果有哪位大侠修
改过，不妨也将修改过的代码贴出来，大家共享！为了在menu控件中加入背景图片，没有直接的方法，都的靠
自己动手画，因为menu控件没有canvas属性，所以只能自己动手了！这个东西我也是菜鸟一只，说不出什么高
深的东西，如果有什么问题可以发信给我，我们共同探讨：cqwty@sina.com，源代码如下：
unit FMain;
interface
uses
Windows, Graphics, Forms, Menus, Classes;
type
TfrmMain = class(TForm)
mnuPopup: TPopupMenu;
MainMenu1: TMainMenu;
sdfsdf1: TMenuItem;
sdfsdf2: TMenuItem;
dfgdfg1: TMenuItem;
dfgdfg2: TMenuItem;
N1: TMenuItem;
werwer1: TMenuItem;
procedure DrawMenu(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
procedure MeasureMenu(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
end;
var
frmMain: TfrmMain;
bmp1:tbitmap;
implementation
{$R *.DFM}
procedure TfrmMain.DrawMenu(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State:
TOwnerDrawState);
var
cTemp: TCanvas;
sText: String;
mWnd: HWND;
rMenu: TRect;
begin
ACanvas.BrushCopy(ARect, bmp1, ARect, clBlack);
ACanvas.Brush.Style := bsclear;
sText := TMenuItem(Sender).Caption;
acanvas.Font.Color:=clred;
with ACanvas do begin
if odSelected in State then begin
pen.Style:=psInsideFrame;
Brush.Color := RGB(110, 131, 184);
Pen.Color := RGB(47, 60, 93);
Rectangle(ARect);
end;
if sText = '-' then begin
// Draw line
ACanvas.Pen.Color := RGB(0, 0, 0);
MoveTo(ARect.Left, ARect.Top + ((ARect.Bottom - ARect.Top) div 2));
LineTo(ARect.Right, ARect.Top + ((ARect.Bottom - ARect.Top) div 2));
end else begin
// Draw text
Inc(ARect.Left, 12);
DrawText(Handle, PChar(sText), Length(sText), ARect, DT_LEFT or DT_VCENTER or
DT_SINGLELINE);
end;
end;
// 画边框的，效果是平面的
mWnd := WindowFromDC(ACanvas.Handle);
if mWnd <> Self.Handle then begin
cTemp := TCanvas.Create();
cTemp.Handle := GetDC(0);
Windows.GetWindowRect(mWnd, rMenu);
cTemp.Brush.Color := RGB(120, 120, 120);
cTemp.FrameRect(rMenu);
InflateRect(rMenu, -1, -1);
cTemp.Brush.Color := RGB(240, 240, 240);
cTemp.FrameRect(rMenu);
InflateRect(rMenu, -1, -1);
cTemp.FrameRect(rMenu);
ReleaseDC(0, cTemp.Handle);
cTemp.Free();
end;
end;
procedure TfrmMain.MeasureMenu(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
Inc(Width,50);//调整菜单的宽度
inc(height,15);//调整每一个item的高度，这一句可以不要，使用默认值
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
bmp1:=tbitmap.Create;
bmp1.loadfromfile('e:/aaa.bmp');
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
bmp1.Free;
end;
end.
236
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
