如题,最好有源码,给个思路也行。

解决方案 »

  1.   

    从网上下载一个控件,放在form上就ok了
      

  2.   

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

  3.   

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

  4.   

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