I have a Delphi application that has a document browser as the main form. When the user opens a document, we open an editor window. We want to have each editor with a button on the task bar, as well as the main form. I've applied the normal code to do this (below), but when I click on the main form after using the editor window the editor is being left on top, while the focus is on the main form. I'm unable to work out what is causing this behaviour.
Stage setting: I open the main form and a document form.
Click on another app, click on main form, main form stays focused.
(Behaving as expected.)
Click on the document form, click on main form, document form comes
back to front, but shown inactive. (Picture shows result)
alt text http://www.matthew-jones.com/temp_xfer/titlebarfailure.jpg
First step, this is Delphi 2007, and I have in the project:
Application.MainFormOnTaskBar := True;
For the main form, I have no additional code.
For the document form, I have
procedure TCommonEditForm.CreateParams(var params: TCreateParams);
begin
inherited;
params.WndParent := 0; // GetDeskTopWindow; no diff
end;
I've tried to work out if there is a message that is making this happen, but can't locate anything appropriate. I've searched the code for anything to do with "activate". Clues welcome!
My application works in the way you describe. Here is the approach I took. I would have liked to find a simpler approach but never did.
I started out by reading these articles. This first one is an great write up by Peter Below:
http://groups-beta.google.com/group/borland.public.delphi.winapi/msg/e9f75ff48ce960eb?hl=en
Other information was also found here, however this did not prove to be a valid solution: for my use:
http://blogs.teamb.com/DeepakShenoy/archive/2005/04/26/4050.aspx
Eventually here is what I ended up with.
My splash screen doubles as the Application Main form. The Main form has a special tie to the Application Object. Using all secondary forms gets me the behavior that I was looking for.
In each form that I want on the task bar I override CreateParams. I do this on my edit forms and what the users sees as the "main form"
procedure TUaarSalesMain.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
Params.WndParent := GetDesktopWindow;
end;
My "Main" form as far as Delphi is concerned loads the true main form in its Activitate function. I use a member variable to keep track of the first activate. Then at the end of the function I hide the splash form, but do not close it. This was important for me because if the user was editing a document and closed the main form I did not want the edit screens to be forced closed at the same time. This way all of the visible forms are treated the same.
if FFirstActivate = false then
exit;
FFristActivate := false;
/*
Main Load code here
Update Splash label, repaint
Application.CreateForm
etc.
*/
// I can't change visible here but I can change the size of the window
Self.Height := 0;
Self.Width := 0;
Self.Enabled := false;
// It is tempting to set Self.Visible := false here but that is not
// possible because you can't change the Visible status inside this
// function. So we need to send a message instead.
ShowWindow(Self.Handle, SW_HIDE);
end;
But there is still a problem. You need the main/splash window to close when all other forms are closed. I have an extra check in my close routines for Parent <> nil because I use forms as plugins (form my purposes they work better than frames).
I didn't really like using the Idle event, but I don't notice this being a drag on the CPU.
{
TApplicationManager.ApplicationEventsIdle
---------------------------------------------------------------------------
}
procedure TApplicationManager.ApplicationEventsIdle(Sender: TObject;
var Done: Boolean);
begin
if Screen.FormCount < 2 then
Close;
end;
{
TApplicationManager.FormCloseQuery
---------------------------------------------------------------------------
}
procedure TApplicationManager.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
var
i: integer;
begin
for i := 0 to Screen.FormCount - 1 do
begin
if Screen.Forms[i] <> self then
begin
// Forms that have a parent will be cleaned up by that parent so
// ignore them here and only attempt to close the parent forms
if Screen.Forms[i].Parent = nil then
begin
if Screen.Forms[i].CloseQuery = false then
begin
CanClose := false;
break;
end;
end;
end;
end;
end;
{
TApplicationManager.FormClose
---------------------------------------------------------------------------
}
procedure TApplicationManager.FormClose(Sender: TObject;
var Action: TCloseAction);
var
i: integer;
begin
for i := Screen.FormCount - 1 downto 0 do
begin
if Screen.Forms[i] <> self then
begin
// Forms that have a parent will be cleaned up by that parent so
// ignore them here and only attempt to close the parent forms
if Screen.Forms[i].Parent = nil then
begin
Screen.Forms[i].Close;
end;
end;
end;
end;
This has served me well so far. I did make a small change for Vista because the icon for my "Main/Splash" screen was still showing. I don't remember what that was though. I probably don't need to set width, height, enabled, and send the hide message on the splash screen. I just wanted to make sure it didn't show up :-).
Dealing with the close events was necessary. If I remember correctly that was needed for when windows sent a shutdown message. I think only the main form gets that message.
Sorry if this is really stupid, but you don't have the formstyle set to fsStayOnTop do you? This would explain this behaviour.
perhaps add this in the createparams
Params.ExStyle := Params.ExStyle OR WS_EX_APPWINDOW;
or try this anywhere in the code. I presonally use it on the forms .OnCreate event.
SetWindowLong(Wnd, GWL_EXSTYLE,
GetWindowLong(Wnd, GWL_EXSTYLE) or WS_EX_APPWINDOW) ;
the downside of this is that if the main form is minimized the other forms hide aswell, but restore when the main form does.
Related
I am trying following code for a GUI to show 2 identical windows. I am using show rather than showmodal:
program RnTFormclass;
{$mode delphi}
uses
//cthreads, // for linux only.
Interfaces, Forms, StdCtrls;
type
RnTForm = class(TForm)
private
wnd: TForm;
btn: TButton;
public
constructor create;
procedure showit;
end;
constructor RnTForm.create;
begin
//Application.Initialize; //removed.
wnd := TForm.Create(Application);
with wnd do begin
Height := 300;
Width := 400;
Position:= poDesktopCenter;
Caption := 'LAZARUS WND';
end;
btn := TButton.Create(wnd);
with btn do begin
SetBounds(0, 0, 100, 50);
Caption := 'Click Me';
Parent := wnd;
end;
end;
procedure RnTForm.showit;
begin
wnd.Show;
end;
var
myform1, myform2: RnTForm;
begin
// create windows:
myform1 := RnTForm.Create;
myform2 := RnTForm.Create;
// show windows:
myform1.showit;
myform2.showit;
end.
I want two identical windows to show/open up. Though the program runs without any error or warning, not even one window is shown.
The program just terminates.
Where is the problem and how can it be solved? Thanks for your help.
Edit: As pointed out in the comments, Application.initialize is being called twice and not run. I have commented out Application.initialize and the code still does not open up any of the window. (It does open windows one by one if show is replaced by showModal).
Main question is how to keep window open after show?
Taking suggestions from comments, I got it working by following main method:
begin
Application.Initialize;
// create windows:
myform1 := RnTForm.Create;
myform2 := RnTForm.Create;
// show windows:
myform1.showit;
myform2.showit;
Application.run;
end.
Now both the windows appear and I can click and work on any of them.
However, on closing both the windows, the program still keeps running in background. An exit button with its click function needs to be added.
running the form below and continuously scrolling the treeview up and down will freeze the form on (my) Windows 10. The scrollbar, the form title bar and its buttons all become unresponsive, but will still update on timer events. Clicking on treeview still works normally.
On (my) Windows 7, the freezing does not happen.
On (my) Windows 10 When you click or Alt-tab away from the application and back, form becomes responsive again. Which means that whenever I switched away to Delphi IDE to pause and see what was going on, problem was gone. On one occasion I did manage to get form so stuck that switching away from it to debugger did not unfreeze it, and the Call Stack was deep inside UxTheme.dll.
As you can see in the code I have a sort of a workaround but it is not very satisfying. Can anybody explain what is going on here ?
I did my best to make the code sample below easy to run from scratch, that's why I included the .dpr The problem originates from a much more complex form updated from a background thread.
Update: just tried same sort of thing with TListView and I get no freezing.
Update: as nolaspeaker suggested, compiling without "enable runtime themes" fixes the problem.
Update: my original complex form was not fixed by compiling without "enable runtime themes" - as the app uses a custom manifest. However using DisableThemesApp from here How to switch an Application between Themed and not Themed at run-time? helped. In fact skipping STAP_ALLOW_NONCLIENT was enough.
The only downside being, on Windows 10 the app now looks like something from Deliverance - i.e. inbred :). So I will continue using my GetLastInputInfo bodge until someone suggests something better.
unit Win10Freezing;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls;
type
TWin10FreezingForm = class(TForm)
private
FTreeView: TTreeView;
procedure TimerTimer(Sender: TObject);
function HasASecondPassedSinceLastInput: boolean;
public
constructor Create(AOwner: TComponent);override;
end;
var
Win10FreezingForm: TWin10FreezingForm;
implementation
{$R *.dfm}
constructor TWin10FreezingForm.Create(AOwner: TComponent);
begin
inherited;
Width := 355;
Height := 355;
FTreeView := TTreeView.Create(self);
with FTreeView do begin
Parent := self;
Align := alClient
end;
with TTimer.Create(self) do begin
OnTimer := TimerTimer;
Interval := 2000;
Enabled := TRUE
end;
TimerTimer(self)
end;
procedure TWin10FreezingForm.TimerTimer(Sender: TObject);
var
i: Integer;
begin
//once the TreeView has been populated
//continuously scroling the listView up and down will freeze the form
//uncomment the following line as a not very good workaround
//if HasASecondPassedSinceLastInput then
with FTreeView.Items do begin
BeginUpdate;
try
Clear;
for i := 0 to 30 + Random(10) do
AddChild(nil, IntToStr(Random(100)))
finally
EndUpdate
end
end
end;
function TWin10FreezingForm.HasASecondPassedSinceLastInput: boolean;
var lii: TLastInputInfo;
begin
lii.cbSize := SizeOf(TLastInputInfo);
result := GetLastInputInfo(lii) and (GetTickCount - lii.dwTime > 1000)
end;
end.
program Win10Freeze;
uses
Vcl.Forms,
Win10Freezing in 'Win10Freezing.pas' {Win10FreezingForm};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TWin10FreezingForm, Win10FreezingForm);
Application.Run;
end.
I am using the code # http://jed-software.com/blog/?p=538 to open a dialog on OSX for selecting a folder
I'm creating a form using Form2.ShowModal, and on this form I am calling the above SelectDirectory function through a button. The form created with ShowModal is then instantly closed as soon as the NSOpenPanel is also closed... The forms OnClose event does not fire, and the ModalResult of the Form2.ShowModal call is mrNone (0), so I haven't been able to find a way to stop this unwanted behaviour. Somehow the LOpenDir.runModal; result is forcing my Form2 to close too
Any help would be fantastic, thanks.
You need to set the FRestartModal flag inside the platformservice.
LDlgResult := LOpenDir.runModal;
RestartModal;
Unfortunately this is a bit nasty, because that flag is hidden in the TPlatformCocoa class in the implementation part of the unit. I don't like hacks using RTTI, but unfortunately I haven't found a better way. So here you go:
procedure RestartModal;
//Hack: Set the FRestartModal flag in TPlatformCocoa
var
Context: TRttiContext;
RttiType: TRttiType;
Field: TRttiField;
FModalStack: TStack<TObject>;
FPlatformService: TObject;
begin
FPlatformService := TObject(TPlatformServices.Current.GetPlatformService(IFMXWindowService)); // trick for getting the MacOS Platformservice
RttiType := Context.GetType(FPlatformService.ClassType);
Field := RttiType.GetField('FModalStack'); // get private field using RTTI
Assert(Field <> nil);
FModalStack := PPointer(Field.GetValue(FPlatformService).GetReferenceToRawData)^;
if (FModalStack <> nil) and (FModalStack.Count > 0) then
begin
Field := RttiType.GetField('FRestartModal');
Field.SetValue(FPlatformService, True);
end;
end;
Some background (kind of a continuation of TLabel and TGroupbox Captions Flicker on Resize):
So, I have an application that loads different plugins and creates a
new tab on a TPageControl for each one.
Each DLL has a TForm associated with it.
The forms are created with their parent hWnd as the new TTabSheet.
Since the TTabSheets aren't a parent of the form as far as VCL is
concerned (didn't want to use dynamic RTL, and plugins made in
other languages) I have to handle resizes manually.
I just seem to be running into a lot of new issues (but great learning experiences) for this "plugin" type of application.
So, my current struggle is trying to have a plugin that doesn't get inserted into a TTabSheet but will be resized and aligned directly on the form.
Since this would be easier to explain with a picture:
Now I could manually do the alignment and the resize, but I'd much rather have the VCL alignment procedures (alClient, alTop, etc) do it for me. That way I would just have to set the plugins alignment on its form without thinking.
After looking through the VCL source I began to step through the align code and how it's called. Basically when a TControl gets a WM_RESIZE it will:
Call Realign() which calls AlignControl()
AlignControl() will get the client rect and call AlignControls()
AlignControls() will call DoAlign() for each TAlignment type in this order: alTop, alBottom, alLeft, alRight, alClient, alCustom, alNone
DoAlign() will loop through FControls and FWinControls (which are TLists) and will align them appropriately
So my thought process is that if I create a new TWinControl, set it's handle to the plugins form (window) handle, and insert it into the FControls list with the proper align it should do my work for me.
Of course I'm here, so it failed miserably. I even get an AV when exiting the application about an invalid window handle. My guess is that the TWinControl I created is trying to free the handle of the plugins form (window) which doesn't exist any more.
What I've tried:
procedure AddHandleToControlList(AHandle: DWORD; Align: TAlign);
var
NewWinControl : TWinControl;
begin
NewWinControl := TWinControl.Create(frmMain);
NewWinControl.WindowHandle := AHandle;
NewWinControl.Align := Align;
NewWinControl.Width := frmMain.ClientWidth;
NewWinControl.Height := 30;
NewWinControl.Parent := frmMain;
end;
procedure AddHandleToControlList(AHandle: DWORD; Align: TAlign);
var
NewWinControl : TWinControl;
begin
NewWinControl := TWinControl.Create(frmMain);
NewWinControl.WindowHandle := AHandle;
NewWinControl.Align := Align;
NewWinControl.Width := frmMain.ClientWidth;
NewWinControl.Height := 30;
TWinControl(frmMain).Insert(NewWinControl);
end;
Soooo, thoughts?
EDIT 1:
Ok, so this correctly adds the control to the list and conforms the the TAlign set (why is it that I spend 8 hours trying to figure something out, I post here, and then the answer just appears...oh well someone might find this question and my ramblings useful):
procedure AddHandleToControlList(AHandle: DWORD; AName: PChar; ATop, ALeft, AWidth, AHeight: Integer; AAlign: TAlign);
var
NewWinControl : TWinControl;
begin
NewWinControl := TWinControl.Create(frmMain);
With NewWinControl Do
begin
Name := AName;
Top := ATop;
Left := ALeft;
Width := AWidth;
Height := AHeight;
Align := AAlign;
WindowHandle := AHandle;
Visible := True;
end;
TWinControl(frmMain).InsertControl(NewWinControl);
end;
The issue now is that when the application closes, I get the invalid error AV...I shall continue!!
EDIT 2:
Ok, so it is TWinControl.DestroyWindowHandle that raises the AV because the window handle doesn't exist any more. I'm trying to think of a clean solution.
Derive a new class from TWinControl and override its virtual DestroyWindowHandle() method to not free the HWND you provide. The default implementation of TWinControl.DestroyWindowHandle() calls the Win32 API DestroyWnd() function.
I Delphi, I need a function which determinates if the system menu (resp. window menu, the menu that appears when the icon is clicked) is opened. The reason is that I am writing a anti-keylogger functionality which sends garbage to the current active editcontrol (this also prevents keylogger which read WinAPI messages to read the content). But if system-menu is opened, the editcontrol STILL has the focus, so the garbage will invoke shortcuts.
If I use message WM_INITMENUPOPUP in my TForm1, I can determinate when the system menu opens, but I wish that I do not have to change the TForm, since I want to write a non visual component, which does not need any modifications at the TForm-derivate-class itself.
//I do not want that solution since I have to modify TForm1 for that!
procedure TForm1.WMInitMenuPopup(var Message: TWMInitMenuPopup);
begin
if message.MenuPopup=getsystemmenu(Handle, False) then
begin
SystemMenuIsOpened := true;
end;
end;
TApplicaton.HookMainWindow() does not send the WM_INITMENUPOPUP to my hook function.
function TForm1.MessageHook(var Msg: TMessage): Boolean;
begin
Result := False;
if (Msg.Msg = WM_INITMENUPOPUP) then
begin
// Msg.Msg IS NEVER WM_INITMENUPOPUP!
if LongBool(msg.LParamHi) then
begin
SystemMenuIsOpened := true;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.HookMainWindow(MessageHook);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Application.UnhookMainWindow(MessageHook);
end;
Even after very long research I did not found any information about how to query if the system-menu is opened or not. I do not find any way to determinate the opening+closing of that menu.
Has someone a solution for me please?
Regards
Daniel Marschall
Application.HookMainWindow doesn't do what you seem to think. It hooks the hidden application window, not the main form. To intercept WM_INITMENUPOPUP on a specific form, all you need to do is write a handler for it, as you have seen.
To do this generically for any owner form of a component, you could assign WindowProc property of the form to place the hook:
unit FormHook;
interface
uses
Windows, Classes, SysUtils, Messages, Controls, Forms;
type
TFormMessageEvent = procedure(var Message: TMessage; var Handled: Boolean) of object;
TFormHook = class(TComponent)
private
FForm: TCustomForm;
FFormWindowProc: TWndMethod;
FOnFormMessage: TFormMessageEvent;
protected
procedure FormWindowProc(var Message: TMessage); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnFormMessage: TFormMessageEvent read FOnFormMessage write FOnFormMessage;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Test', [TFormHook]);
end;
procedure TFormHook.FormWindowProc(var Message: TMessage);
var
Handled: Boolean;
begin
if Assigned(FFormWindowProc) then
begin
Handled := False;
if Assigned(FOnFormMessage) then
FOnFormMessage(Message, Handled);
if not Handled then
FFormWindowProc(Message);
end;
end;
constructor TFormHook.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFormWindowProc := nil;
FForm := nil;
while Assigned(AOwner) do
begin
if AOwner is TCustomForm then
begin
FForm := TCustomForm(AOwner);
FFormWindowProc := FForm.WindowProc;
FForm.WindowProc := FormWindowProc;
Break;
end;
AOwner := AOwner.Owner;
end;
end;
destructor TFormHook.Destroy;
begin
if Assigned(FForm) and Assigned(FFormWindowProc) then
begin
FForm.WindowProc := FFormWindowProc;
FFormWindowProc := nil;
FForm := nil;
end;
inherited Destroy;
end;
end.
You could then use this component on a form:
procedure TForm1.FormHook1FormMessage(var Message: TMessage; var Handled: Boolean);
begin
case Message.Msg of
WM_INITMENUPOPUP:
...
end;
end;
The problem might be that if the form has any other components which do the same thing then you need to make sure that unhooking happens in reverse order (last hooked, first unhooked). The above example hooks in the constructor and unhooks in the destructor; this seems to work even with multiple instances on the same form.
If you don't want any modifications to TForm-derivate-class, why don't try pure Windows API way to implement your current solution, that is, use SetWindowLongPtr() to intercept the WM_INITMENUPOPUP message. Delphi VCL style to intercept messages is just a wrapper of this Windows API function actually.
For that purpose, use SetWindowLongPtr() to set a new address for the window procedure and to get the original address of the window procedure, both at one blow. Remember to store the original address in a LONG_PTR variable. In 32-bit Delphi, LONG_PTR was Longint; supposing 64-bit Delphi will have been released in the future, LONG_PTR should be Int64; you can use $IFDEF directive to distinguish them as follows:
Type
{$IFDEF WIN32}
PtrInt = Longint;
{$ELSE}
PtrInt = Int64;
{$ENDIF}
LONG_PTR = PtrInt;
The value for nIndex parameter to be used for this purpose is GWLP_WNDPROC. Also, pass the new address for the window procedure to dwNewLong parameter, e.g. LONG_PTR(NewWndProc). The NewWndProc is a WindowProc Callback Function that processes messages, it is where your put your intercept criteria and override the default handling of the message you are going to intercept. The callback function can be any name, but the parameters must follow the WindowProc convention.
Note that you must call CallWindowProc() to pass any messages not processed by the new window procedure to the original window procedure.
Finally, you should call SetWindowLongPtr() again somewhere in your code to set the address of modified/new window procedure handler back to the original address. The original address has been saved before as mentioned above.
There was a Delphi code example here. It used SetWindowLong(), but now Microsoft recommends to use SetWindowLongPtr() instead to make it compatible with both 32-bit and 64-bit versions of Windows.
SetWindowLongPtr() didn't exist in Windows.pas of Delphi prior to Delphi 2009. If you use an older version of Delphi, you must declare it by yourself, or use JwaWinUser unit of JEDI API Library.
Not tried this myself, but give this a shot:
Use GetMenuItemRect to get the rect for item 0 of the menu returned by GetSystemMenu.
I (assume!) GetMenuItemRect should return 0 if the system menu is not open (because system could not know the rect of the menu item unless it is open?) If the result is non-zero, check if the coords returned are possible for the given screen resolution.
If you have the time, you could look into AutoHotKey's source code to see how to monitor when system menu is open/closed.