文档章节

Delphi XE2 之 FireMonkey 入门(38) - 控件基础: TPopupMenu、TMenuItem、TMenuBar、TMainMenu

涂孟超
 涂孟超
发布于 2014/09/26 15:33
字数 748
阅读 10
收藏 0

相关控件: 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.

本文转载自:http://www.cnblogs.com/del/archive/2011/10/07/2200278.html

共有 人打赏支持
涂孟超
粉丝 12
博文 2011
码字总数 14107
作品 0
深圳
程序员
GO 语言 UI 组件库 - govcl

由于现有第三方的Go UI库不是太大就是用的不习惯,或者组件太少。就萌生了自己写一个UI库的想法Delphi(Lazarus)有些许多优秀的VCL(LCL)组件,不拿来使用太可惜了。所以就索性做了一套。目前支...

不在乎y
2017/10/10
6.9K
17
Delphi XE2:这就是我们所期待的Delphi吗?

版权声明:本文为 OSChina.NET 原创编译 转载务必注明出处,并保留链接! 作者:蒂姆.安德森 Delphi是被一些人遗忘了的快速应用程序开发工具,但它与可视组件库相结合,依然是开发Windows本机...

虫虫
2011/10/31
40.4K
49
最全面的常用Delphi第三方控件汇总—报表、图表、界面、数据库等

有网友问我常用Delphi第三方控件及功能。我先大概整理一下,以后会在文章里面碰到时再仔细介绍。 报表图表方面: TeeChart Pro 在delphi 的图形显示方面目前唯一的选择,虽然从delphi 3 就随...

Leamontea
2012/12/03
0
2
Delphi XE2 新功能:LiveBindings --- 把对象之间的属性绑定起来

Delphi XE2 新功能:LiveBindings --- 把对象之间的属性绑定起来日期:2011年9月9日 作者: 人气:5340 查看:[大字体 中字体 小字体] XE2 有了 FireMonkey 框架,它不同于 VCL ,以往的数据感...

vga
2016/08/09
17
0
PostgreDAC 2.8.0,Delphi的PostgreSQL组件

PostgreDAC 2.8.0 发布了,该版本首次通过 RAD Studio XE2 支持 Mac OS X 系统,大大提升了 FireMonkey 支持,修复了关于 TPSQLMonitor 的 bug。 完整改进记录: [!] FireMonkey and cross p...

红薯
2012/03/20
662
1

没有更多内容

加载失败,请刷新页面

加载更多

Shell编程(expect同步文件、指定host和同步文件、构建文件分发系统、批量执行命令)

expect脚本同步文件 需求:自动同步文件 实验准备: A机器:192.168.248.130 B机器:192.168.248.129 实现: 1.A机器编写4.expect脚本文件,内容如下所示: #!/usr/bin/expectset passwd "...

蛋黄_Yolks
21分钟前
1
0
ppwjs之bootstrap颜色:背景颜色

<!DOCTYPT html><html><head><meta http-equiv="content-type" content="text/html; charset=utf-8" /><title>ppwjs欢迎您</title><link rel="icon" href="/favicon.ico" ......

ppwjs
22分钟前
0
0
Ubuntu与 Fedora之对比

大家好。今天我将重点介绍两个流行的Linux发行版之间的一些特性和差异; Ubuntu 18.04和Fedora 28。它们都有自己的包管理; Ubuntu使用DEB,而Fedora使用RPM,但它们都具有相同的桌面环境(GNO...

linuxprobe16
26分钟前
1
0
线性代数入门

线性代数的概念对于理解机器学习背后的原理非常重要,尤其是在深度学习领域中。它可以帮助我们更好地理解算法内部到底是怎么运行的,借此,我们就能够更好的做出决策。所以,如果你真的希望了...

牛奋Debug
昨天
3
0
开发5分钟,调试2小时 - 该如何debug?

几年来我在答疑群、论坛、公众号、知乎回答的各种问题,没有一万也有八千。其中有三分之二以上都是在帮人看报错,帮人 debug(调试代码)。 可以说,会不会 debug,有没有 debug 的意识,懂不...

crossin
昨天
4
1

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部