您的位置：首页 > 其它

收藏 不显示删除回复显示所有回复显示星级回复显示得分回复 如何绘制类似于Windows开始菜单的菜单

2010-06-18 11:53 471 查看
这里有一篇文章!
上面图片是这些代码对照图片。
在Delphi中做这种菜单关键就在于怎么画分隔符，因为分隔符在属性面板我们是输入“-”表示的，但在delphi中它却不是按普通字符处理的，打开库源代码可以看到，它是将“-”转化为系统中真正的分隔符，它的类型（MenuItemInfo）是MFT_SEPARATOR而一般的字符串的类型是MFT_STRING的，所以我们在重画的时候就要注意，否则会出现1的那种情况，因为分隔符不要用一般的重画过程，如果这样处理它会割断图片，如果我们按字符串形式（和其他菜单项一样看待）呢？那么它会画成图2的样子，怎么画成图3的样子呢？我们这里用个小的技巧，不要系统处理，我们来自己画它！
下面是全部代码：（可能由于这里的断行问题，你要仔细看哟）
只是在我认为重点的部分加了部分注释！
unit Myapp;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, StdActns, ExtActns, ActnList, StdCtrls;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
ActionList1: TActionList;
FileOpen1: TFileOpen;
FileSaveAs1: TFileSaveAs;
FileRun1: TFileRun;
FileExit1: TFileExit;
file1: TMenuItem;
Open1: TMenuItem;
Run1: TMenuItem;
SaveAs1: TMenuItem;
Exit1: TMenuItem;
Image1: TImage;
N1: TMenuItem;
Image2: TImage;
procedure Open1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure Run1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
procedure SaveAs1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure Exit1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure Open1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure Run1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
Height: Integer);
procedure SaveAs1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure Exit1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure N1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
procedure N1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
Height: Integer);
procedure file1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);

private
{ Private declarations }
public
procedure DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean;StrOut:String);//这是画菜单的函数
procedure MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer;StrOut:String);//这是定位菜单的函数
procedure DrawItem1(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);//这是画分隔符的函数
procedure MeasureItem1(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);//这是定位分隔符的函数
{ Public declarations }
end;

var
Form1: TForm1;
i,ih,ind,iw,irate:integer;
rtemp:trect;
ig1,ig2:integer;
canvas1:tcanvas;
implementation

{$R *.dfm}

procedure TForm1.DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean;StrOut:String);
var j,q:integer;
begin
q:=file1.Count;
i:=arect.Bottom-arect.Top;
ind:=TMenuItem(sender).MenuIndex;
ih:=round(image1.Height/q*ind);
OffsetRect(ARect,0,0);
stretchBlt(acanvas.Handle,arect.Left,arect.Top,iw,i,image1.Canvas.Handle,0,ih,image1.Width,round(image1.Height/q),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;
acanvas.Brush.Style:=bsclear;
acanvas.TextOut(arect.Left+iw+5,arect.Top,strout);
end;

procedure TForm1.DrawItem1(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
var q:integer;
begin
q:=file1.Count;
i:=arect.Bottom-arect.Top;
ind:=TMenuItem(sender).MenuIndex;
ih:=round(image1.Height/q*ind);
OffsetRect(ARect,0,0);
stretchBlt(acanvas.Handle,arect.Left,arect.Top,iw,i,image1.Canvas.Handle,0,ih,image1.Width,round(image1.Height/q),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;
end
else
begin
acanvas.Brush.Color:=clBtnFace;//第一层为系统颜色
rtemp:=arect;
rtemp.Left:=rtemp.Left+iw+3;
rtemp.Right:=arect.Right-3;
acanvas.FillRect(rtemp);
acanvas.Font.Color:=clMedGray;
end;
acanvas.Brush.Style:=bsSolid;
OffsetRect(rtemp,0,2);//下移2象素
acanvas.Brush.Color:=rgb(128,128,128
对我有用[0]

丢个板砖[0]

引用

举报

管理

TOP

精华推荐：Delphi下的轻量级IoC容器 - Elite Container (Demo 0.1版)



sundytu

(涂飞平)

等　级：


#4楼 得分：0回复于：2004-04-08 22:07:52

续上部分!!
);//填充这种颜色，很特别吧？这是我用自己的程序截到的菜单中的一种颜色值，大家不信就看看效果，估计微软的API中也是用这种颜色来画分隔符的。截颜色的程序大家想要的话可以找我：tufeiping@vip.sina.com。
acanvas.FillRect(rtemp);
OffsetRect(rtemp,0,1);
acanvas.Brush.Color:=rgb(225,225,225);//填充白色，造成立体效果！
acanvas.FillRect(rtemp);
acanvas.Brush.Style:=bsSolid;
OffsetRect(rtemp,0,2);
acanvas.Brush.Color:=clBtnFace;//最下面还是填充原来的颜色
acanvas.FillRect(rtemp);
acanvas.Brush.Style:=bsSolid;
end;

procedure TForm1.MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer;StrOut:String);
var q:integer;
begin
q:=file1.Count;
height:=acanvas.TextHeight(strout)+5;
width:=acanvas.TextWidth(strout)+50;
irate:=round(image1.height/(height*q));
iw:=round(image1.width/irate);
width:=width+iw;
end;

procedure TForm1.MeasureItem1(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
var q:integer;
begin
q:=file1.Count;
height:=acanvas.TextHeight( ' ')+5;
width:=acanvas.TextWidth( ' ')+50;
irate:=round(image1.height/(height*q));
iw:=round(image1.width/irate);
width:=width+iw;
end;

procedure TForm1.Open1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,open1.Caption);
end;

procedure TForm1.Run1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,run1.Caption);
end;

procedure TForm1.SaveAs1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,saveas1.Caption);
end;

