Proper way to change focus of TEdits Delphi Xe5 - delphi

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.

Related

Some events not fired in TsaveDialog with FMX

I am porting a project to FMX (from VCL). I use a TSaveDialog with Filter for the file extensions, but when I change the extension the 'OnTypeChange' event does'nt fire, but the 'OnShow' event fires !
I tried TOpenDialog with the same problem.
Some informations :
Delphi Pro 10.3.1 (I tried Delphi 10.3.3)
Event 'OnFolderChange' does'nt fire.
Events 'OnClose' and 'OnShow' are OK.
Any idea ? Is there any option I missed ? Or a known bug ?
My test code : just a Form with a TButton and a TSaveDialog whith some code in the events to show if they are fired.
unit Unit1;
interface
uses
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Controls.Presentation,
FMX.StdCtrls, System.Classes;
type
TForm1 = class(TForm)
SaveDialog1: TSaveDialog;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure SaveDialog1FolderChange(Sender: TObject);
procedure SaveDialog1TypeChange(Sender: TObject);
procedure SaveDialog1Close(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.SaveDialog1Close(Sender: TObject);
begin
Self.Caption := Self.Caption + ', Close';
end;
procedure TForm1.SaveDialog1FolderChange(Sender: TObject);
begin
Self.Caption := Self.Caption + ', Folder';
end;
procedure TForm1.SaveDialog1TypeChange(Sender: TObject);
begin
Self.Caption := Self.Caption + ', Change';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Self.Caption := 'Start';
SaveDialog1.Filter := 'Applications (*.exe)|*.EXE|Text files (*.txt)|*.TXT';
SaveDialog1.Execute;
end;
end.
Thx
Although the OnFolderChange and OnTypeChange events are published and assignable in the TSaveDialog's Object Inspector these do nothing at all.
It is possible though to make these events work like in VCL by copying the source file FMX.Dialogs.Win.pas to your project folder and adding the relevant missing bits from the Vcl.Dialogs.pas source file, which include but not limited to:
References to FolderChange and TypeChange in TCustomFileDialog class.
Procedures OnFolderChangeEvent and OnTypeChangeEvent in TFileDialogWrapper class.
The whole TFileDialogEvents class.
Although these changes were tested with Delphi 10.3.3 the solution should be similar for Delphi 10.3.1 and even more recent versions as this unit hasn't changed much along time.

Delphi drag and drop files from Windows explorer to TListView does not work

I'm using Delphi 10.3 Community Edition. I'm trying to drag and drop files from a Windows folder onto my application but the Windows message handler is not called when I drag and drop a file on the form.
This is what I have at the moment:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
protected
procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
ShellApi;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Disable drag accept files
DragAcceptFiles(Self.Handle, true);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Enable drag accept files
DragAcceptFiles(Self.Handle, true);
end;
procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
begin
// Show a message
ShowMessage('File dropped');
// Set the message result
Msg.Result := 0;
inherited;
end;
end.
Like I said, when I drag and drop a file on the form, I can see that the file is accepted when dragged onto the form but when I drop the file, the WMDropFiles procedure is not called.
I also tried enabling the DragAcceptFiles in the CreateWnd procedure. But it still does not work.
...
public
procedure CreateWnd; override;
procedure DestroyWnd; override;
...
procedure TForm1.CreateWnd;
begin
inherited;
DragAcceptFiles(Handle, True);
end;
procedure TForm1.DestroyWnd;
begin
DragAcceptFiles(Handle, False);
inherited;
end;
I even tried running the Delpi IDE as Administrator.
Could it be a limitation of the Community Edition or am I missing something?
Addendum
I've now added a button to send a message WM_DROPFILES.
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(Self.Handle, WM_DROPFILES, Integer(self), 0);
end;
When I click the button, the WMDropFiles procedure is called. So then it works.
Ok, very interesting. I found this article:
How to Enable Drag and Drop for an Elevated MFC Application on Vista/Windows 7
So I added the following to my form create procedure:
procedure TForm1.FormCreate(Sender: TObject);
begin
// Enable drag accept files
DragAcceptFiles(Form1.Handle, true);
ChangeWindowMessageFilter (WM_DROPFILES, MSGFLT_ADD);
ChangeWindowMessageFilter (WM_COPYDATA, MSGFLT_ADD);
ChangeWindowMessageFilter ($0049, MSGFLT_ADD);
end;
And now it is working!
I changed the topic to include text "TListView" because I actually want to drop files on a TListView. Since I've solved the problem with dropping files on a form, I still had an issue with dropping files on a TListView.
So to drop the files on a TListView, you have to change the Handle to the listview's handle:
// Enable drag accept files
DragAcceptFiles(MyListview.Handle, true);
and
// Disable drag accept files
DragAcceptFiles(MyListview.Handle, false);
But that alone is not enough. You then need a Application events handler to catch the messages and handle them accordingly. So I just added a TApplicationEvents component to the form and added the following to the OnMessage event:
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
// If it is a drop files message and it is for the listview
if ((Msg.message = WM_DROPFILES)and (Msg.hwnd = MyListView.Handle)) then
begin
// Handle your dropped data here
end;
end;

Delphi while loop causing program to stop responding

I'm using Delphi 7 and the program I am writing needs to continuously draw on the screen. While it currently doesn't draw anything important, this is a necessity in the program later on. However, when I put the procedure for drawing the screen in a while loop which can only be stopped by pressing any button the program stops responding completely. I don't understand why this is happening. Surely, as the while loop can be exited, the program should continue to run fine.
Here is the source code:
unit DD04f1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TeCanvas, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Image1OnCreate();
procedure ScreenRender();
procedure OnCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
IsDone : Boolean;
implementation
{$R *.dfm}
procedure TForm1.OnCreate(Sender: TObject);
begin
IsDone := False;
end;
procedure TForm1.Image1OnCreate ();
var
Count:Integer;
begin
image1.canvas.Create();
image1.canvas.Pen.Color:=clBlack;
image1.canvas.rectangle(0,0,640,480);
image1.canvas.Pen.Color:=$ed630e; //bgr instead of rgb
Count:=0;
While (Count <> 640) do
begin
image1.Canvas.moveto(Count,0);
image1.Canvas.LineTo(Count,480);
Count:=Count+1;
end;
end;
procedure TForm1.ScreenRender();
var
Count : Integer;
begin
Count:=0;
While(Count<>640) do
begin
image1.Canvas.moveto(Count,0);
image1.Canvas.LineTo(Count,480);
Count:=Count+1;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1OnCreate();
Button1.Visible := False;
While(IsDone = False) do
begin
ScreenRender();
end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
IsDone := True;
end;
end.
procedure TForm1.OnCreate(Sender: TObject);
begin
IsDone := False;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1OnCreate();
Button1.Visible := False;
While(IsDone = False) do
begin
ScreenRender();
end;
end;
Assuming IsDone is always False (because otherwise we would not enter the loop), this loop can not terminate. It is infinite.
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
IsDone := True;
end;
You do not call this procedure from inside TForm1.Button1Click loop, hence it can never be called after you entered that loop. Since you never exit the TForm1.Button1Click procedure you do not allow any outside agent (like messages dispatch loop in VCL) to get executed and call that procedure either. To sum it up as soon as you entered the loop there is no any executable code that can change IsDone value. So, it is not changed.
Event handlers are supposed to be very short procedures, executing almost immediately, and giving up "execution flow control" back to VCL internals. Every long (more so infinite) processing leads to the program becomes irresponsive. No matter how many news Windows might want to tell the program - the program never asks for them.
https://en.wikipedia.org/wiki/Event-driven_programming
https://msdn.microsoft.com/en-us/library/windows/desktop/ms644927.aspx
https://msdn.microsoft.com/en-us/library/windows/desktop/ms632593.aspx
It was once told that Windows windows (GDI objects) are living in the center of the "messages storm" that they have to work out in timely matter. Hundreds of those messages are incoming every second and a Window Procedure (built inside the VCL classes for Delphi 7 forms) should receive, dispatch, and process every one of them before it's too late.
As soon as you blocked that process by making one of event handlers long or even endless - you broke the basic contract between the OS and the application.
You have to do "inversion of control", to break your continuous work into small short chunks and make Windows call those chunks when it sees appropriate.
Try to use TTimer for example.
PS. A VERY remote problem you can look at:
How to use Pipeline pattern in Delphi
How to Stop all Pipeline tasks correctly
Skip all the multithreading stuff there, for your case it only is important that other threads create those "chunks of work" that we have to paint onto our forms when Windows asks us to do so at some reasonable framerate (not too fast and not too slow). Your work chunks are fundamentally different, so all the threading stuff unrelated to you.
And the rendering is made inside TTimer events. So the "framework" of setting up the timer, turning it on and off might be of some interest to you. However the work you are going to do inside the .OnTimer event would be significantly different (just painting something, or even merely invalidating some part of the form and waiting for the Windows to trigger OnPaint event.).
You already got an excellent answer why your current code does not work and in your comments you are mentioning you want to do ray casting and drawing from a players perspective, so I assume some kind of game background.
I'm not sure the VCL is the best basis for a game. Different philosophies and needs. As Arioch 'The explained Delphi's VCL is event driven. Things happen in response to windows messages, even painting. If nothing causes a need to repaint, nothing will be painted anew.
This is very different from how I understand game engines (I'm by no means an expert). Even if nothing happens, they will continuously draw frame after frame to present as fluid as possible. Each frame might include an update to underlying structures based on game rules, physics, player input, animation, but even when they remain the same a new frame will be drawn. Basically three steps happen in a simplified 'game loop'
Input
Update
Presentation
All this happens for every frame. There might be no input, no update of the game's structures or even no presentation is desired. But all three steps belong together, the input causing an update that is later presented happened in the exact same frame as the resulting drawing.
This is something I find hard to fit into the VCL. As a solution must be based on the existing VCL loop and windows messages. You basically attempted to create such a game loop in VCL.
A way to solve your immediate issue - that you want to present something based on a calculation - could be just using the principle of the VCL. You want to have something drawn. VCL controls normally communicate their desire to be drawn by Invalidate, causing their BoundsRect to be invalidated. You could do that after you have done your calculations. In the following example I'll just use a timer to simulate your calculations are done. Just be aware that Invalidate will cause WM_PAINT messages to be generated for the control, but will not cause immediate repainting. There might be messages queued before the WM_PAINT is processed.
I'm using a TPaintBox's OnPaint to actually do the painting work, you might want to have your own control for that in the future when your project progresses.
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
type
TFormMain = class(TForm)
procedure FormCreate(Sender: TObject);
private
Timer1: TTimer;
PaintBox1: TPaintBox;
{ Private declarations }
procedure PaintBox1Paint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
public
{ Public declarations }
end;
implementation
{$R *.dfm}
procedure TFormMain.FormCreate(Sender: TObject);
begin
PaintBox1 := TPaintBox.Create(Self);
PaintBox1.Parent := Self;
PaintBox1.Align := alClient;
PaintBox1.OnPaint := PaintBox1Paint;
Timer1 := TTimer.Create(Self);
Timer1.Interval := 100;
Timer1.OnTimer := Timer1Timer;
Randomize;
end;
procedure TFormMain.PaintBox1Paint(Sender: TObject);
var
AColor: TColor;
I: Integer;
begin
for I := 0 to PaintBox1.ClientWidth - 1 do
begin
AColor := RGB(Random(256), Random(256), Random(256));
PaintBox1.Canvas.Pen.Color := AColor;
PaintBox1.Canvas.MoveTo(I, 0);
PaintBox1.Canvas.LineTo(I, PaintBox1.ClientHeight);
end;
end;
procedure TFormMain.Timer1Timer(Sender: TObject);
begin
PaintBox1.Invalidate;
end;
end.

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.

How to not have a MainForm in Delphi?

i've been trying to get some modeless forms in my application to appear on the taskbar - taking advantage of the new useful taskbar in Windows 7.
There's are many issues with the VCL that need to be undone before a form can exist on the taskbar.
But the final issue is that minimizing the form that the VCL has designated the main form causes all windows in the application to vanish.
Ten years ago, Peter Below (TeamB) documented these problems, and attempts to work around them. But there are some issues that cannot be solved. The issues run so deep within the VCL itself, that it's effectively impossible to make Delphi applications behave properly.
It all stems from the fact that the button you see on the toolbar does not represent the application's window; it represents the TApplications window, which is hidden and never seen. And then there is the application's MainForm, which is then imbued with special abilities where if it is minimized then it instructs the application to hide itself.
It seems to me that if i can do
Application.MainForm := nil;
then all these bugs would go away. The application can have its hidden window, and in the meantime i'll override every other form in the application, including my main form, with:
procedure TForm2.CreateParams(var params: TCreateParams );
begin
inherited CreateParams(params);
params.ExStyle := params.ExStyle or WS_EX_APPWINDOW;
end;
But in Delphi the Application.MainForm property is read-only.
How can i not have a MainForm in Delphi?
See also
(stackoverflow) Delphi: What is Application.Handle?
(newsgroup) Hiding Main Window but not child
You cannot run a GUI project without a MainForm assigned. The main message loop will exit immediately without one. However, that does not mean that the MainForm has to run your UI. You can use a blank hidden TForm as the assigned MainForm, and then have it instantiate your real MainForm as a secondary TForm. For example:
HiddenMainFormApp.dpr:
project HiddenMainFormApp;
uses
..., Forms, HiddenMainForm;
begin
Application.Initialize;
Application.CreateForm(THiddenMainForm, MainForm);
Application.ShowMainForm := False;
Application.Run;
end.
HiddenMainForm.cpp:
uses
..., RealMainForm;
procedure THiddenMainForm.FormCreate(Sender: TObject);
begin
RealMainForm := TRealMainForm.Create(Self);
RealMainForm.Show;
end;
RealMainForm.cpp:
procedure TRealMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
Application.Terminate;
end;
Alternatively:
HiddenMainFormApp.dpr:
project HiddenMainFormApp;
uses
..., Forms, HiddenMainForm, RealMainForm;
begin
Application.Initialize;
Application.CreateForm(THiddenMainForm, MainForm);
Application.ShowMainForm := False;
RealMainForm := TRealMainForm.Create(Application);
RealMainForm.Show;
RealMainForm.Update;
Application.Run;
end.
RealMainForm.cpp:
procedure TRealMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
Application.Terminate;
end;
You can't, especially in Delphi 5.
Your quote concerning the TApplication window being the one seen on the task bar hasn't been true for several Delphi versions now (I believe D2007 changed it).
Because you're using Delphi 5, you're using an outdated copy of Delphi; current versions have almost none of the things you're writing about any longer. I'd suggest you upgrade to a later version of Delphi (D5 is extremely old); Delphi 2007 if you need to avoid Unicode, Delphi XE if you can use (or don't mind having) Unicode support in the VCL and RTL.
The things you're describing are not bugs, BTW. They were intentional design decisions made at the time Delphi 1 was being designed, and through Delphi 7 worked fine with the versions of Windows that were available. Changes in later versions of Windows (XP/Vista/Win7 and the equivalent Server versions) made changes in that architecture necessary, and they were made as Delphi progressed along with Windows. Because you've chosen not to progress with your version of Delphi to keep it more recent doesn't make the things you write about magically become bugs. :-)
Having Application.MainForm assigned seems not to be a problem here for showing another modeless form on the taskbar while minimizing the MainForm.
Project1.dpr:
program Project1;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {MainForm},
Unit2 in 'Unit2.pas' {Form2};
{$R *.res}
var
MainForm: TMainForm;
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
ShowWindow(Application.Handle, SW_HIDE);
Application.Run;
end.
Unit1.pas:
unit Unit1;
interface
uses
Windows, Messages, Classes, Controls, Forms, StdCtrls, Unit2;
type
TMainForm = class(TForm)
ShowForm2Button: TButton;
ShowForm2ModalButton: TButton;
procedure ShowForm2ButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ShowForm2ModalButtonClick(Sender: TObject);
private
FForm2: TForm2;
procedure ApplicationActivate(Sender: TObject);
procedure Form2Close(Sender: TObject; var Action: TCloseAction);
procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
protected
procedure CreateParams(var Params: TCreateParams); override;
end;
implementation
{$R *.dfm}
procedure TMainForm.FormCreate(Sender: TObject);
begin
Visible := True; //Required only for MainForm, can be set designtime
Application.OnActivate := ApplicationActivate;
end;
procedure TMainForm.ApplicationActivate(Sender: TObject);
{ Necessary in case of any modal windows dialog or modal Form active }
var
TopWindow: HWND;
I: Integer;
begin
TopWindow := 0;
for I := 0 to Screen.FormCount - 1 do
begin
Screen.Forms[I].BringToFront;
if fsModal in Screen.Forms[I].FormState then
TopWindow := Screen.Forms[I].Handle;
end;
Application.RestoreTopMosts;
if TopWindow = 0 then
Application.BringToFront
else
SetForegroundWindow(TopWindow);
end;
procedure TMainForm.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
ExStyle := ExStyle or WS_EX_APPWINDOW;
WndParent := GetDesktopWindow;
end;
end;
procedure TMainForm.WMSysCommand(var Msg: TWMSysCommand);
begin
if Msg.CmdType = SC_MINIMIZE then
ShowWindow(Handle, SW_MINIMIZE)
else
inherited;
end;
{ Testing code from here }
procedure TMainForm.ShowForm2ButtonClick(Sender: TObject);
begin
if FForm2 = nil then
begin
FForm2 := TForm2.Create(Application); //Or: AOwner = nil, or Self
FForm2.OnClose := Form2Close;
end;
ShowWindow(FForm2.Handle, SW_RESTORE);
FForm2.BringToFront;
end;
procedure TMainForm.Form2Close(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
FForm2 := nil;
end;
procedure TMainForm.ShowForm2ModalButtonClick(Sender: TObject);
begin
with TForm2.Create(nil) do
try
ShowModal;
finally
Free;
end;
end;
end.
Unit2.pas:
unit Unit2;
interface
uses
Windows, Messages, Classes, Controls, Forms;
type
TForm2 = class(TForm)
private
procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
protected
procedure CreateParams(var Params: TCreateParams); override;
end;
implementation
{$R *.dfm}
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
ExStyle := ExStyle or WS_EX_APPWINDOW;
WndParent := GetDesktopWindow;
end;
end;
procedure TForm2.WMSysCommand(var Msg: TWMSysCommand);
begin
if Msg.CmdType = SC_MINIMIZE then
ShowWindow(Handle, SW_MINIMIZE)
else
inherited;
end;
end.
(Tested with D5 and D7 on XP and Win7.)
(And yes, you may flag this as being not an answer, because it isn't: There still is a MainForm. But I dó like to think this answers the question behind the question...)
I can't speak for Delphi 5, but in Delphi 7 you can definitely run without a mainform if you're willing to get your hands dirty. I covered a lot of the details in another answer here.
Since Delphi 5 doesn't have the MainFormOnTaskbar property, you need to do the following in your dpr:
// Hide application's taskbar entry
WasVisible := IsWindowVisible(Application.Handle);
if WasVisible then
ShowWindow(Application.Handle, SW_HIDE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
if WasVisible then
ShowWindow(Application.Handle, SW_SHOW);
// Hide the hidden app window window from the Task Manager's
// "Applications" tab. Don't change Application.Title since
// it might get read elsewhere.
SetWindowText(Application.Handle, '');
That will hide the application window, and as long as you override your form's CreateParams to set Params.WndParent := 0 each of them will have a taskbar entry of their own. Application.MainForm isn't assigned, so things like the minimize override aren't an issue, but you do have to be careful about any code that assumes MainForm is valid.
You can put your modeless forms in a dll, then they act pretty much on their own. (If you do not use the Application instance of the dll while creating them (Application.CreateForm) then Application.Mainform is nil in the dll).
Of course this might not be feasible depending on what the forms might need to do.
Actually most of what you are complaining about is in fact the design of Windows rather than the VCL. See Windows Features for all the details.
The crux of the matter is the owner property, and I mean the windows owner rather than the VCL owner.
An owned window is hidden when
its owner is minimized.
If you wish to be able to minimise the main form without other windows being hidden then you need to get on top of how owned windows work.

Resources