TPopup 子控件不接受 keyboard/mouse 输入 - (Delphi XE7 FireMonkey)
TPopup subcontrols do not accept keyboard/mouse input - (Delphi XE7 FireMonkey)
我正在尝试使用多个子控件设置 TPopup 的样式,然后将事件处理程序分配给需要它们的那些控件(主要是按钮)。我正在使用 TPopup.IsOpen:=True。
使用 TPopup.popup(True) 时,会检测到输入并且所有鼠标事件都运行良好,但我不希望用户在 "click" 之外做任何其他事情来关闭弹出窗口 window .
在这里发现了非常相似的问题,但除了使用模态弹出窗口之外,没有真正合适的答案。
Delphi XE5 FireMonkey TstringGrid cells don't accept keyboard input
而且,这也有一个可以接受的答案,但我的风格有不透明区域,在无边框形式上呈现黑色。我会设置表单的透明度,但这会导致我宁愿在另一天解决的性能问题。
Allowing keyboard input to a FireMonkey TEdit nested inside a FireMonkey TPopup
从头到尾的完整过程:
1.设置TPopup.StyleLookup:='MyStyle';
2. 为子控件分配事件处理程序
3. 设置 TPopup.IsOpen:=True;
4. 尝试在任何 TNumberBox/Edit 中按 Tab 键(未检测到键盘输入)
5. 尝试单击具有指定处理程序的任何按钮(未检测到鼠标输入)
编辑
经过大量测试后,我能够为按钮触发鼠标事件,但我仍然无法获得用户键盘输入。我附上了我的测试器应用程序的示例代码,该应用程序会在右键单击时打开一个弹出窗口
- 如果只需右键单击,将打开应用了按钮样式的标准弹出窗口
- 如果右键单击并按住 Shift,将打开应用了按钮样式的模式弹出窗口
- 如果右键单击并 alt,打开应用了 memostyle 的标准弹出窗口(这是不起作用的部分)
目标是允许用户在弹出窗口中输入内容。表单上已经有一个 TMemo,用于测试我的弹出窗口的 "TMemo" 是否会在单击弹出窗口后获得焦点,并用于验证标准 TMemo 的样式名称。此外,还有一个带有 tmemo 作为 child 的布局。我用它来创建可以应用于我的 TPopup 的基本样式。 (请原谅任何命名不当的变量或未使用的代码......我已经尝试了很多不同的东西但运气不佳..我真的不确定从哪里开始以及折腾什么)
单元 1 代码:
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,System.Rtti,
FMX.Styles.Objects, FMX.Layouts, FMX.Memo;
type
TForm1 = class(TForm)
Memo1: TMemo;
StyleBook1: TStyleBook;
Layout1: TLayout;
Memo2: TMemo;
Popup1: TPopup;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
private
{ Private declarations }
public
{ Public declarations }
procedure DoButtonClick(Sender:TObject);
procedure DoMemoClick(Sender:TObject);
function FindRootStyleResource(const AObject: TFmxObject; const AStyleLookup: string):TFmxObject;
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.DoButtonClick(Sender: TObject);
begin
showmessage('WoooHooo!');
end;
procedure TForm1.DoMemoClick(Sender: TObject);
begin
if Sender is TMemo then
Begin
Tmemo(Sender).SetFocus;
with FindRootStyleResource(TFmxObject(Sender),'background') as TActiveStyleObject do
Begin
CanFocus:=True;
HitTest:=True;
Locked:=False;
SetFocus;
End;
Self.Focused:=nil;//Removes the focus from the current form to TPopup (TCommonCustomForm)
End;
end;
function TForm1.FindRootStyleResource(const AObject: TFmxObject;
const AStyleLookup: string): TFmxObject;
var
SearchResult,Child:TFmxObject;
begin
Result:=nil;
//No object get out
if AObject=nil then
exit;
//No Style lookup, get out
if AStyleLookup='' then
exit;
//If Current object is what we're looking for, set result
if AObject.StyleName.ToLower=AStyleLookup.ToLower then
Result:=AObject;
//if Object has children need to check lower levels
if AObject.ChildrenCount>0 then
Begin
//Now Recurse the children
for Child in AObject.Children do
Begin
SearchResult:=FindRootStyleResource(Child,AStyleLookup);
if SearchResult<>nil then
Result:=SearchResult
End;
End;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
Var
O:TFmxObject;
begin
if (Button=TMouseButton.mbRight) and not ((ssShift in Shift) or (ssAlt in Shift)) then
Begin
Popup1.Width:=100;
Popup1.Height:=100;
Popup1.StyleLookup:='buttonstyle';
ApplyStyleLookup;
(*
O:= FindRootStyleResource(popup1,'background');
TButtonStyleObject(O).OnClick:=DoButtonClick;
TButtonStyleObject(O).HitTest:=True;
TButtonStyleObject(O).Locked:=False;
*)
Popup1.StylesData['background.OnClick']:=TValue.From<TNotifyEvent>(DoButtonClick);
Popup1.StylesData['background.HitTest']:=True;
Popup1.StylesData['background.Locked']:=False;
Popup1.IsOpen:=True;
End
else if (Button=TMouseButton.mbRight) and (ssShift in Shift) then
Begin
Popup1.Width:=100;
Popup1.Height:=100;
Popup1.StyleLookup:='buttonstyle';
ApplyStyleLookup;
(*
O:= FindRootStyleResource(popup1,'background');
TButtonStyleObject(O).OnClick:=DoButtonClick;
TButtonStyleObject(O).HitTest:=True;
TButtonStyleObject(O).Locked:=False;
*)
Popup1.StylesData['background.OnClick']:=TValue.From<TNotifyEvent>(DoButtonClick);
Popup1.StylesData['background.HitTest']:=True;
Popup1.StylesData['background.Locked']:=False;
Popup1.Popup(True);
End
else if (Button=TMouseButton.mbRight) and (ssAlt in Shift) then
Begin
Popup1.Width:=100;
Popup1.Height:=100;
Popup1.StyleLookup:='MemoPopupStyle';
ApplyStyleLookup;
Popup1.StylesData['content.OnClick']:=TValue.From<TNotifyEvent>(DoMemoClick);
Popup1.StylesData['content.HitTest']:=True;
Popup1.StylesData['content.Locked']:=False;
//Popup1.StylesData['background.TabStop']:=True;
//Popup1.StylesData['background.Enabled']:=True;
Popup1.IsOpen:=True;
End;
end;
end.
项目来源:
program Project1;
uses
System.StartUpCopy,
FMX.Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
再次感谢您的帮助,谢谢!
决定只在这里回答这个问题:
Allowing keyboard input to a FireMonkey TEdit nested inside a FireMonkey TPopup
为了透明起见,我在名为 Content 的 fmPopup 表单上添加了一个子 TPanel。之后我设置了 Transparency:=True,并将我的自定义样式应用到内容面板。不完全是我想要的,因为我必须编写自己的 positioning/hiding TPopup 已有的过程,但我现有的 "initialize style" 过程无需任何修改即可工作。我当然欢迎任何更好的解决方案。
我正在尝试使用多个子控件设置 TPopup 的样式,然后将事件处理程序分配给需要它们的那些控件(主要是按钮)。我正在使用 TPopup.IsOpen:=True。 使用 TPopup.popup(True) 时,会检测到输入并且所有鼠标事件都运行良好,但我不希望用户在 "click" 之外做任何其他事情来关闭弹出窗口 window .
在这里发现了非常相似的问题,但除了使用模态弹出窗口之外,没有真正合适的答案。 Delphi XE5 FireMonkey TstringGrid cells don't accept keyboard input
而且,这也有一个可以接受的答案,但我的风格有不透明区域,在无边框形式上呈现黑色。我会设置表单的透明度,但这会导致我宁愿在另一天解决的性能问题。 Allowing keyboard input to a FireMonkey TEdit nested inside a FireMonkey TPopup
从头到尾的完整过程: 1.设置TPopup.StyleLookup:='MyStyle'; 2. 为子控件分配事件处理程序 3. 设置 TPopup.IsOpen:=True; 4. 尝试在任何 TNumberBox/Edit 中按 Tab 键(未检测到键盘输入) 5. 尝试单击具有指定处理程序的任何按钮(未检测到鼠标输入)
编辑
经过大量测试后,我能够为按钮触发鼠标事件,但我仍然无法获得用户键盘输入。我附上了我的测试器应用程序的示例代码,该应用程序会在右键单击时打开一个弹出窗口
- 如果只需右键单击,将打开应用了按钮样式的标准弹出窗口
- 如果右键单击并按住 Shift,将打开应用了按钮样式的模式弹出窗口
- 如果右键单击并 alt,打开应用了 memostyle 的标准弹出窗口(这是不起作用的部分)
目标是允许用户在弹出窗口中输入内容。表单上已经有一个 TMemo,用于测试我的弹出窗口的 "TMemo" 是否会在单击弹出窗口后获得焦点,并用于验证标准 TMemo 的样式名称。此外,还有一个带有 tmemo 作为 child 的布局。我用它来创建可以应用于我的 TPopup 的基本样式。 (请原谅任何命名不当的变量或未使用的代码......我已经尝试了很多不同的东西但运气不佳..我真的不确定从哪里开始以及折腾什么)
单元 1 代码:
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,System.Rtti,
FMX.Styles.Objects, FMX.Layouts, FMX.Memo;
type
TForm1 = class(TForm)
Memo1: TMemo;
StyleBook1: TStyleBook;
Layout1: TLayout;
Memo2: TMemo;
Popup1: TPopup;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
private
{ Private declarations }
public
{ Public declarations }
procedure DoButtonClick(Sender:TObject);
procedure DoMemoClick(Sender:TObject);
function FindRootStyleResource(const AObject: TFmxObject; const AStyleLookup: string):TFmxObject;
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.DoButtonClick(Sender: TObject);
begin
showmessage('WoooHooo!');
end;
procedure TForm1.DoMemoClick(Sender: TObject);
begin
if Sender is TMemo then
Begin
Tmemo(Sender).SetFocus;
with FindRootStyleResource(TFmxObject(Sender),'background') as TActiveStyleObject do
Begin
CanFocus:=True;
HitTest:=True;
Locked:=False;
SetFocus;
End;
Self.Focused:=nil;//Removes the focus from the current form to TPopup (TCommonCustomForm)
End;
end;
function TForm1.FindRootStyleResource(const AObject: TFmxObject;
const AStyleLookup: string): TFmxObject;
var
SearchResult,Child:TFmxObject;
begin
Result:=nil;
//No object get out
if AObject=nil then
exit;
//No Style lookup, get out
if AStyleLookup='' then
exit;
//If Current object is what we're looking for, set result
if AObject.StyleName.ToLower=AStyleLookup.ToLower then
Result:=AObject;
//if Object has children need to check lower levels
if AObject.ChildrenCount>0 then
Begin
//Now Recurse the children
for Child in AObject.Children do
Begin
SearchResult:=FindRootStyleResource(Child,AStyleLookup);
if SearchResult<>nil then
Result:=SearchResult
End;
End;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
Var
O:TFmxObject;
begin
if (Button=TMouseButton.mbRight) and not ((ssShift in Shift) or (ssAlt in Shift)) then
Begin
Popup1.Width:=100;
Popup1.Height:=100;
Popup1.StyleLookup:='buttonstyle';
ApplyStyleLookup;
(*
O:= FindRootStyleResource(popup1,'background');
TButtonStyleObject(O).OnClick:=DoButtonClick;
TButtonStyleObject(O).HitTest:=True;
TButtonStyleObject(O).Locked:=False;
*)
Popup1.StylesData['background.OnClick']:=TValue.From<TNotifyEvent>(DoButtonClick);
Popup1.StylesData['background.HitTest']:=True;
Popup1.StylesData['background.Locked']:=False;
Popup1.IsOpen:=True;
End
else if (Button=TMouseButton.mbRight) and (ssShift in Shift) then
Begin
Popup1.Width:=100;
Popup1.Height:=100;
Popup1.StyleLookup:='buttonstyle';
ApplyStyleLookup;
(*
O:= FindRootStyleResource(popup1,'background');
TButtonStyleObject(O).OnClick:=DoButtonClick;
TButtonStyleObject(O).HitTest:=True;
TButtonStyleObject(O).Locked:=False;
*)
Popup1.StylesData['background.OnClick']:=TValue.From<TNotifyEvent>(DoButtonClick);
Popup1.StylesData['background.HitTest']:=True;
Popup1.StylesData['background.Locked']:=False;
Popup1.Popup(True);
End
else if (Button=TMouseButton.mbRight) and (ssAlt in Shift) then
Begin
Popup1.Width:=100;
Popup1.Height:=100;
Popup1.StyleLookup:='MemoPopupStyle';
ApplyStyleLookup;
Popup1.StylesData['content.OnClick']:=TValue.From<TNotifyEvent>(DoMemoClick);
Popup1.StylesData['content.HitTest']:=True;
Popup1.StylesData['content.Locked']:=False;
//Popup1.StylesData['background.TabStop']:=True;
//Popup1.StylesData['background.Enabled']:=True;
Popup1.IsOpen:=True;
End;
end;
end.
项目来源:
program Project1;
uses
System.StartUpCopy,
FMX.Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
再次感谢您的帮助,谢谢!
决定只在这里回答这个问题: Allowing keyboard input to a FireMonkey TEdit nested inside a FireMonkey TPopup
为了透明起见,我在名为 Content 的 fmPopup 表单上添加了一个子 TPanel。之后我设置了 Transparency:=True,并将我的自定义样式应用到内容面板。不完全是我想要的,因为我必须编写自己的 positioning/hiding TPopup 已有的过程,但我现有的 "initialize style" 过程无需任何修改即可工作。我当然欢迎任何更好的解决方案。