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

时间:2015-02-23 22:03:04

标签: delphi firemonkey delphi-xe7

我正在尝试使用多个子控件设置TPopup的样式,然后将事件处理程序分配给需要它们的控件(主要是按钮)。我正在使用TPopup.IsOpen:= True。 当使用TPopup.popup(True)时,检测到输入并且所有鼠标事件都很有效,但我不希望用户做任何事情而不是从弹出窗口“点击”关闭它。

这里发现非常类似的问题,但除了使用模态弹出窗口之外,没有其他合适的答案。 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中的选项卡(未检测到键盘输入) 5.尝试单击任何带有已分配处理程序的按钮(未检测到鼠标输入)

修改

经过大量测试后,我能够为按钮触发鼠标事件,但我仍然无法获得用户键盘输入。我已经从我的测试版应用程序附加了示例代码,右键单击打开一个弹出窗口

  1. 如果只是右键单击,则使用按钮样式打开标准弹出窗口
  2. 如果右键单击并移动,则使用buttonstyle应用
  3. 打开模态弹出窗口
  4. 如果右键单击并使用alt,则会打开应用了memostyle的标准弹出窗口(这部分无法正常工作
  5. 目标是允许用户输入弹出窗口。如果弹出窗口的“TMemo”在单击弹出窗口后获得焦点,并且用于验证标准TMemo的样式名称,则表单上已有一个用于测试的TMemo。此外,作为一个孩子,有一个tmemo tlayout。我用它来创建一个可以应用于我的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.
    

    再一次,非常感谢任何帮助,谢谢!

1 个答案:

答案 0 :(得分:0)

决定在这里回答这个问题: Allowing keyboard input to a FireMonkey TEdit nested inside a FireMonkey TPopup

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