Delphi XE2 之 FireMonkey 入门(38) - 控件基础: TPopupMenu、TMenuItem、TMenuBar、TMainMenu
Delphi XE2 之 FireMonkey 入门(38) - 控件基础: TPopupMenu、TMenuItem、TMenuBar、TMainMenu
涂孟超 发表于4年前
Delphi XE2 之 FireMonkey 入门(38) - 控件基础: TPopupMenu、TMenuItem、TMenuBar、TMainMenu
  • 发表于 4年前
  • 阅读 7
  • 收藏 0
  • 点赞 0
  • 评论 0

【腾讯云】新注册用户域名抢购1元起>>>   


相关控件: TMenuBar、TPopupMenu、TMainMenu; 它们都是要包含 TMenuItem; 在设计时添加 TMenuItem 很容易.
其中的 TMainMenu 暂不能应用其他样式; TMenuBar 只有一个值得注意 UseOSMenu 属性.

控件 PopupMenu 属性用于指定右键菜单.

暂时无法直接为窗体指定右键菜单, 因为窗体现在没有 PopupMenu 属性; 我想到的办法是在窗体上覆盖一个 TPanel 或 TRectangle:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Align := TAlignLayout.alClient;
  Panel1.StyleLookup := StyleLookup;
  Panel1.PopupMenu := PopupMenu1;
end;


也可通过 TPopupMenu 的 Popup() 方法:

procedure TForm1.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
  pt: TPointF;
begin
  inherited;
  if Button = TMouseButton.mbRight then
  begin
    pt := PointF(x,y);
    pt := ClientToScreen(pt);
    PopupMenu1.Popup(pt.X, pt.Y);
  end;
end;


Popup() 方法用于控件的例子(如 TRectangle):

procedure TForm1.Rectangle1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
  pt: TPointF;
begin
  if Button = TMouseButton.mbRight then
  begin
    pt := PointF(x,y);
    pt := TControl(Sender).LocalToAbsolute(pt);
    pt := ClientToScreen(pt);
    PopupMenu1.Popup(pt.X, pt.Y);
  end;
end;


TPopupMenu 的功能很简单, 更多需要在 TMenuItem 中.

以下测试都需要在空白窗体上先放置 Rectangle1、PopupMenu1.

动态添加菜单项:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Rectangle1.PopupMenu := PopupMenu1;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item1';
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item2';
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := '-';
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item3';
  end;
end;


嵌套菜单项:

procedure TForm1.FormCreate(Sender: TObject);
var
  item: TMenuItem;
begin
  Rectangle1.PopupMenu := PopupMenu1;

  item := TMenuItem.Create(Self);
  item.Parent := PopupMenu1;
  item.Text := 'Item1';

    with TMenuItem.Create(Self) do
    begin
      Parent := item;
      Text := 'Item1_1';
    end;
    with TMenuItem.Create(Self) do
    begin
      Parent := item;
      Text := 'Itme1_2';
    end;

  with TMenuItem.Create(Self) do
  begin
    Parent := PopupMenu1;
    Text := 'Item2';
  end;
end;


指定快捷键:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Rectangle1.PopupMenu := PopupMenu1;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item1';
    ShortCut := scCtrl or Byte('A'); //Ctrl + A
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item2';
    ShortCut := scShift or scCtrl or scAlt or Ord('A'); //Shift + Ctrl + Alt + A
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := '-';
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item3';
    ShortCut := 112; //F1
  end;
end;


复选菜单项:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Rectangle1.PopupMenu := PopupMenu1;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item1';
    AutoCheck := True;
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item2';
    AutoCheck := True;
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := '-';
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item3';
    AutoCheck := True;
  end;
end;


单选(分组)菜单项:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Rectangle1.PopupMenu := PopupMenu1;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item1';
    AutoCheck := True;
    RadioItem := True;
    GroupIndex := 1;
    IsChecked := True;
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item2';
    AutoCheck := True;
    RadioItem := True;
    GroupIndex := 1;
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := '-';
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item3';
    AutoCheck := True;
    RadioItem := True;
    GroupIndex := 2;
  end;
  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item4';
    AutoCheck := True;
    RadioItem := True;
    GroupIndex := 2;
  end;
end;


菜单文本格式:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Rectangle1.PopupMenu := PopupMenu1;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item1';
    Font.Style := [TFontStyle.fsBold, TFontStyle.fsItalic];
  end;
end;


图标:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Rectangle1.PopupMenu := PopupMenu1;

  with TMenuItem.Create(Self) do
  begin
    Parent := PopupMenu1;
    Text := 'Item1';
    Bitmap.LoadFromFile('c:\temp\test.png');
  end;
end;


指定事件:

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Menus, FMX.Objects;

type
  TForm1 = class(TForm)
    Rectangle1: TRectangle;
    PopupMenu1: TPopupMenu;
    procedure FormCreate(Sender: TObject);
    procedure ItemOnClick(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Rectangle1.PopupMenu := PopupMenu1;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item1';
    OnClick := ItemOnClick;
  end;

  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item2';
    OnClick := ItemOnClick;
  end;
end;

procedure TForm1.ItemOnClick(Sender: TObject);
begin
  ShowMessage(TTextControl(Sender).Text);
end;

end.

  • 打赏
  • 点赞
  • 收藏
  • 分享
共有 人打赏支持
粉丝 12
博文 2004
码字总数 14107
×
涂孟超
如果觉得我的文章对您有用,请随意打赏。您的支持将鼓励我继续创作!
* 金额(元)
¥1 ¥5 ¥10 ¥20 其他金额
打赏人
留言
* 支付类型
微信扫码支付
打赏金额:
已支付成功
打赏金额: