MainFormOnTaskbar + tooltip causes focus-stealing - delphi

I built the code below using Delphi XE2. It creates Form1, and Form1 immediately creates an instance of Form2. When I press the button on Form2 a second Form2 is created.
Now if I hover the mouse over the button on this second, topmost, Form2 and wait for the tooltip to appear, the moment the tooltip appears, the first Form2 comes to the front, stealing focus.
The problem occurs only if Application.MainFormOnTaskbar is True. It also relies on the first Form2 being created from Form1's FormCreate method. If I use PostMessage() to delay the creation of the first Form2 until the application has finished initialising, the problem goes away.
I'd like to understand why this is happening. I have already learned that Delphi's Application object handles a lot of things including hint display, and I know that Delphi can recreate a window's handle during initialisation, but I haven't been able to follow this through to explain fully the behaviour described above (or indeed whether the above two facts are even relevant).
Project1.dpr
program Project1;
uses
Vcl.Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True; // False makes problem go away
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Unit1.pas
unit Unit1;
interface
uses
Vcl.Forms, Unit2;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
public
procedure CreateForm2;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
CreateForm2;
end;
procedure TForm1.CreateForm2;
var
frm : TForm2;
begin
frm := TForm2.Create(Application); // (Could pass Self - makes no difference)
frm.Show;
end;
end.
Unit2.pas
unit Unit2;
interface
uses
Vcl.Forms, System.Classes, Vcl.Controls, Vcl.StdCtrls, WinApi.Windows;
type
TForm2 = class(TForm)
Button1: TButton; // This button has a hint
procedure Button1Click(Sender: TObject);
end;
var
Form2: TForm2;
implementation
uses
System.SysUtils, Unit1;
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
Form1.CreateForm2;
end;
end.

The key issue here is that the first instance of TForm2 is created as window that is owned by the application window, Application.Handle. And here I am referring to the Windows meaning of owner. In VCL language this is known as the popup parent.
Now, when you create that first TForm2 instance, the Application.MainForm property is still nil. And because you did not explicitly assign PopupParent, the code in TCustomForm.CreateParams sets the owner to be the application window.
You simply do not want your windows to be owned by the hidden application window. This is the reason why that first TForm2 instance sometimes appears behind all the other windows, in particular behind your main form. It has simply been created with the wrong owner.
The form that is owned by Application.Handle gets shown in THintWindow.ActivateHint. That happens due to the line that reads ParentWindow := Application.Handle. This is followed by a call to SetWindowPos(Handle, ...) which results in the incorrectly owned form coming to the front. Presumably that form comes to the front because it is also owned by Application.Handle. Right now I don't have a clear explanation for the precise mechanism, but I don't find that terribly interesting because the form is clearly setup wrongly.
In any case, the fundamental problem is that you have created a window that is incorrectly owned. The solution therefore is to make sure that the window is owned correctly. Do that by assigning the PopupParent. For example:
procedure TForm1.CreateForm2;
var
frm : TForm2;
begin
frm := TForm2.Create(Application); // (Could pass Self - makes no difference)
frm.PopupParent := Self;
frm.Show;
end;

Related

MDIChild form cannot be created

Have a main form (Form1) where is created a MDIForm (Form2) and a MDIChild (Form3) form respectivelly in execution time. In my tests the MDIForm (Form2) is show like expected but when try show the MDIChild (Form3) i get the following error that say:
Cannot create form. No mdi forms are currently active
Some idea about how fix this?
program Project1;
uses
Vcl.Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2},
Unit3 in 'Unit3.pas' {Form3};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Form:
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Unit2, Unit3;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2 := TForm2.Create(Self);
Form2.Show;
Form3 := TForm3.Create(Form2);
Form3.Show;
end;
end.
The VCL (not the Win32 API) is hard-coded to allow only the Application.MainForm to be set to fsMDIForm for hosting fsMDIChild Forms. Your MainForm is not the fsMDIForm parent Form, which is why you are getting the error.
Using a secondary Form as the fsMDIForm parent is technically possible, but not out of the box. It requires a bit of manual work hacking up the VCL's internals to make it work, and even then there are holes and gotchas. See my Multiple MDI Parent Forms in a single Application submission on CodeCentral for an example (I haven't updated it in over a decade, so it may need some tweaking for modern VCL versions). The old Quality Central (not Quality Portal!) ticket it refers to can be found on archive.org: #12006: Hosting MDI child forms in non-MainForm forms.
That being said, MDI is a dead technology, Microsoft abandoned it a long time ago, and modern Windows versions have poor support for MDI, especially when Visual Styles are used. You are best off not even bothering with MDI in modern software, there are other/better UI design choices available.

TPopup subcontrols do not accept keyboard/mouse input - (Delphi XE7 FireMonkey)

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!
Decided just to go with this answer here:
Allowing keyboard input to a FireMonkey TEdit nested inside a FireMonkey TPopup
For transparency, I added a child TPanel on the fmPopup form named Content. Afterwards I set the Transparency:=True, and applied my custom style to the Content panel. Not exactly what I wanted because I had to write my own positioning/hiding procs that a TPopup already had, but my existing "initialize style" procedure worked without any modifications. I certainly welcome any better solutions.

Proper way to change focus of TEdits Delphi Xe5

I've searched around and the general answer seems to place
SomeEdit2.setFocus;
in SomeEdit1.OnExit event. I have tried this (Using Delphi Xe5, developing for iOS) and it causes the application to crash. The app does not throw an error, it just blanks out and crashes. I've tried placing the same code in other events but it does not work as expected. For example, when placed in SomeEdit1.OnChange event, when a user hits 'done' on the virtual keyboard - Focus is switched to the desired control, but the keyboard does not show and stops working properly.
What is the proper way to change focus inbetween controls when a user hits the 'done' button provided on the virtual keyboard?
You can not compare VCL-Control behaviour with FMX-Control behaviour, because sometimes they behave different - they should not, but they do.
In VCL you have an OnExit event and it occurs right after the focus has left the control. So this is an OnAfterExit event.
In FMX the OnExit event is fired before the focus gets away. So this is an OnBeforeExit.
procedure TControl.DoExit;
begin
if FIsFocused then
begin
try
if CanFocus and Assigned(FOnExit) then
FOnExit(Self);
FIsFocused := False;
Now, what has this to do with your current problem?
If you set the focus to another control inside the OnExit event, the current active control DoExit method gets called, which calls the OnExit event, and you have a perfect circle.
So you have several options to fix this
Bug Report
The best solution is to create a bug report and let emba fix this.
There is already a bug report 117752 with the same reason. So I posted the solution as a comment.
Patch FMX.Controls.pas
Copy FMX.Controls into your project source directory and patch the buggy code (just one line)
procedure TControl.DoExit;
begin
if FIsFocused then
begin
try
FIsFocused := False; // thats the place to be, before firering OnExit event
if CanFocus and Assigned(FOnExit) then
FOnExit(Self);
//FIsFocused := False; <-- buggy here
SetFocus to control
To set the focus in the OnExit you have to do some more work, because the message to change the focus to the next control is already queued. You must ensure that the focus change to the desired control take place after that already queued focus change message. The simplest approach is using a timer.
Here is an example FMX form with 3 edit controls and each of them has an OnExit event
unit MainForm;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Edit;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
EnsureActiveControl_Timer: TTimer;
procedure EnsureActiveControl_TimerTimer(Sender: TObject);
procedure Edit1Exit(Sender: TObject);
procedure Edit2Exit(Sender: TObject);
procedure Edit3Exit(Sender: TObject);
private
// locks the NextActiveControl property to prevent changes while performing the timer event
FTimerSwitchInProgress: Boolean;
FNextActiveControl: TControl;
procedure SetNextActiveControl(const Value: TControl);
protected
property NextActiveControl: TControl read FNextActiveControl write SetNextActiveControl;
public
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.Edit1Exit(Sender: TObject);
begin
NextActiveControl := Edit3;
end;
procedure TForm1.Edit2Exit(Sender: TObject);
begin
NextActiveControl := Edit1;
end;
procedure TForm1.Edit3Exit(Sender: TObject);
begin
NextActiveControl := Edit2;
end;
procedure TForm1.EnsureActiveControl_TimerTimer(Sender: TObject);
begin
EnsureActiveControl_Timer.Enabled := False;
FTimerSwitchInProgress := True;
try
if (Self.ActiveControl <> NextActiveControl) and NextActiveControl.CanFocus then
NextActiveControl.SetFocus;
finally
FTimerSwitchInProgress := False;
end;
end;
procedure TForm1.SetNextActiveControl(const Value: TControl);
begin
if FTimerSwitchInProgress
or (FNextActiveControl = Value)
or (Assigned(Value) and not Value.CanFocus)
or (Self.ActiveControl = Value)
then
Exit;
FNextActiveControl := Value;
EnsureActiveControl_Timer.Enabled := Assigned(FNextActiveControl);
end;
end.

