关于动态菜单的问题

Question

procedure TFMain.BuildPopMenu;
begin
  MainPopMenu.Items.Clear;
  AddPopMenu(pShareData.aPopedomMenu,0,MainPopMenu.Items);
end;procedure TFMain.AddPopMenu(aMenu:array of ST_POPEDOM;ParentID:Integer;PMenu:TMenuItem);
var
  i : Integer;
  myMenu : TMenuItem;
begin
  Application.ProcessMessages;
  for i:=low(aMenu) to High(aMenu) do
  begin
    if (aMenu[i].iParentID=ParentID)and(aMenu[i].bShow) then
    begin
      myMenu := TMenuItem.Create(self);
      myMenu.Caption := aMenu[i].sName;
      myMenu.Tag := aMenu[i].iPopedomID;
      myMenu.Hint := aMenu[i].sMemo;
      myMenu.OnClick := PopMenuClick;//你的关键是这一句！！！！！！！！！！！
      PMenu.Insert(myMenu.Count,myMenu);
      AddPopMenu(aMenu,aMenu[i].iPopedomID,myMenu);
    end;
  end;
end;
//主功能菜单事件
procedure TFMain.PopMenuClick(Sender: TObject);
begin
  Case TMenuItem(Sender).Tag of
    1999 :
    begin
      pPrivateData.pConnect :=MainData.MainDataModule.myConnection;
      ow_Operator(pConfig,pShareData,pPrivateData);
    end;
  else
  end;
end;

Answer 1

//你自己研究
//pas
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ActnList;type
  TForm1 = class(TForm)
    ActionList1: TActionList;
    ActionAbout: TAction;
    ActionHelp: TAction;
    ActionExit: TAction;
    MainMenu1: TMainMenu;
    Button1: TButton;
    MenuItemFileM: TMenuItem;
    MenuItemHelpM: TMenuItem;
    MenuItemExit: TMenuItem;
    MenuItemHelp: TMenuItem;
    MenuItemAbout: TMenuItem;
    Button2: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure ActionAboutExecute(Sender: TObject);
    procedure ActionHelpExecute(Sender: TObject);
    procedure ActionExitExecute(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}function StringToComponent(Value: string; Instance: TComponent): TComponent;
var
  StrStream: TStringStream;
  BinStream: TMemoryStream;
begin
  StrStream := TStringStream.Create(Value);
  try
    BinStream := TMemoryStream.Create;
    try
      ObjectTextToBinary(StrStream, BinStream);
      BinStream.Seek(0, soFromBeginning);
      Result := BinStream.ReadComponent(Instance);
    finally
      BinStream.Free;
    end;
  finally
    StrStream.Free;
  end;
end; { StringToComponent }procedure TForm1.ActionAboutExecute(Sender: TObject);
begin
  ShowMessage('一个范例');
end;procedure TForm1.ActionHelpExecute(Sender: TObject);
begin
  ShowMessage('自己帮助自己才能成功');
end;procedure TForm1.ActionExitExecute(Sender: TObject);
begin
  Close;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  vComponent: TComponent;
  S: string;
begin
  MainMenu1.Items.Clear;
  StringToComponent(Memo1.Text, MainMenu1);
  for I := 0 to ActionList1.ActionCount - 1 do begin
    S := ActionList1.Actions[I].Name;
    Delete(S, 1, 6);
    vComponent := MainMenu1.FindComponent('MenuItem' + S);
    if Assigned(vComponent) then
      TMenuItem(vComponent).Action := ActionList1.Actions[I];
  end;
end;procedure TForm1.Button2Click(Sender: TObject);
var
  I: Integer;
  vComponent: TComponent;
  S: string;
begin
  MainMenu1.Items.Clear;
  StringToComponent(Memo2.Text, MainMenu1);
  for I := 0 to ActionList1.ActionCount - 1 do begin
    S := ActionList1.Actions[I].Name;
    Delete(S, 1, 6);
    vComponent := MainMenu1.FindComponent('MenuItem' + S);
    if Assigned(vComponent) then
      TMenuItem(vComponent).Action := ActionList1.Actions[I];
  end;
end;end.//dfm
object Form1: TForm1
  Left = 192
  Top = 107
  Width = 544
  Height = 375
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 56
    Top = 192
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 304
    Top = 184
    Width = 75
    Height = 25
    Caption = 'Button2'
    TabOrder = 1
    OnClick = Button2Click
  end
  object Memo1: TMemo
    Left = 8
    Top = 8
    Width = 265
    Height = 145
    Lines.Strings = (
      'object MainMenu1: TMainMenu'
      '  Left = 48'
      '  Top = 24'
      '  object MenuItemFileM: TMenuItem'
      '    Caption = #25991#20214'
      '    object MenuItemExit: TMenuItem'
      '      Caption = #36864#20986'
      '    end'
      '  end'
      '  object MenuItemHelpM: TMenuItem'
      '    Caption = #24110#21161'
      '    object MenuItemHelp: TMenuItem'
      '      Caption = #24110#21161'
      '    end'
      '    object MenuItemAbout: TMenuItem'
      '      Caption = #20851#20110'
      '    end'
      '  end'
      'end')
    TabOrder = 2
  end
  object Memo2: TMemo
    Left = 280
    Top = 8
    Width = 233
    Height = 145
    Lines.Strings = (
      'object MainMenu1: TMainMenu'
      '  Left = 48'
      '  Top = 24'
      '  object MenuItemFileM: TMenuItem'
      '    Caption = #25991#20214'
      '    object MenuItemHelpM: TMenuItem'
      '      Caption = #24110#21161'
      '      object MenuItemHelp: TMenuItem'
      '        Caption = #24110#21161'
      '      end'
      '      object MenuItemAbout: TMenuItem'
      '        Caption = #20851#20110'
      '      end'
      '    end'
      '    object MenuItemExit: TMenuItem'
      '      Caption = #36864#20986'
      '    end'
      '  end'
      'end')
    TabOrder = 3
  end
  object ActionList1: TActionList
    Left = 16
    Top = 24
    object ActionAbout: TAction
      Caption = '关于'
      OnExecute = ActionAboutExecute
    end
    object ActionHelp: TAction
      Caption = '帮助'
      OnExecute = ActionHelpExecute
    end
    object ActionExit: TAction
      Caption = '退出'
      OnExecute = ActionExitExecute
    end
  end
  object MainMenu1: TMainMenu
    Left = 48
    Top = 24
  end
end