如何制作动态菜单，提供源代码的有分

Question

如何制作动态菜单，菜单随添加的模块而增加。

Answer 1

procedure TFrmMain.SetupMenu;
var
  MenuItem: TMenuItem;
  ParentMenu: TComponent;
  i, MenuPosition: Integer;
begin
  for i := 0 to AddonMenu.Count - 1 do
  begin
    MenuItem := TMenuItem.Create(Self);  {create an item on the fly}
    with MenuItem do
    begin
     {1=Name,Parent,Caption,Hint,Shortcut,AppTag,BPLName,Index}
      Name := UserTitle(AddonMenu[i], ',', 1);
      Caption := UserTitle(AddonMenu[i], ',', 3);
      Hint := UserTitle(AddonMenu[i], ',', 4);
      if UserTitle(AddonMenu[i], ',', 5) <> EmptyStr then
        Shortcut := TextToShortCut(UserTitle(AddonMenu[i], ',', 5));
      Enabled := True;
      Visible := True;
      Tag := i;
{      if UserTitle(AddonMenu[i], ',', 2)='pmSend' then
        OnClick := btnToolBarClick
      else                                             }
        OnClick := MenuOnClick;  {assign OnClick event}
      if UserTitle(AddonMenu[i], ',', 2) = EmptyStr then
        ParentMenu := nil
      else
        ParentMenu := Self.FindComponent(UserTitle(AddonMenu[i], ',', 2));
    end;
    MenuPosition:=StrToIntDef(UserTitle(AddonMenu[i], ',', 8),0);
    if ParentMenu = nil then
    begin
      MenuPosition:= mnuMain.Items.Count - MenuPosition;
      if MenuPosition<0 then MenuPosition:= mnuMain.Items.Count;
      mnuMain.Items.Insert(MenuPosition , MenuItem);
    end
    else
    begin
      if ParentMenu is TMainMenu then
      begin
        MenuPosition:= TMainMenu(ParentMenu).Items.Count - MenuPosition;
        if MenuPosition<0 then MenuPosition:= TMainMenu(ParentMenu).Items.Count;
        TMainMenu(ParentMenu).Items.Insert(MenuPosition , MenuItem);
      end
      else if ParentMenu is TPopupMenu then
           begin
             MenuPosition:= TPopupMenu(ParentMenu).Items.Count - MenuPosition;
             if MenuPosition<0 then MenuPosition:= TPopupMenu(ParentMenu).Items.Count;
             TPopupMenu(ParentMenu).Items.Insert(MenuPosition , MenuItem);
           end
      else
      begin
        MenuPosition:= TMenuItem(ParentMenu).Count - MenuPosition;
        if MenuPosition<0 then MenuPosition:= TMenuItem(ParentMenu).Count;
        TMenuItem(ParentMenu).Insert(MenuPosition,MenuItem);
      end
     end;
  end;
end;AddonMenu是一个TStringList的数量，用于存放读取的Ini文件的菜单内容。
Ini内容如下：
;Index=Name,Parent,Caption,Hint,Shortcut,Action,ServiceID,MenuItemIndex counting from the end
[Tools_MENU]
Tools01=mniTools01,,Tools,PC Tools,,,,2
Tools02=mniTools02,mniTools01,File Handle...,,,,Tools
Tools03=mniTools03,mniTools01,-,
Tools04=mniTools04,mniTools01,Mail &Handle...,Sent and Receive Mail,,,,Tools
Tools05=mniTools05,mniTools02,File &Separate...,File Separate,,1,Tools
Tools06=mniTools06,mniTools02,File &Merge...,File Merge,,2,Tools
Tools07=mniTools07,mniTools01,Ma&tch Files...,Match File,,4,Tools
Tools08=mniTools08,mniTools01,Set &Desktop...,Set Desktop,,5,Tools
Tools09=mniTools09,mniTools01,-,
Tools10=mniTools10,mniTools01,Computed&Tax...,Computed need to pay tax,,6,Tools
Tools11=mniTools11,mniTools01,Remind &Work...,Remind your working,,7,Tools
Tools12=mniTools50,Start1,Se&ndMail...,New a mail,,3,Tools
Tools14=mniTools13,mniTools04,&Send Mail,Send Mail,,3,Tools
Tools15=mniTools14,mniTools04,&Receive Mail,Receive mail,,9,Tools
Tools16=mniTools15,mniTools01,&Multiple Chat...,Multiple user chat synchronously,,,Tools
Tools17=mniTools16,mniTools15,Chat &Server...,Chat Server,,10,Tools
Tools18=mniTools17,mniTools15,Single Chat...,Chat Client,,11,Tools
;Tools19=mniTools18,mniTools15,Chat Clien&t...,Chat Client,,12,Tools

Answer 2

创建菜单就可以了 找到菜单的class用语句闯进create

Answer 3

unit Menu;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    HotKey1: THotKey;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
     procedure MyPopUpHandler(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  MyMainMenu: TMainMenu;
  MyPopUpMenu: TPopUpMenu;
  MySubItems: array[0..3] of TMenuItem;
  MyPopUpItems: array[0..3] of TMenuItem;
  i: integer;implementation{$R *.dfm}
procedure TForm1.MyPopUpHandler(Sender: TObject);
begin
  with Sender as TMenuItem do
    ShowMessage(Caption);
end;//创建主菜单
procedure TForm1.Button1Click(Sender: TObject);
var
  MyItem: array[0..2]of TMenuItem;
begin
  MyMainMenu:= TMainMenu.Create(self);
  for i:= 0 to 2 do
  begin
    MyItem[i]:= TMenuItem.Create(self);
    MyItem[i].Caption := '子菜单'+IntToStr(i)+'(&'+IntToStr(i)+')';
    MyMainMenu.Items.Add(MyItem[i]);
  end;  for i:= 0 to 3 do
  begin
    MySubItems[i]:= TMenuItem.Create(self);
    MySubItems[i].Caption := '主菜单项'+IntToStr(i)+'(&'+IntToStr(i+1)+')';
    MyMainMenu.Items[0].Add(MySubItems[i]);
    MySubItems[i].OnClick := MyPopUpHandler;
  end;  MySubItems[1].Caption := '-';
  MySubItems[3].Break := mbBarBreak;
end;
//创建弹出式菜单
procedure TForm1.Button2Click(Sender: TObject);
begin
  MyPopUpMenu:= TPopUpMenu.Create(self);
  for i:= 0 to 3 do
  begin
    MyPopUpItems[i]:= TMenuItem.Create(self);
    MyPopUpItems[i].Caption := '弹出菜单'+IntToStr(i)+'(&'+IntToStr(i)+')';
    MyPopUpMenu.Items.Add(MyPopUpItems[i]);
    MyPopUpItems[i].OnClick := MyPopUpHandler;
  end;
end;
//显示
procedure TForm1.Button3Click(Sender: TObject);
begin
  MyPopUpMenu.Popup(Form1.Left+60, Form1.Top+60);
end;end;