Delphi XE2 之 FireMonkey 入门(38) - 控件基础: TPopupMenu、TMenuItem、TMenuBar、TMainMenu
其中的 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的更多相关文章
- Delphi XE2 之 FireMonkey 入门(44) - 控件基础: TTreeView、TTreeViewItem
Delphi XE2 之 FireMonkey 入门(44) - 控件基础: TTreeView.TTreeViewItem TScrollBox -> TCustomTreeView -> ...
- Delphi XE2 之 FireMonkey 入门(43) - 控件基础: TStringGrid、TGrid
Delphi XE2 之 FireMonkey 入门(43) - 控件基础: TStringGrid.TGrid TStringGrid.TGrid 都是从 TCustomGrid 继承; 区别有:1 ...
- Delphi XE2 之 FireMonkey 入门(42) - 控件基础: TComboBox、TComboEdit
Delphi XE2 之 FireMonkey 入门(42) - 控件基础: TComboBox.TComboEdit TListBox 有两个兄弟 TComboListBox.TComboEditL ...
- Delphi XE2 之 FireMonkey 入门(41) - 控件基础: TListBox
Delphi XE2 之 FireMonkey 入门(41) - 控件基础: TListBox TScrollBox -> TCustomListBox -> TListBox; 其元素项 ...
- Delphi XE2 之 FireMonkey 入门(40) - 控件基础: TMemo
Delphi XE2 之 FireMonkey 入门(40) - 控件基础: TMemo 值得注意的变化: 1.其父类 TScrollBox 的许多特性也很有用处, 如: Memo1.UseSma ...
- Delphi XE2 之 FireMonkey 入门(39) - 控件基础: TScrollBox、TVertScrollBox、TFramedScrollBox、TFramedVertScrollBox
Delphi XE2 之 FireMonkey 入门(39) - 控件基础: TScrollBox.TVertScrollBox.TFramedScrollBox.TFramedVertScrollB ...
- Delphi XE2 之 FireMonkey 入门(37) - 控件基础: TControl 概览
Delphi XE2 之 FireMonkey 入门(37) - 控件基础: TControl 概览 { TControl } public constructor Create(...); ov ...
- Delphi XE2 之 FireMonkey 入门(36) - 控件基础: TForm
Delphi XE2 之 FireMonkey 入门(36) - 控件基础: TForm 当我第一次读取 Form1.StyleLookup 并期待出现 "formstyle" 时 ...
- Delphi XE2 之 FireMonkey 入门(35) - 控件基础: TFmxObject: 其它
Delphi XE2 之 FireMonkey 入门(35) - 控件基础: TFmxObject: 其它 TFmxObject 增加了 TagObject.TagFloat.TagString, 算 ...
随机推荐
- Qt Creator 4.9 发布
Qt Creator 4.8中引入了语言服务器协议支持,允许Qt Creator通过利用此标准轻松支持更多编程语言,使IDE和其他编程工具可以轻松地获得通用编程语言支持的交换格式.使用Qt Creat ...
- 有理想的中国IT企业,正在全球攻城略地 - 阅读笔记
文章来源:https://mp.weixin.qq.com/s/xc5Uqe4WmEEgI03dPR4Orw 中资手机崛起 大部分国人对传音不熟悉,这家深圳公司由前波导高管创立,是非洲手机市场的老大. ...
- Window10的激活步骤
1. 首先,我们先查看一下Win10正式专业版系统的激活状态: 点击桌面左下角的“Windows”按钮,从打开的扩展面板中依次点击“设置”-“更新和安全”,并切换到“激活”选项卡,在此就可以查看到当前 ...
- init.uniform / unit.normal
均匀分布nn.init.uniform(tensor,a=0,b=1)tensor -n维的torch.Tensora 均匀分布的下界,默认值为0b 均匀分布的上界,默认值为1 正态分布torcn.n ...
- 下载bat脚本
@rem 注释:从ftp服务器每小时下载北向性能文件的脚本 @rem 用vb脚本取昨天 for /f %%a in ('cscript //nologo yester.vbs') do set yes ...
- 2017年全国卷3的21题与2018年全国卷3的21题命题背景是同一个函数$y=\frac{2x}{\ln(x+1)}$(再次瞎谈)
2017年四川高考数学(全国卷3)理科21题第1问 已知函数\(f(x)=x-1-a\ln x\) (1)若\(f(x)\geqslant 0\),求\(a\)的值\(.\) 该不等式等价于$a\ln ...
- 1 搭建K8s集群
官网:https://kubernetes.io/docs/setup/production-environment/tools/kubeadm/install-kubeadm/#installing ...
- ZROI 19.08.07模拟赛
传送门 写在前面:为了保护正睿题目版权,这里不放题面,只写题解. "正睿从来没有保证,模拟赛的题目必须原创." "文案不是我写的,有问题找喵老师去."--蔡老师 ...
- ftp CentOS7安装
1.安装ftp服务yum install vsftpd 2.修改ftp配置文件(/etc/vsftpd/vsftpd.conf)ascii_upload_enable=YESascii_downloa ...
- 对TypeScript进行研究
1.npm install -g typescript 在编辑器,将下面的代码输入到greeter.ts文件里: function greeter(person) { return "Hel ...