procedure TForm1.Exit1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,exit1.Caption);
end;

procedure TForm1.Open1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
MeasureItem(TMenuItem(Sender), ACanvas,Width,Height,open1.Caption);
end;

procedure TForm1.Run1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
MeasureItem(TMenuItem(Sender), ACanvas,Width,Height,run1.Caption);
end;

procedure TForm1.SaveAs1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
MeasureItem(TMenuItem(Sender), ACanvas,Width,Height,saveas1.Caption);
end;

procedure TForm1.Exit1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
MeasureItem(TMenuItem(Sender),ACanvas,Width,Height,exit1.Caption);
end;

procedure TForm1.N1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
DrawItem1(TMenuItem(Sender),ACanvas,ARect,Selected);
end;

procedure TForm1.N1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
MeasureItem1(TMenuItem(Sender),ACanvas,Width,Height);
end;

procedure TForm1.file1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);//最后一个函数是画主菜单选择时的背景的
var rect:trect;
begin
if selected then
begin
acanvas.Brush.Color:=clblack;
rect:=arect;
rect.Left:=rect.Left;
acanvas.FillRect(rect);
acanvas.Font.Color:=clwhite;
end
else
begin
acanvas.Brush.Color:=cl3dlight;
rect:=arect;
rect.Left:=rect.Left;
acanvas.FillRect(rect);
acanvas.Font.Color:=clblack;
end;
acanvas.Brush.Style:=bsclear;
acanvas.TextOut(arect.Left+5,arect.Top, '&File... ');//这里只是直接给出主菜单第一项的名字，可以写成一个函数，然后所有菜单都可以调用它，这里也偷懒一下，有兴趣的朋友自己可以写。
end;

end.
最后要注意将你的菜单的OwnerDraw属性改为：true，不然你写再多的代码，程序也不会自己画菜单的，呵呵。
原理就时这样的，大家有兴趣可以将它写成一个组件（应该不难的），那样就可以放在网上大家用了，还避免的重复写那么多代码，不是吗？
由于是直接使用自己程序中的代码（我这个人写程序想怎么写就怎么写），一点都不规范!

晶晶
2003年3月31日傍晚

对我有用[0]

丢个板砖[0]

引用

举报

管理

TOP

精华推荐：DELPHi编写的超酷时钟



sundytu

(涂飞平)

等　级：


#5楼 得分：0回复于：2004-04-08 22:12:39

至于效果图片由于这里复制不了,所以只好作罢!
如果使用组件的话有MenuXP组件,你可以看看它的代码,其实道理都是一样的,他将自己的事件代码交给枚举到窗口的menu组件的DrawItem并设置menu组件的OwnerDraw为true!
还有几个相似的组件都可以做出眩目的效果,可惜不记得名字了,呵呵!
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 点击这里给我发消息
标签： 
相关文章推荐
新的分享
章节导航