运行效果图:


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    HotKey1: THotKey;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    procedure MsgMenu(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Menus; {本例无须在窗体上添加 TMainMenu; 是动态建立菜单的}

var
  MyMenu: TMainMenu;
  Item: TMenuItem;

{让各菜单调用的测试过程}
procedure TForm1.MsgMenu(Sender: TObject);
begin
  if Sender is TMenuItem then
    ShowMessage(TMenuItem(Sender).Caption);
end;

{动态建立菜单}
procedure TForm1.FormCreate(Sender: TObject);
begin
  MyMenu := TMainMenu.Create(Self);
  Self.Menu := MyMenu;

  Item := TMenuItem.Create(MyMenu);
  Item.Caption := 'TestMenu';
  MyMenu.Items.Add(Item);


  Item := TMenuItem.Create(MyMenu);
  Item.Caption := 'Menu-1';
  Item.OnClick := MsgMenu;
  MyMenu.Items[0].Add(Item);

  Item := TMenuItem.Create(MyMenu);
  Item.Caption := 'Menu-2';
  Item.OnClick := MsgMenu;
  MyMenu.Items[0].Add(Item);

  Item := TMenuItem.Create(MyMenu);
  Item.Caption := 'Menu-3';
  Item.OnClick := MsgMenu;
  MyMenu.Items[0].Add(Item);

  Button1.Caption := '设置给第一个子菜单';
  Button2.Caption := '设置给第二个子菜单';
  Button3.Caption := '设置给第三个子菜单';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Self.Menu.Items[0][0].ShortCut := HotKey1.HotKey;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Self.Menu.Items[0][1].ShortCut := HotKey1.HotKey;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Self.Menu.Items[0][2].ShortCut := HotKey1.HotKey;
end;

end.

关于动态建立菜单的相关内容在这: http://www.cnblogs.com/del/category/122010.html

posted on 2008-03-20 10:45  万一  阅读(3172)  评论(8编辑  收藏  举报