收藏 不显示删除回复显示所有回复显示星级回复显示得分回复 如何绘制类似于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

续上部分!!
);//填充这种颜色，很特别吧？这是我用自己的程序截到的菜单中的一种颜色值，大家不信就看看效果，估计微软的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日傍晚
                                                     

至于效果图片由于这里复制不了,所以只好作罢!
如果使用组件的话有MenuXP组件,你可以看看它的代码,其实道理都是一样的,他将自己的事件代码交给枚举到窗口的menu组件的DrawItem并设置menu组件的OwnerDraw为true!
还有几个相似的组件都可以做出眩目的效果,可惜不记得名字了,呵呵!