Accelerator keys for `TActionToolBar` not working - delphi

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.

Related

How to show "NUMERIC KEYPAD" for menu item shortcut assigned with `VK_NUMPAD0`?

In a Delphi 10.4.2 Win32 VCL Application, on Windows10 X64 (German language) I set the shortcuts for some menu items programmatically:
mRasterizedDoubleSize.Shortcut := VK_ADD;
mRasterizedHalveSize.Shortcut := VK_SUBTRACT;
mRasterizedResetToOriginalSVGSize.Shortcut := VK_NUMPAD0;
This results in the following menu at run-time:
("ZEHNERTASTATUR" is German for NUMERIC KEYPAD)
Why "Zehnertastatur" (numeric keypad) is not shown for the third menu item?
How can I show "ZEHNERTASTATUR" (NUMERIC KEYPAD) for the menu item shortcut assigned with VK_NUMPAD0?
I have filed a Quality Report for this bug in Vcl.Menus: https://quality.embarcadero.com/browse/RSP-33296
Please vote for it!
EDIT: I have tried Andreas' advice, but it does work only programmatically at run-time, not at design-time in the Object Inspector:
mRasterizedResetToOriginalSVGSize.Caption := mRasterizedResetToOriginalSVGSize.Caption + #9 + '0 (NUMPAD) ';
Isn't there a function that translates the word "NUMPAD" into the current system language at-run-time?
EDIT2: I have tried this to get the word for the VK_NUMPAD0 shortcut, but it only gives back the same "0" without the "NUMPAD" suffix:
var s: TShortCut;
s := ShortCut(VK_NUMPAD0, []);
CodeSite.Send('TformMain.FormCreate: ShortCutToText(s)', ShortCutToText(s));
EDIT3: I now have debugged Vcl.Menus: The bug seems to be in Vcl.Menus.ShortCutToText: While VK_ADD ($6B) is correctly translated by GetSpecialName(ShortCut), VK_NUMPAD0 ($60) is NOT being translated by GetSpecialName(ShortCut)!
EDIT4: I have found the solution:
function MyGetSpecialName(ShortCut: TShortCut): string;
var
ScanCode: Integer;
KeyName: array[0..255] of Char;
begin
Result := '';
ScanCode := Winapi.Windows.MapVirtualKey(LoByte(Word(ShortCut)), 0) shl 16;
if ScanCode <> 0 then
begin
if Winapi.Windows.GetKeyNameText(ScanCode, KeyName, Length(KeyName)) <> 0 then
Result := KeyName;
end;
end;
var s: System.Classes.TShortCut;
s := ShortCut(VK_NUMPAD0, []);
CodeSite.Send('ShortCutToText', MyGetSpecialName(s));
One approach is like this:
Use a TActionList. This is good practice in general. Define your actions within this list, and then simply map them to menu items, buttons, check boxes, etc. The action list facility is one of the very best parts of the VCL IMHO.
Now, create an action named aResetZoom with Caption = 'Reset zoom'#9'Numpad 0' and NO ShortCut. Put this on the menu bar.
Then, create a new action named aResetZoomShortcut with the same OnExecute (and possibly the same OnUpdate) and shortcut Num 0 (set at design time or programmatically at run time). Don't put this on the main menu.
The result:
and the action is triggered when I press numpad 0 (but not the alpha 0).
There are many variants to this approach. Maybe you can make it work with a single action with no ShortCut but with Num 0 in its SecondaryShortCuts list. Or you can use the form's KeyPreview and OnKeyPress properties instead of the "dummy" action.
Many options. Choose the one that is best suited for your particular scenario.
Bonus remarks
Please note it is perfectly possibly to set captions with tabs at design time using the Object Inspector. See example video.
You can probably do localisation using the Win32 GetKeyNameText function. The following code is adapted from the VCL:
var
name: array[0..128] of Char;
begin
FillChar(name, SizeOf(name), 0);
GetKeyNameText(MapVirtualKey(VK_NUMPAD0, 0) shl 16, #name[0], Length(name));
// string(name) now is 'NUM 0' on my system
That being said, personally I don't mind if shortcut descriptions are non-localized or manually localised -- like the rest of the application.
Update
A clarification on how to use the localisation code:
procedure TForm5.FormCreate(Sender: TObject);
var
name: array[0..128] of Char;
NameAsANormalString: string;
begin
FillChar(name, SizeOf(name), 0);
GetKeyNameText(MapVirtualKey(VK_NUMPAD0, 0) shl 16, #name[0], Length(name));
NameAsANormalString := name;
ShowMessage(name);
end;
produces
on my system.

Dynamically create submenu

I have a TMainMenu with a menu item called mnuWindows. I wish to create submenu items dynamically. I thought this code might do it but it doesn't work:
var
mnuitm: TMenuItem;
mnuitm:=TMenuItem.Create(nil);
mnuitm.Text:='some text';
mnuWindows.AddObject(mnuitm);
When I click on mnuWIndows, nothing happens. Where am i going wrong?
EDIT:
The submenu was not displaying on clicking because each time I did so, the program had been freshly started and I didn't realize that under these circumstances, two clicks are necessary. The first click doesn't visibly do anything and the second click drops down the submenu. So, I concede the code snippet above works.
But I still have a difficulty. I need to create several submenu items so I tried the following loop inside the mnuWindows OnClick event handler:
for I := 0 to TabSet1.Tabs.Count - 1 do
begin
mnuitm := TMenuItem.Create(mnuWindows);
mnuitm.Text := TabSet1.Tabs[I].Text;
mnuitm.OnClick:=MenuItemClick;
if not mnuWindows.ContainsObject(mnuitm) then
mnuWindows.AddObject(mnuitm);
end;
The intent of the above code is that clicking the mnuWindows item displays a list of the tabs in a tabset. This code works up to a point. On first being clicked, it correctly lists the current tabs. But when I add a tab and click on mnuWindows again, the new tab is not shown in the list. The list is exactly as before. I wondered if the menu needed updating or refreshing somehow. I came across the following method
IFMXMenuService.UpdateMenuItem(IItemsContainer, TMenuItemChanges)
but it is poorly documented and I'm not sure how to use it or even whether it is relevant.
EDIT2:
I thought the two down votes on my post were harsh. I have searched the web extensively for an example of how to dynamically create submenus in Firemonkey and there is very little. I did find a solution from 2012, but syntax changes since then mean that it does not work in Tokyo 10.2.
Try something like this. As others have commented above, you need to provide an event that will happen when the menu item is clicked. Note also that my methods here require a bunch of parameters. It would have been cleaner if I had created a class and passed the details that way, but I wrote this a long time ago and now have many places in my code that use it in this form. Also, if I wrote this now, I would use a function to return the menu item created in case I needed to interact with it in particular cases (e.g., check it, assign a hot key, etc.)
procedure PopMenuAddItem(menu: TPopupMenu; sText: string; iID: integer;
clickEvent: TNotifyEvent; bEnabled: boolean = true);
var
NewMenuItem: TmenuItem;
begin
NewMenuItem := TmenuItem.create(menu);
with NewMenuItem do
begin
Caption := sText;
tag := iID;
Enabled := bEnabled;
OnClick := clickEvent;
end;
menu.Items.Add(NewMenuItem);
end;
procedure PopMenuAddSubItem(menuItem: TmenuItem; sText: string; iID: integer;
clickEvent: TNotifyEvent; bEnabled: boolean = true);
var
NewMenuItem: TmenuItem;
begin
NewMenuItem := TmenuItem.create(menuItem);
with NewMenuItem do begin
Caption := sText;
tag := iID;
Enabled := bEnabled;
OnClick := clickEvent;
end;
menuItem.Add(NewMenuItem);
end;
I have answered my own question.
As a reminder, what I wanted to do was to dynamically create a submenu under my top level menu item "Windows" (component name "mnuWindows"). In the submenu, I wished to list the names of the tabs in a tabset.
Attempting to create the submenu dynamically in the mnuWindows.OnClick event was a failure.
My eventual solution was to rebuild the submenu with the following method and to call this method immediately after creating a new tab, removing a tab, or renaming a tab:
procedure Form1.ReBuildWindowsMenu;
var
mnuitm: TMenuItem;
I: Integer;
begin
mnuWindows.Clear; // removes submenu items
for I := 0 to TabSet1.Tabs.Count - 1 do
begin
mnuitm := TMenuItem.Create(MainMenu1);
mnuitm.Caption:= TabSet1.Tabs[I].Text; // submenu item displays same text as associated tab
mnuitm.OnClick := MenuItemClick; // makes the associated tab active
mnuWindows.AddObject(mnuitm);
end;
end;
The OnClick handler contains the single statement
TabSet1.ActiveTabIndex:=(Sender as TMenuItem).Index;
This simple solution keeps my Windows list perfectly synched with the tabs in the tabset. I'm planning to use a similar approach to put a most recently used (MRU) file list into my File menu.

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

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.

How to add menu items separators which work as expected on OSX?

On Windows platform, with the VCL, when we want to add a separator in a menu, we add a TMenuItem with a Caption := '-';
With FireMonkey, we add a TMenuItem with a Text := '-';
It works as expected on Windows platform, the item with the Text='-' is displayed as a separator.
But, when I run the same application on OSX, I have the minus sign visible...
I haven't found any property on the TMenuItem to specify it is a separator...
I have tried with a TMainMenu and a TMenuBar (UseOSMenu := True|False;) and I still have this issue.
Any idea to create a real separator? (otherwise, I will check the OS and remove it if OSX...)
This is a bug in FireMonkey. I am sure they will solve it. But meanwhile you can use the below code. Call the procedure FixSeparatorItemsForMac in the OnActivate event of your main form.
Dont forget mac specific files in the uses list.
uses
...
{$IFDEF MACOS}
,Macapi.ObjectiveC,MacApi.AppKit,MacApi.Foundation,FMX.Platform.Mac
{$ENDIF}
{$IFDEF MACOS}
Procedure FixSeparatorItemsForMenuItem(MenuItem:NSMenuItem);
var i:Integer;
subItem:NSMenuItem;
begin
if (MenuItem.hasSubmenu = false) then exit;
for i := 0 to MenuItem.submenu.itemArray.count -1 do
begin
subItem := MenuItem.submenu.itemAtIndex(i);
if (subItem.title.isEqualToString(NSSTR('-'))= true) then
begin
MenuItem.submenu.removeItemAtIndex(i);
MenuItem.submenu.insertItem(TNSMenuItem.Wrap(TNSMenuItem.OCClass.separatorItem),i);
end else begin
FixSeparatorItemsForMenuItem(subItem);
end;
end;
end;
Procedure FixSeparatorItemsForMac;
var NSApp:NSApplication;
MainMenu:NSMenu;
AppItem: NSMenuItem;
i: Integer;
begin
NSApp := TNSApplication.Wrap(TNSApplication.OCClass.sharedApplication);
MainMenu := NSApp.mainMenu;
if (MainMenu <> nil) then
begin
for i := 0 to MainMenu.itemArray.count -1 do
begin
AppItem := mainMenu.itemAtIndex(i);
FixSeparatorItemsForMenuItem(AppItem);
end;
end;
end;
{$ENDIF}
I never programmed for the Mac, and I don't eveb have a Mac but out of curiosity I found some Apple Documentation about it.
The Menu Separator item is a disabled blank menu item, maybe you can fake with that:
separatorItem
Returns a menu item that is used to separate logical groups of menu
commands.
+ (NSMenuItem *)separatorItem Return Value
A menu item that is used to separate logical groups of menu commands.
Discussion
This menu item is disabled. The default separator item is blank space.
(From: http://developer.apple.com/library/mac/#documentation/Cocoa/Reference/ApplicationKit/Classes/NSMenuItem_Class/Reference/Reference.html#//apple_ref/doc/c_ref/NSMenuItem)
I don't have the facilities to test this, but it's worth a try.
By default, FireMonkey creates it's own fully styled menus, but set the TMenuBar.UseOSMenu property to true and it uses OS calls to create the menus.
You can then combine this with the advice for creating Cocoa menus already discussed.
From http://docwiki.embarcadero.com/RADStudio/en/FireMonkey_Application_Design#Menus :
"Setting the TMenuBar.UseOSMenu property to True causes FireMonkey to create the menu tree with OS calls, resulting in a native menu. On Windows, this menu is at the top of the parent form, and displayed using the current Appearance theme. On Mac OS X, the menu is displayed in the global menu bar on top of the main screen whenever the application has focus."

Create an exact copy of TPanel on Delphi5

I have a TPanel pnlMain, where several dynamic TPanels are created (and pnlMain is their Parent) according to user actions, data validations, etc. Every panel contains one colored grid full of strings. Apart from panels, there are some open source arrows components and a picture. Whole bunch of stuff.
Now I want user to be able to print this panel (I asked how to do it on this question), but before printing, user must be presented with a new form, containing copy of pnlMain. On this form user has to do some changes, add few components and then print his customized copy of pnlMain. After printing user will close this form and return to original form with original pnlMain. And – as you can guess – original pnlMain must remain intact.
So is there any clever way to copy whole TPanel and it’s contents? I know I can make it manually iterating through pnlMain.Controls list.
Code based as iterating on child controls, but not bad in anyway ;-)
procedure TForm1.btn1Click(Sender: TObject);
function CloneComponent(AAncestor: TComponent): TComponent;
var
XMemoryStream: TMemoryStream;
XTempName: string;
begin
Result:=nil;
if not Assigned(AAncestor) then
exit;
XMemoryStream:=TMemoryStream.Create;
try
XTempName:=AAncestor.Name;
AAncestor.Name:='clone_' + XTempName;
XMemoryStream.WriteComponent(AAncestor);
AAncestor.Name:=XTempName;
XMemoryStream.Position:=0;
Result:=TComponentClass(AAncestor.ClassType).Create(AAncestor.Owner);
if AAncestor is TControl then TControl(Result).Parent:=TControl(AAncestor).Parent;
XMemoryStream.ReadComponent(Result);
finally
XMemoryStream.Free;
end;
end;
var
aPanel: TPanel;
Ctrl, Ctrl_: TComponent;
i: integer;
begin
//handle the Control (here Panel1) itself first
TComponent(aPanel) := CloneComponent(pnl1);
with aPanel do
begin
Left := 400;
Top := 80;
end;
//now handle the childcontrols
for i:= 0 to pnl1.ControlCount-1 do begin
Ctrl := TComponent(pnl1.Controls[i]);
Ctrl_ := CloneComponent(Ctrl);
TControl(Ctrl_).Parent := aPanel;
TControl(Ctrl_).Left := TControl(Ctrl).Left;
TControl(Ctrl_).top := TControl(Ctrl).top;
end;
end;
code from Delphi3000 article
Too much code... ObjectBinaryToText and ObjectTextToBinary do the job nicely using streaming.
Delphi 7 have a code example, don't know 2009 (or 2006, never bothered to look) still have it.
See D5 help file for those functions (don't have d5 available here).
I'd do it by using RTTI to copy all the properties. You'd still have to iterate over all the controls, but when you need to set up the property values, RTTI can help automate the process. You can get an example towards the bottom of this article, where you'll find a link to some helper code, including a CopyObject routine.

Resources