相关控件: 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 := ; //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 := ;
    IsChecked := True;
  end;   with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item2';
    AutoCheck := True;
    RadioItem := True;
    GroupIndex := ;
  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 := ;
  end;
  with TMenuItem.Create(PopupMenu1) do
  begin
    Parent := PopupMenu1;
    Text := 'Item4';
    AutoCheck := True;
    RadioItem := True;
    GroupIndex := ;
  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.

Delphi XE2 之 FireMonkey 入门(38) - 控件基础: TPopupMenu、TMenuItem、TMenuBar、TMainMenu的更多相关文章

  1. Delphi XE2 之 FireMonkey 入门(44) - 控件基础: TTreeView、TTreeViewItem

    Delphi XE2 之 FireMonkey 入门(44) - 控件基础: TTreeView.TTreeViewItem TScrollBox -> TCustomTreeView -> ...

  2. Delphi XE2 之 FireMonkey 入门(43) - 控件基础: TStringGrid、TGrid

    Delphi XE2 之 FireMonkey 入门(43) - 控件基础: TStringGrid.TGrid TStringGrid.TGrid 都是从 TCustomGrid 继承; 区别有:1 ...

  3. Delphi XE2 之 FireMonkey 入门(42) - 控件基础: TComboBox、TComboEdit

    Delphi XE2 之 FireMonkey 入门(42) - 控件基础: TComboBox.TComboEdit TListBox 有两个兄弟 TComboListBox.TComboEditL ...

  4. Delphi XE2 之 FireMonkey 入门(41) - 控件基础: TListBox

    Delphi XE2 之 FireMonkey 入门(41) - 控件基础: TListBox TScrollBox -> TCustomListBox -> TListBox; 其元素项 ...

  5. Delphi XE2 之 FireMonkey 入门(40) - 控件基础: TMemo

    Delphi XE2 之 FireMonkey 入门(40) - 控件基础: TMemo 值得注意的变化: 1.其父类 TScrollBox 的许多特性也很有用处, 如:   Memo1.UseSma ...

  6. Delphi XE2 之 FireMonkey 入门(39) - 控件基础: TScrollBox、TVertScrollBox、TFramedScrollBox、TFramedVertScrollBox

    Delphi XE2 之 FireMonkey 入门(39) - 控件基础: TScrollBox.TVertScrollBox.TFramedScrollBox.TFramedVertScrollB ...

  7. Delphi XE2 之 FireMonkey 入门(37) - 控件基础: TControl 概览

    Delphi XE2 之 FireMonkey 入门(37) - 控件基础: TControl 概览 { TControl } public   constructor Create(...); ov ...

  8. Delphi XE2 之 FireMonkey 入门(36) - 控件基础: TForm

    Delphi XE2 之 FireMonkey 入门(36) - 控件基础: TForm 当我第一次读取 Form1.StyleLookup 并期待出现 "formstyle" 时 ...

  9. Delphi XE2 之 FireMonkey 入门(35) - 控件基础: TFmxObject: 其它

    Delphi XE2 之 FireMonkey 入门(35) - 控件基础: TFmxObject: 其它 TFmxObject 增加了 TagObject.TagFloat.TagString, 算 ...

随机推荐

  1. 破解phpStorm 2018 亲测

    网上教程很多,这里我就不多赘述,我也是看其他教程试过来的. 下面分步骤介绍一下: 1.下载,我这里选用的版本是 phpStorm 2018.3 ,下载地址 https://www.newasp.net ...

  2. Shiro单Realm加密

    首先,我们要明确认证的流程: 1. 获取当前的 Subject. 调用 SecurityUtils.getSubject(); 2. 测试当前的用户是否已经被认证. 即是否已经登录. 调用 Subje ...

  3. java 返回输入中出现次数最多的字符串

    举例输入: abc abc de de de fghi fghi 应该返回: de 代码: static List<String> func(String str) { String[] ...

  4. 【ZIP】打包过滤指定目录和文件

    zip -r project.zip project/ -x@exclude.lst #目录过滤 # 直接目录,如 public public/* # 嵌套目录 如 node_modules */no ...

  5. vi/vim常用命令总结

    vim是vi的升级模式,完全兼容vi 解决vim打开中文乱码问题 编辑/etc/vim/vimrc配置文件,添加下面的内容: ''' set fileencodings=utf-8,ucs-bom,g ...

  6. idea 添加静态注释和live Templates

    静态注释 /** * @Description * @Author wzz * @Date ${DATE} ${TIME} */ Live Templates 1.新建一个自己的添加组如图:Mygro ...

  7. Js中JSON.stringify()与JSON.parse()

    JSON(JavaScript Object Notation)是一种轻量级的数据交换格式.因为采用独立于语言的文本格式,也使用了类似于C语言家族的习惯,拥有了这些特性使使JSON称为理想的数据交换语 ...

  8. ZROI 19.08.05模拟赛

    传送门 写在前面:为了保护正睿题目版权,这里不放题面,只写题解. A \(21pts:\) 随便枚举,随便爆搜就好了. \(65pts:\) 比较显然的dp,设\(f_{i,j,k}\)表示在子树\( ...

  9. 【leetcode】1178. Number of Valid Words for Each Puzzle

    题目如下: With respect to a given puzzle string, a word is valid if both the following conditions are sa ...

  10. js 页面 保持状态 的方法

    A -> B 带参数进去B页面, 刷新B页面还  保持状态 单机下一页, 改变请求参数, A->B 不带参数进去B页面 (不存在)当前状态保存在cookies中, 刷新页面,判断cooki ...