Shortcut triggers TAction on first created form instead of form with focus - delphi

I found (in Delphi 2010) that shortcuts always end up on first form (as owned by main form) that has that action, but not the currently focused form. My TMainFrm owns several TViewFrm. Each has a TActionManager with the same TActons.
I see some ways out, but wonder whats the best fix.. (and not a bad hack)
The forms are navigated using a tabset which calls their Hide() and Show(). I'd did not expect hidden forms to receive keypresses. Am i doing something wrong?
It seems that action shortcuts are always start at the main form, and using TCustomForm.IsShortCut() get distributed to owned forms. I see no logic there to respect hidden windows, should i override it and have it trigger the focused form first?
Disabling all TActions in TViewFrm.Hide() .. ?
Moving the TActionToolBar to TMainFrm but that is a pit of snakes and last resort.

I have found a workaround thats good enough for me; my main form now overrides TCustomForm.IsShortcut() and first checks visible windows from my list of editor tabs.
A list which i conveniently already have, so this might not work for everyone.
// Override TCustomForm and make it check the currently focused tab/window first.
function TFormMain.IsShortCut(var Message: TWMKey): Boolean;
function DispatchShortCut(const Owner: TComponent) : Boolean; // copied function unchanged
var
I: Integer;
Component: TComponent;
begin
Result := False;
{ Dispatch to all children }
for I := 0 to Owner.ComponentCount - 1 do
begin
Component := Owner.Components[I];
if Component is TCustomActionList then
begin
if TCustomActionList(Component).IsShortCut(Message) then
begin
Result := True;
Exit;
end
end
else
begin
Result := DispatchShortCut(Component);
if Result then
Break;
end
end;
end;
var
form : TForm;
begin
Result := False;
// Check my menu
Result := Result or (Menu <> nil) and (Menu.WindowHandle <> 0) and
Menu.IsShortCut(Message);
// Check currently focused form <------------------- (the fix)
for form in FEditorTabs do
if form.Visible then
begin
Result := DispatchShortCut(form);
if Result then Break;
end;
// ^ wont work using GetActiveWindow() because it always returns Self.
// Check all owned components/forms (the normal behaviour)
if not Result then
Result := inherited IsShortCut(Message);
end;
Another solution would be to change DispatchShortCut() to check for components being visible and/or enabled, but that might impact more than i'd like. I wonder whether the original code architects had a reason not to -- by design. Best would be have it called twice: first to give priority to visible+enabled components, and second call as fallback to normal behavior.

Related

Accelerator keys for `TActionToolBar` not working