show window before terminate

I have a delphi application that, on startup, checks to see if a process is already running, if it is running, I pass data over to that process and terminate the current process. The problem: In terminating the current process, the window of the app flashes for a split second prior to termination. All the code is in the application initialization, before that main form is even created, so I don't understand how it could show the form for a split second. I have tried numerous things like making the window invisible, nothing seems to work. Is there something I am doing wrong.
You are apparently not terminating soon enough. I'd do something like
program Project1;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
function PrevInstance: boolean;
begin
...
end;
procedure PassData;
begin
...
end;
begin
if PrevInstance then
begin
PassData;
Exit;
end;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Update: I believe you do something like
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure MyInitProc;
begin
if true then Application.Terminate;
end;
initialization
InitProc := #MyInitProc;
end.
This will not work, because Application.Terminate doesn't terminate the application immediately. Instead, it simply posts a WM_QUIT message. This message will be received and acted upon after all initialisation is completed.

How i can to Destroy (free) a Form from memory?

i have 2 Form (Form1 and Form2) in the my project, Form1 is Auto-create forms, but Form2 is Available forms.
how i can to create Form2 and unload Form1?
I received a "Access validation" Error in this code.
Here is Form1 code:
1. uses Unit2;
//*********
2. procedure TForm1.FormCreate(Sender: TObject);
3. var a:TForm2;
4. begin
5. a := TForm2.Create(self);
6. a.Show;
7. self.free; // Or self.destory;
8. end;
Thanks.
I modified that "Serg" code to this :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Application.CreateForm(TForm2, Form2);
Release;
end;
end.
///
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Form1:= TForm1.Create(Application);
Application.Run;
end.
but this project start and then exit automatically, Why?
i want to show Form1 and when we click Button1 then show Form2 and free(Release) Form1. how i can to this?
When you destroy a form, it's better to use Release.
Release is almost the same as free, but it waits for pending messages to avoid crashes.
You should never use Destroy. Free/Release calls the destructor.
Self is the current object (in your code Form1, so self.Free kills the current form. Which results in the access violation. Form1 is auto created, it is also auto destroyed so you shouldn't destroy it yourself. If you don't want it, hide it.
And you should keep a reference to the newly created form if you want to handle it later.
Your modified code should be like:
uses Unit2;
TForm1 = class (TForm)
private
FChild : TForm2;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FChild := TForm2.Create(nil);
Hide; // Hides form 1
FChild.Show;
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
FChild.Release;
end;
But Why do you want to create another form in the form create of the first form. Why not remove the first form entirely and only use the second one (auto created)?
You are trying to do something strange.
You cannot free main form without closing application, so your Form1 should not be autocreated form, both Form1 and Form2 should be created manually.
First, you should edit your project source like this to create Form1 manually:
program Project9;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Form1:= TForm1.Create(Application);
Application.Run;
end.
Form1.OnCreate should be written as
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.CreateForm(TForm2, Form2);
Release;
end;
that will make Form2 the main form of your application. As already answered you should use Release method to free the form.
If Form1 is 'autocreate', it's owned by the application object - you shouldn't free it in your code. If Form1 owns Form2, application cleans up both.
I'd do it like this, but not sure it meets your requirements:
procedure TForm1.FormCreate(Sender: TObject);
var a:TForm2;
begin
a := TForm2.Create(nil);
try
a.Show;
finally
freeandNil(a);
end;
end;
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
...
procedure TForm1.FormClose(Sender: TObject; var CanClose: Boolean);
begin
if MessageDlg ('Are you want to exit?', mtConfirmation,
[mbYes, mbNo], 0) = mrNo then
CanClose := False;
end;
So, that is all...
If all Form1 should do is initialize something but not being shown, consider using a datamodule instead. These cannot be shown but can still be autocreated.

Resources