如何动态生成菜单并加事件

Question

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, DB, ADODB, Grids, DBGrids;type
  TNotifyEvent = procedure (Sender:TObject) of Object;
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    Q_MenuItem: TADOQuery;
    procedure FormCreate(Sender: TObject);
    procedure NewForm2(Sender :TObject);
    procedure NewForm3(Sender :TObject);
  private
    { Private declarations }
    procedure CreateMainMenu;
    procedure GetMenuItemData(RootID :Integer);
    procedure GetHeadItemData;
    procedure CreateMenuItem(RootID :Integer);
    procedure AddMenuItem(RootID,ParentID :Integer);
    function FindItem(RootID,ID:Integer):TMenuItem;
  public
    { Public declarations }
    procedure MenuItemClickEvent(Tag :Integer);
  published
    { published declarations }  end;var
  Form1: TForm1;
  OnClick :TNotifyEvent;
implementationuses Unit2, Unit3;
procedure ExecSQL(Sender:TADOQuery; sSQL :string);
begin
  with Sender do
    begin
      Active :=False;
      SQL.Clear;
      SQL.Add(sSQL);
      Active :=True;
    end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateMainMenu;
end;procedure TForm1.GetMenuItemData(RootID: integer);
var sSQL :string;
begin
  sSQL :='Select ID,ItemName,ItemCaption, ItemOrder,ImageIndex,ParentID,RootID,Tag,IsCheck,IsEnable,IsVisible,ShortCut,ClickEvent From SR_SYS_MAINMENU Where '+
      'IsRoot=0 and RootID='''+IntToStr(RootID)+''' Order by ItemOrder ';
  ExecSQL(Form1.Q_MenuItem,sSQL);
end;procedure TForm1.GetHeadItemData;
var sSQL :string;
begin
  sSQL :='Select ID,ItemName,ItemCaption, ItemOrder,ImageIndex,Tag,IsCheck,IsEnable,IsVisible,ShortCut,ClickEvent From SR_SYS_MAINMENU Where '+
      'IsRoot=1  Order by ItemOrder ';
  ExecSQL(Form1.Q_MenuItem,sSQL);
end;procedure TForm1.CreateMainMenu;
var MainMenu: TMainMenu;
    MenuItem :Array of TMenuItem;
    i,HeadCount :integer;
begin
   MainMenu:= TMainMenu.Create(Self);
   MainMenu.AutoHotkeys :=maManual;
   MainMenu.AutoLineReduction :=maManual;
   // Create HeadMenu
  GetHeadItemData;
  HeadCount :=Q_MenuItem.RecordCount;
  SetLength(MenuItem,HeadCount);
  for i :=0 to HeadCount-1 do
    begin
      MenuItem[i] :=TMenuItem.Create(Self);
      MenuItem[i].Name := Trim(Q_MenuItem.FieldByName('ItemName').AsString);
      MenuItem[i].Caption := Trim(Q_MenuItem.FieldByName('ItemCaption').AsString);
      MenuItem[i].ImageIndex :=Q_MenuItem.FieldByName('ImageIndex').AsInteger;
      MenuItem[i].Tag:=StrToInt(Trim(Q_MenuItem.FieldByName('Tag').AsString));
      MenuItem[i].Checked :=StrToBool(Q_MenuItem.FieldByName('IsCheck').AsString);
      MenuItem[i].Enabled :=StrToBool(Q_MenuItem.FieldByName('IsEnable').AsString);
      MenuItem[i].Visible :=StrToBool(Q_MenuItem.FieldByName('IsVisible').AsString);
      MenuItem[i].ShortCut :=TextToShortCut(Trim(Q_MenuItem.FieldByName('IsVisible').AsString));
      MainMenu.Items.Add(MenuItem[i]);
      Q_MenuItem.Next;
    end;
  //Create MenuItem
  for i :=0 to HeadCount-1 do
    CreateMenuItem(i);end;procedure TForm1.CreateMenuItem(RootID: Integer);
var MenuItem :TMenuItem;
    i,ItemCount,ParentID :integer;
begin
  GetMenuItemData(RootID);
  ItemCount :=Q_MenuItem.RecordCount;
  for i :=0 to ItemCount-1 do
    begin
      ParentID :=Q_MenuItem.FieldByName('ParentID').AsInteger;
      MenuItem :=TMenuItem.Create(Self);
      AddMenuItem(RootID,ParentID);
      Q_MenuItem.Next;
    end;
end;procedure TForm1.AddMenuItem(RootID,ParentID :Integer);
var ParentItem,MenuItem :TMenuItem;
    P: ^Integer;
begin
  ParentItem :=FindItem(RootID,ParentID);
  if ParentItem <> nil then
    begin
      MenuItem :=TMenuItem.Create(Self);
      MenuItem.Name := Trim(Q_MenuItem.FieldByName('ItemName').AsString);
      MenuItem.Caption := Trim(Q_MenuItem.FieldByName('ItemCaption').AsString);
      MenuItem.ImageIndex :=Q_MenuItem.FieldByName('ImageIndex').AsInteger;
      MenuItem.Tag:=StrToInt(Trim(Q_MenuItem.FieldByName('Tag').AsString));
      MenuItem.Checked :=StrToBool(Q_MenuItem.FieldByName('IsCheck').AsString);
      MenuItem.Enabled :=StrToBool(Q_MenuItem.FieldByName('IsEnable').AsString);
      MenuItem.Visible :=StrToBool(Q_MenuItem.FieldByName('IsVisible').AsString);
      MenuItem.ShortCut :=TextToShortCut(Trim(Q_MenuItem.FieldByName('IsVisible').AsString));
      P :=MethodAddress(Trim(Q_MenuItem.FieldByName('ClickEvent').AsString));
      OnClick :=P^;//这里有错误该如何解决
      ParentItem.Add(MenuItem);
    end
  else
    begin    end;
end;function TForm1.FindItem(RootID, ID: Integer):TMenuItem;
var j :Integer;
    sSQL :string;
    Query: TADOQuery;
begin
  Query :=TADOQuery.Create(Self);
  sSQL :='Select ID,ItemName,ItemCaption, ItemOrder,ImageIndex,ParentID,RootID,Tag,IsCheck,IsEnable,IsVisible,ShortCut,ClickEvent From SR_SYS_MAINMENU Where '+
      ' RootID='''+IntToStr(RootID)+''' and ID='''+IntTostr(ID)+''' Order by ItemOrder ';
  Query.Connection :=ADOConnection1;
  ExecSQL(Query,sSQL);
  Result :=nil;  if Query.RecordCount=1 then
    begin
      for j := 0 to ComponentCount - 1 do
        if Components[j] is TMenuItem then
          if UpperCase(Components[j].Name)=UpperCase(Trim(Query.FieldByName('ItemName').AsString)) then
          begin
            Result := TMenuItem(Components[j]);
            Break;
          end;
    end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateMainMenu;
end;procedure TForm1.NewForm2(Sender: TObject);
begin
  Form2.Show;
end;procedure TForm1.NewForm3(Sender: TObject);
begin
  Form3.Show;
end;

Answer 1

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, DB, ADODB, Grids, DBGrids;type
  TNotifyEvent = procedure (Sender:TObject) of Object;
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    Q_MenuItem: TADOQuery;
    procedure FormCreate(Sender: TObject);
    procedure NewForm2(Sender :TObject);
    procedure NewForm3(Sender :TObject);
  private
    { Private declarations }
    procedure CreateMainMenu;
    procedure GetMenuItemData(RootID :Integer);
    procedure GetHeadItemData;
    procedure CreateMenuItem(RootID :Integer);
    procedure AddMenuItem(RootID,ParentID :Integer);
    function FindItem(RootID,ID:Integer):TMenuItem;
  public
    { Public declarations }
    procedure MenuItemClickEvent(Tag :Integer);
  published
    { published declarations }  end;var
  Form1: TForm1;
  OnClick :TNotifyEvent;
implementationuses Unit2, Unit3;
procedure ExecSQL(Sender:TADOQuery; sSQL :string);
begin
  with Sender do
    begin
      Active :=False;
      SQL.Clear;
      SQL.Add(sSQL);
      Active :=True;
    end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateMainMenu;
end;procedure TForm1.GetMenuItemData(RootID: integer);
var sSQL :string;
begin
  sSQL :='Select ID,ItemName,ItemCaption, ItemOrder,ImageIndex,ParentID,RootID,Tag,IsCheck,IsEnable,IsVisible,ShortCut,ClickEvent From SR_SYS_MAINMENU Where '+
      'IsRoot=0 and RootID='''+IntToStr(RootID)+''' Order by ItemOrder ';
  ExecSQL(Form1.Q_MenuItem,sSQL);
end;procedure TForm1.GetHeadItemData;
var sSQL :string;
begin
  sSQL :='Select ID,ItemName,ItemCaption, ItemOrder,ImageIndex,Tag,IsCheck,IsEnable,IsVisible,ShortCut,ClickEvent From SR_SYS_MAINMENU Where '+
      'IsRoot=1  Order by ItemOrder ';
  ExecSQL(Form1.Q_MenuItem,sSQL);
end;procedure TForm1.CreateMainMenu;
var MainMenu: TMainMenu;
    MenuItem :Array of TMenuItem;
    i,HeadCount :integer;
begin
   MainMenu:= TMainMenu.Create(Self);
   MainMenu.AutoHotkeys :=maManual;
   MainMenu.AutoLineReduction :=maManual;
   // Create HeadMenu
  GetHeadItemData;
  HeadCount :=Q_MenuItem.RecordCount;
  SetLength(MenuItem,HeadCount);
  for i :=0 to HeadCount-1 do
    begin
      MenuItem[i] :=TMenuItem.Create(Self);
      MenuItem[i].Name := Trim(Q_MenuItem.FieldByName('ItemName').AsString);
      MenuItem[i].Caption := Trim(Q_MenuItem.FieldByName('ItemCaption').AsString);
      MenuItem[i].ImageIndex :=Q_MenuItem.FieldByName('ImageIndex').AsInteger;
      MenuItem[i].Tag:=StrToInt(Trim(Q_MenuItem.FieldByName('Tag').AsString));
      MenuItem[i].Checked :=StrToBool(Q_MenuItem.FieldByName('IsCheck').AsString);
      MenuItem[i].Enabled :=StrToBool(Q_MenuItem.FieldByName('IsEnable').AsString);
      MenuItem[i].Visible :=StrToBool(Q_MenuItem.FieldByName('IsVisible').AsString);
      MenuItem[i].ShortCut :=TextToShortCut(Trim(Q_MenuItem.FieldByName('IsVisible').AsString));
      MainMenu.Items.Add(MenuItem[i]);
      Q_MenuItem.Next;
    end;
  //Create MenuItem
  for i :=0 to HeadCount-1 do
    CreateMenuItem(i);end;procedure TForm1.CreateMenuItem(RootID: Integer);
var MenuItem :TMenuItem;
    i,ItemCount,ParentID :integer;
begin
  GetMenuItemData(RootID);
  ItemCount :=Q_MenuItem.RecordCount;
  for i :=0 to ItemCount-1 do
    begin
      ParentID :=Q_MenuItem.FieldByName('ParentID').AsInteger;
      MenuItem :=TMenuItem.Create(Self);
      AddMenuItem(RootID,ParentID);
      Q_MenuItem.Next;
    end;
end;procedure TForm1.AddMenuItem(RootID,ParentID :Integer);
var ParentItem,MenuItem :TMenuItem;
    P: ^Integer;
begin
  ParentItem :=FindItem(RootID,ParentID);
  if ParentItem <> nil then
    begin
      MenuItem :=TMenuItem.Create(Self);
      MenuItem.Name := Trim(Q_MenuItem.FieldByName('ItemName').AsString);
      MenuItem.Caption := Trim(Q_MenuItem.FieldByName('ItemCaption').AsString);
      MenuItem.ImageIndex :=Q_MenuItem.FieldByName('ImageIndex').AsInteger;
      MenuItem.Tag:=StrToInt(Trim(Q_MenuItem.FieldByName('Tag').AsString));
      MenuItem.Checked :=StrToBool(Q_MenuItem.FieldByName('IsCheck').AsString);
      MenuItem.Enabled :=StrToBool(Q_MenuItem.FieldByName('IsEnable').AsString);
      MenuItem.Visible :=StrToBool(Q_MenuItem.FieldByName('IsVisible').AsString);
      MenuItem.ShortCut :=TextToShortCut(Trim(Q_MenuItem.FieldByName('IsVisible').AsString));
      P :=MethodAddress(Trim(Q_MenuItem.FieldByName('ClickEvent').AsString));
      OnClick :=P^;//这里有错误该如何解决
      ParentItem.Add(MenuItem);
    end
  else
    begin    end;
end;function TForm1.FindItem(RootID, ID: Integer):TMenuItem;
var j :Integer;
    sSQL :string;
    Query: TADOQuery;
begin
  Query :=TADOQuery.Create(Self);
  sSQL :='Select ID,ItemName,ItemCaption, ItemOrder,ImageIndex,ParentID,RootID,Tag,IsCheck,IsEnable,IsVisible,ShortCut,ClickEvent From SR_SYS_MAINMENU Where '+
      ' RootID='''+IntToStr(RootID)+''' and ID='''+IntTostr(ID)+''' Order by ItemOrder ';
  Query.Connection :=ADOConnection1;
  ExecSQL(Query,sSQL);
  Result :=nil;  if Query.RecordCount=1 then
    begin
      for j := 0 to ComponentCount - 1 do
        if Components[j] is TMenuItem then
          if UpperCase(Components[j].Name)=UpperCase(Trim(Query.FieldByName('ItemName').AsString)) then
          begin
            Result := TMenuItem(Components[j]);
            Break;
          end;
    end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateMainMenu;
end;procedure TForm1.NewForm2(Sender: TObject);
begin
  Form2.Show;
end;procedure TForm1.NewForm3(Sender: TObject);
begin
  Form3.Show;
end;

Answer 2

不难，你先用设计器设计几个菜单，并添加响应代码，然后在源码窗口中展开全部代码，copy一下再修改一下就OK了