I cannot get the accelerator keys for a TActionToolBar to work.
This is what I am doing (reproducable in D2006, XE4):
Select New -> VCL Forms Application
Add ActionManager1 to the form
Add a new action Action1 in ActionManager1, set caption of action to &Test
Add ActionToolBar1 to the form
Add an item to ActionManager.ActionBars and set ActionManager.ActionBars[0].ActionBar to ActionToolBar1
Add an item to ActionManager.ActionBars[0].Items and set Action to Action1
Set the Action1.OnExecute event to show a message
Start program --> toolbar is displayed just fine and works via mouse
Press ALT+T --> nothing happens, but a Ding sound
What step am I missing?
As the existing answer points out, action toolbars do not support this functionality.
My personal opinion is that, this has been overlooked. Toolbar buttons often showing images instead of text might be one reason to do so (at least it was for me). However, evidently, toolbar buttons have the functionality when they show their captions, so could the action toolbar buttons.
#Silver points out in a comment that action bars have the capability to find accelerated items. In fact action menus use that functionality. Same functionality could easily be integrated into TCustomForm.IsShortCut for action toolbars, which already iterates action lists to find possible shortcut targets.
We can override the method and do it ourselves. Below example gives priority to default handling so assigned shortcuts will suppress keyboard accelerators with the same character, but this logic could easily be reversed.
function TForm1.IsShortCut(var Message: TWMKey): Boolean;
var
Item: TActionClientItem;
i: Integer;
begin
Result := inherited IsShortCut(Message);
if not Result and (KeyDataToShiftState(Message.KeyData) = [ssAlt]) then begin
for i := 0 to ActionManager1.ActionBars.Count - 1 do begin
if ActionManager1.ActionBars[i].ActionBar is TActionToolBar then begin
Item := TActionToolBar(ActionManager1.ActionBars[i].ActionBar)
.FindAccelItem(Message.CharCode);
if Assigned(Item) and Item.ShowCaption and Assigned(Item.Action)
and Item.Action.Execute then begin
Result := True;
Break;
end;
end;
end;
end;
end;
It seems that accelerator keys are not implemented for TActionToolBar - so no steps missing.
The following is not a real solution but a workaround that adds shortcuts by parsing the captions of the action (thanks to the suggestion of #KenWhite). A real solution for the question you will find in the accepted answer. I'll keep that answer for reference anyway:
uses System.Actions, System.UiTypes, Vcl.Menus, Vcl.ActnMan;
procedure AddShortCutsFromActionCaption(AActionMan: TActionManager);
var
Act: TContainedAction;
AccelKey: string;
I: Integer;
begin
for I := 0 to AActionMan.ActionCount - 1 do
begin
Act := AActionMan.Actions[I];
if Act.ShortCut = 0 then
begin
AccelKey := GetHotKey(Act.Caption);
if AccelKey <> '' then
Act.ShortCut := TextToShortCut('Alt+' + AccelKey);
end;
end;
end;
AddShortCutsFromActionCaption must be run once for ActionManager1 after the localization is run. That way the different accelerator keys for different languages remain functional.
If a shortcut already exists or if the caption of the action is modified, this workaround will not work - but for my purposes this is okay.

Delphi- How to Call ActionList on button click?

I'm making a multi-device application in Delphi XE8 which uses LiveBindings to a dataset.
There are a number of LB-specific Actions for FMX, including TFMXBindNavigateDelete. I'm trying to use this in a button-click handler like this:
Button Click Code:
procedure TForm1.Button1Click(Sender: TObject);
begin
if cdsOrdersSTATUS.Value='READY' then
begin
ShowMessage('Your Order Is Already READY/PENDING!');
end
else
begin
TAction(ActionList1.Actions[0]).Execute; //Not working,why?
end;
end;
The first (and only) item in ActionList1's Actions is my FMXBindNavigateDelete1.
The problem is, even if the code TAction(ActionList1.Actions[0]).Execute executes, the current dataset record is not deleted, so apparently
TFMXBindNavigateDelete's Action has no effect. Why is this, and how can I make it work?
Pic. ActionList1:
Actually, I think this is a good question and doesn't deserve the downvote.
I can reproduce your problem. I put two buttons on the FMX form. I set
Button1's OnClick to your Button1Click and Button2's Action to LiveBindingsBindNavigateDelete1.
Clicking Button2 pops up the standard 'Delete record?' confirmation and deletes the current record
if I answer "Yes", as expected.
However, when clicking Button1, even if your else block executes, the 'Delete record?' confirmation
does not appear, so the record has no chance of being deleted.
The reason is in the code
function TCustomAction.Execute: Boolean;
begin
Result := False;
if Supported and not Suspended then
begin
Update;
if Enabled and AutoCheck then
if (not Checked) or (Checked and (GroupIndex = 0)) then
Checked := not Checked;
if Enabled then
Result := ((ActionList <> nil) and ActionList.ExecuteAction(Self)) or
((Application <> nil) and Application.ExecuteAction(Self)) or inherited Execute or
((Application <> nil) and Application.ActionExecuteTarget(Self));
end;
end;
The Enabled property seems by default to be set to False during the call to
Update so the if Enabled then ... never executes. I haven't managed to find
a way to get Enabled set to True during the call to Update. Perhaps someone else knows how to do that.
In the case of Button2, execution then passes to TComponent.ExecuteAction and
it is the call to Action.ExecuteTarget(Self) in it which results in the
record-deletion routine executing.
So, from that, your problem seemed to me to become how to adjust the code so that
TComponent.ExecuteAction gets executed, in other words, how to associate the
Action with a component. The answer was fairly obvious.
All that's needed is this
procedure TForm1.Button1Click(Sender: TObject);
begin
if cdsOrdersSTATUS.Value='READY' then
begin
ShowMessage('Your Order Is Already READY/PENDING!');
end
else
begin
Button1.ExecuteAction(LiveBindingsBindNavigateDelete1); // <- this works
//LiveBindingsBindNavigateDelete1.Execute; //Not working,why?
end;
end;
I didn't understand exactly what you wanted to do but if you trigger the action by it's index, you can do something like this:
TAction(ActionList1.Actions[0]).Execute;

When iterating through controls on a form, how can I identify particular buttons?

I need to make some changes to a TaskDialog before it is shown to the user. It's fairly simple to use Windows API calls to work with each of the controls on the dialog box. I need to be more sure which button I have found. I would have expected to find a place where I could read the result the button would give if pressed.
in other words, if I pressed a button that would cause a return value (in Delphi, it's called a modal result) of 100, I would have expected there to be an API call I could call to find out what the button's "return value" would be. I haven't yet found any such call.
I don't want to rely on the button text..
Here's what I have so far.
function EnumWindowsProcToFindDlgControls(hWindow: HWND; _param:LPARAM): BOOL; stdcall;
var
sClassName:string;
hBMP:THandle;
i:integer;
begin
SetLength(sClassName, MAX_PATH);
GetClassName(hWindow, PChar(sClassName), MAX_PATH);
SetLength(sClassName, StrLen(PChar(sClassName)));
if sClassName='Button' then
begin
// always 0...
i:=GetDlgCtrlID(hWindow);
if (i=100) or (i=102) then
begin
hBmp := LoadImage(HInstance, 'DISA', IMAGE_BITMAP, 0, 0, LR_DEFAULTSIZE or LR_LOADTRANSPARENT );
SendMessage(hWindow, BM_SETIMAGE, WPARAM(IMAGE_BITMAP), LPARAM(hBmp));
end;
end;
// keep looking
Result:=true;
end;
procedure TForm2.TaskDialog1DialogConstructed(Sender: TObject);
begin
EnumChildWindows(TaskDialog1.Handle, #EnumWindowsProcToFindDlgControls, 0);
end;
I suspect it's not entirely "respectable" to do things like this with a dialog.
This is a Delphi 10 Win32 application using Delphi's VCL TTaskDialog component which is a wrapper around Windows task dialog feature. before it's shown, the OnConstructed event fires, executing this code.
Thank you for your help!
Win32 buttons do not have "return values", which is why there is no API to retrieve such a value from them. What you are thinking of is strictly a VCL feature.
In Win32 API terms, a button can have a control ID, and in the case of MessageBox(), for example, standard ID values like IDOK, IDCANCEL, etc are assigned to the dialog buttons. When a button is clicked and the dialog is closed, the button's control ID is used as the function return value.
But task dialogs do not use control IDs, which is why you do not see any assigned to the dialog buttons.
To identify a particular task dialog button, I can think of two ways:
during child enumeration, retrieve each button's caption text (GetWindowText()), and compare that to captions you are interested in. Just know that the standard buttons (from the TTaskDialog.CommonButtons property) use localized text, which does not make this a well-suited option for locating standard buttons unless you have control over the app's locale settings.
send the dialog a TDM_ENABLE_BUTTON message to temporarily disable the desired button that has a given ID, then enumerate the dialog's controls until you find a disabled child window (using IsWindowEnabled()), and then re-enable the control. You can then manipulate the found window as needed.
For Task Dialog messages and Task Dialog Notifications that operate on buttons (like TDN_BUTTON_CLICKED, which triggers the TTaskDialog.OnButtonClicked event), the standard buttons use IDs like IDOK, IDCANCEL, etc while custom buttons (from the TTaskDialog.Buttons property) use their ModalResult property as their ID.
You can send TDM_ENABLE_BUTTON directly via SendMessage() for standard buttons, or via the TTaskDialogBaseButtonItem.Enabled property for custom buttons.
For #2, this works when I try it:
uses
Winapi.CommCtrl;
function FindDisabledDlgControl(hWindow: HWND; _param: LPARAM): BOOL; stdcall;
type
PHWND = ^HWND;
begin
if not IsWindowEnabled(hWindow) then
begin
PHWND(_param)^ := hWindow;
Result := False;
end else
Result := True;
end;
procedure TForm2.TaskDialog1DialogConstructed(Sender: TObject);
var
hButton: HWND;
begin
// common tcbOk button
SendMessage(TaskDialog1.Handle, TDM_ENABLE_BUTTON, IDOK, 0);
hButton := 0;
EnumChildWindows(TaskDialog1.Handle, #FindDisabledDlgControl, LPARAM(#hButton));
SendMessage(TaskDialog1.Handle, TDM_ENABLE_BUTTON, IDOK, 1);
if hButton <> 0 then
begin
// use hButton as needed...
end;
// custom button
TaskDialog1.Buttons[0].Enabled := False;
hButton := 0;
EnumChildWindows(TaskDialog1.Handle, #FindDisabledDlgControl, LPARAM(#hButton));
TaskDialog1.Buttons[0].Enabled := True;
if hButton <> 0 then
begin
// use hButton as needed...
end;
end;

How can you tell if a TJvDockServer Form is unpinned or pinned?

I was just wondering if anybody knew how to determine if a TJvDockServer Form is pinned or unpinned easily. The only way I've been able to do so is by checking if a parent form is a TJvDockVSPopupPanel via...
ancestor := GetAncestors(Self, 3);
if (ancestor is TJvDockTabHostForm) then
if ancestor.Parent <> nil then
begin
if ancestor.Parent is TJvDockVSPopupPanel then
begin
// Code here
end;
end;
and getAncestors is...
function GetAncestors(Control : TControl; AncestorLevel : integer) : TWinControl;
begin
if (Control = nil) or (AncestorLevel = 0) then
if Control is TWinControl then
result := (Control as TWinControl)
else
result := nil // Must be a TWinControl to be a valid parent.
else
result := GetAncestors(Control.Parent, AncestorLevel - 1);
end;
I would check DockState first, like this:
function IsUnpinned(aForm:TMyFormClassName):Boolean;
begin
result := false;
if Assigned(aForm) then
if aForm.Client.DockState = JvDockState_Docking then
begin
// it's docked, so now try to determine if it's pinned (default state,
// returns false) or unpinned (collapsed/hidden) and if unpinned, return true.
if aForm.Client.DockStyle is TJvDockVSNetStyle then
begin
if Assigned(aForm.Parent) and (aForm.Parent is TJvDockVSPopupPanel) then
begin
result := true;
end;
end;
end;
end;
Unpinned means that the dock style supports a bimodal (click it's on, click it's off) state change from pinned (the default state when you dock) to unpinned (but still docked) state which is entirely hidden except for a tiny name-plate marker.
The above code I wrote does not recurse through parents, and so it does not handle the case that your code is trying to handle it seems, which is if the form is part of a tabbed notebook which is then hidden inside a JvDockVSPopupPanel. (Make three pages, then hide them all by unpinning). You would need to use the Ancestors approach in that case, but I would at least still add the check to
TJvDockClient.DockState to whatever approach you use.
However, your approach which appears to hard code a 3 level recursion is probably only applicable to your exact set of controls, so I would consider rewriting it generally, by saying "If aForm has a parent within the last X generations of parents that is a TJvDockVSPopupPanel, then return true, otherwise return false".

Delphi - overriding hide behaviour of TForm.showModal

I am currently writing a windowing system for an existing Delphi application.
Currently, the program consists of a number of full-sized forms which are shown modally in the order they are required and none of which can be moved by the user. My aim is to allow all of these forms to be moveable. Previously forms were stacked on top of each other but since none could be moved the background forms were not visible to the user. My solution so far has been to hide the 'parent' form when opening a new child, and reshowing it when that child is closed.
Unfortunately since each child is called with showModal, the call the make the parent form visible does not come until after the modal process has completed and hence after the child form has been hidden so the user sees a split second flash where no form is visible.
Is there a way I can prevent the modal forms from being hidden automatically after their process has completed? This would allow me to manually hide them once the parent form is visible again. I have tried to schedule this in the FormHide event of each child form but this does not work as a child form is also hidden when opening one of its own children.
EDIT:
Here is what I have so far based of Remy's advice below
procedure openModalChild(child: TForm; parent: TForm);
var
WindowList: Pointer;
SaveFocusCount: Integer;
SaveCursor: TCursor;
SaveCount: Integer;
ActiveWindow: HWnd;
Result: integer;
begin
CancelDrag;
with child do begin
Application.ModalStarted;
try
ActiveWindow := GetActiveWindow;
WindowList := DisableTaskWindows(0);
//set the window to fullscreen if required
setScreenMode(child);
try
Show; //show the child form
try
SendMessage(Handle, CM_ACTIVATE, 0, 0);
ModalResult := 0;
repeat
Application.HandleMessage;
//if Forms.Application.FTerminate then ModalResult := mrCancel else
if ModalResult <> 0 then closeModal(child as TCustomForm);
until ModalResult <> 0;
Result := ModalResult;
SendMessage(Handle, CM_DEACTIVATE, 0, 0);
if GetActiveWindow <> Handle then ActiveWindow := 0;
finally
parent.Show;
Hide;
end;
finally
EnableTaskWindows(WindowList);
parent.Show; //reshow the parent form
if ActiveWindow <> 0 then SetActiveWindow(ActiveWindow);
end;
finally
Application.ModalFinished;
end;
end;
end;
This works well but the only problem is the active repeat loop never breaks, even after the child has been escaped and so the parent form is never reshown.
Is there any way I can resolve this?
ShowModal() explicitally calls Show() just before entering its modal processing loop, and explicitally calls Hide() immediately after exiting the loop. You cannot change that without altering the code in the VCL's Forms.pas source file.
If you need finer control over the windows, without editing VCL source code, then don't use ShowModal() at all. Use Show(), Hide(), DisableTaskWindows(), and EnableTaskWindows() yourself as needed. I would sugest you look at Forms.pas to see how they are used. Copy the implementation of ShowModal() into your own function, then you can customize it as needed.

Resources