I'm attempting to style a TPopup with several subcontrols, and then assign event handlers to those controls that need them (buttons primarily). I am using TPopup.IsOpen:=True. When using TPopup.popup(True), input is detected and all mouse events work great, but I do not want the user to do anything more than "click" away from the popup window to close it.
Very similar issues found here, but there wasn't really a suitable answer other than using a modal popup. Delphi XE5 FireMonkey TstringGrid cells don't accept keyboard input
and, this also has a somewhat acceptable answer, but my style has opaque areas that render black on a borderless form. I'd set the form's transparency, but this causes performance issues that I'd rather tackle on another day. Allowing keyboard input to a FireMonkey TEdit nested inside a FireMonkey TPopup
Full process from start to finish: 1. set TPopup.StyleLookup:='MyStyle'; 2. Assign event handlers to subcontrols 3. set TPopup.IsOpen:=True; 4. Attempt to press tab in any TNumberBox/Edit (No Keyboard input detected) 5. Attempt to click any button with assigned handler (No Mouse input detected)
Edit
After a lot of testing I was able to get mouse events to be fired for buttons, but I still cannot get user keyboard input. I've attached sample code from my tester app that opens a popup on right click
- if just right click, opens standard popup with buttonstyle applied
- if right click and shift, opens modal popup with buttonstyle applied
- if right click and alt, opens standard popup with memostyle applied (This is the part not working)
The goal would be to allow the user to type in the popup. There is a TMemo on the form already for testing if my popup's "TMemo" will get focus after clicking the popup, and for verifying the stylenames of a standard TMemo. Also, there is a tlayout with a tmemo as a child. I used this to create a basic style that could be applied to my TPopup. (Please forgive any poorly named variables or unused code... I've tried a lot of different things with little luck.. I'm not really sure where to start and what to toss)
Unit 1 Code:
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.
Project Source:
program Project1;
uses
System.StartUpCopy,
FMX.Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Again, any help is greatly appreciated, thanks!
