文档章节

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

涂孟超
 涂孟超
发布于 2014/09/26 15:33
字数 748
阅读 8
收藏 0
点赞 0
评论 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第三方控件汇总—报表、图表、界面、数据库等

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

Leamontea
2012/12/03
0
2
Delphi XE2:这就是我们所期待的Delphi吗?

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

虫虫
2011/10/31
40.4K
49
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
PostgreSQL的Delphi组件--PostgreDAC

PostgreDAC 是适合 Delphi/C++ Builder 操作 PostgreSQL 数据库的功能非常强大的组件包,允许你创建直连 PostgreSQL 数据库的 Delphi/C++ Builder 应用,无需 BDE 和 ODBC 支持。 使用 Post...

匿名
2012/03/20
2.1K
0
delphi各个版本编译开关值

delphi各个版本编译开关值 {$IFDEF VER80} - Delphi 1 {$IFDEF VER90} - Delphi 2 {$IFDEF VER100} - Delphi 3 {$IFDEF VER120} - Delphi 4 {$IFDEF VER130} - Delphi 5 {$IFDEF VER140} - D......

伽罗kapple
2016/03/01
10
0
请问delphi XE 和 RAD studio有什么区别呢?

本人不是做delphi的,想了解一下delphi,请问站内好友,Delphi Prism XE2,delphi xe和Rad studio有什么区别呢? 下载哪个版本适合学习?谢谢啦!...

it-达摩
2011/11/22
2.4K
1
uniGui安装教程、使用例子

转]uniGui安装教程、使用例子 uniGui安装步骤: 步骤一、下载安装文件 运行fmsoftuniguibeta0.86.0.880setup.exe (从官方下载的安装包,没有源码,只提供dcu文件。) 步骤二、修复源文件错误...

vga
2014/02/26
0
3
OSChina 技术周刊第十五期——每周技术精粹集锦

每周技术抢先看,总有你想要的! 移动开发 【软件】移动基站数据分析 SnoopSnitch 【博客】android自动连接wifi——WifiManager 【资讯】OSC 安卓客户端全面改版 —— 新界面新体验 【资讯】...

OSC编辑部
2014/12/28
1K
0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

shell中的函数、shell中的数组、告警系统需求分析

shell中的函数 格式: 格式: function f_name() { command } 函数必须要放在最前面 示例1(用来打印参数) 示例2(用于定义加法) 示例3(用于显示IP) shell中的数组 shell中的数组1 定义数...

Zhouliang6
今天
2
0
用 Scikit-Learn 和 Pandas 学习线性回归

      对于想深入了解线性回归的童鞋,这里给出一个完整的例子,详细学完这个例子,对用scikit-learn来运行线性回归,评估模型不会有什么问题了。 1. 获取数据,定义问题     没有...

wangxuwei
今天
1
0
MAC安装MAVEN

一:下载maven压缩包(Zip或tar可选),解压压缩包 二:打开终端输入:vim ~/.bash_profile(如果找不到该文件新建一个:touch ./bash_profile) 三:输入i 四:输入maven环境变量配置 MAVEN_HO...

WALK_MAN
今天
0
0
33.iptables备份与恢复 firewalld的9个zone以及操作 service的操作

10.19 iptables规则备份和恢复 10.20 firewalld的9个zone 10.21 firewalld关于zone的操作 10.22 firewalld关于service的操作 10.19 iptables规则备份和恢复: ~1. 保存和备份iptables规则 ~2...

王鑫linux
今天
2
0
大数据教程(2.11):keeperalived+nginx高可用集群搭建教程

上一章节博主为大家介绍了目前大型互联网项目的系统架构体系,相信大家应该注意到其中很重要的一块知识nginx技术,在本节博主将为大家分享nginx的相关技术以及配置过程。 一、nginx相关概念 ...

em_aaron
今天
1
0
Apache Directory Studio连接Weblogic内置LDAP

OBIEE默认使用Weblogic内置LDAP管理用户及组。 要整理已存在的用户及组,此前办法是导出安全数据,文本编辑器打开认证文件,使用正则表达式获取用户及组的信息。 后来想到直接用Apache Dire...

wffger
今天
2
0
HFS

FS,它是一种上传文件的软件。 专为个人用户所设计的 HTTP 档案系统 - Http File Server,如果您觉得架设 FTP Server 太麻烦,那么这个软件可以提供您更方便的档案传输系统,下载后无须安装,...

garkey
今天
1
0
Java IO类库之BufferedInputStream

一、BufferedInputStream介绍 /** * A <code>BufferedInputStream</code> adds * functionality to another input stream-namely, * the ability to buffer the input and to * sup......

老韭菜
今天
0
0
STM 32 窗口看门狗

http://bbs.elecfans.com/jishu_805708_1_1.html https://blog.csdn.net/a1985831055/article/details/77404131...

whoisliang
昨天
1
0
Dubbo解析(六)-服务调用

当dubbo消费方和提供方都发布和引用完成后,第四步就是消费方调用提供方。 还是以dubbo的DemoService举例 -- 提供方<dubbo:application name="demo-provider"/><dubbo:registry address="z...

青离
昨天
2
0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

返回顶部
顶部