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

这里有一篇文章! 上面图片是这些代码对照图片。 在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! 还有几个相似的组件都可以做出眩目的效果,可惜不记得名字了,呵呵!