TPopup子控件不接受键盘/鼠标输入 - （Delphi XE7 FireMonkey）

问题描述：

我试图用几个子控件设计一个TPopup，然后将事件处理程序分配给那些需要它们的控件（主要是按钮）。我正在使用TPopup.IsOpen：= True。当使用TPopup.popup（True）时，检测到输入并且所有鼠标事件都很好，但我不希望用户做任何事情，而不是从弹出窗口“点击”来关闭它。TPopup子控件不接受键盘/鼠标输入 - （Delphi XE7 FireMonkey）

在这里发现了非常类似的问题，但除了使用模态弹出窗口之外并没有真正合适的答案。 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 /编辑（无键盘输入检测），按Tab键 5.尝试点击使用分配处理任何按钮（无鼠标输入检测）

编辑

很多后测试我能够获得按键的鼠标事件，但我仍然无法获得用户的键盘输入。我从打开

如果只是右键点击鼠标右键，弹出我的测试应用程序，附加的示例代码将打开的ButtonStyle标准弹出应用
如果点击右键并移位，将打开的ButtonStyle应用
如果右键和alt，打开应用了memostyle标准弹出（这不是工作的部分）

我们的目标是让用户在弹出的输入。在表单上有一个TMemo用于测试如果弹出窗口的“TMemo”在单击弹出窗口后将获得焦点，并验证标准TMemo的样式名称。另外，tmemo还是一个小孩。我用这个来创建一个可以应用于我的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

对于透明度，我添加了一个孩子TPanel在名为Content fmPopup形式。之后，我设置了Transparency：= True，并将我的自定义样式应用于“内容”面板。不完全是我想要的，因为我必须编写自己的TPopup已有的定位/隐藏过程，但我现有的“初始化样式”过程没有任何修改就能正常工作。我当然欢迎有更好的解决方案。

TPopup子控件不接受键盘/鼠标输入 - （Delphi XE7 FireMonkey）

相关推荐