I have moved my application from MDI to PageControl Embedded. When I work with MDI, there was no problem. Everything works fine. I had a TActionList with Shortcuts in the form, the TActionList execute event was fired. Since I've switched to an embedded form under a PageControl tab, the TMainMenu shortcuts are triggered instead of TAction. If I set the TMenuItems enabled to false, the TActionList ones works ok.
I've tried setting the TMenuItems enabled to false, I have also changed the owner of the form to the main form. What I'm looking for is that the shortcut TActionList is executed and the TMenuITem is not triggered when the TActionList shortcut exists, and if there is no TActionList, the TMenuITem shortcut is triggered.
Example for Principal Form:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, System.Rtti, System.TypInfo,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ComCtrls, Vcl.StdCtrls,
Vcl.ExtCtrls;
type
TFormBaseClass = class of TForm;
TForm1 = class(TForm)
PageControl1: TPageControl;
MainMenu1: TMainMenu;
mnuFile: TMenuItem;
mnuOptionA: TMenuItem;
mnuOptionB: TMenuItem;
mnuOptionC: TMenuItem;
Panel1: TPanel;
Button1: TButton;
procedure mnuOptionAClick(Sender: TObject);
procedure mnuOptionBClick(Sender: TObject);
procedure mnuOptionCClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
tsNew : TTabSheet;
frmForm2:TForm2;
begin
tsNew := TTabSheet.Create(Form1);
tsNew.PageControl := Form1.PageControl1;
frmForm2 := TForm2.Create(Form1);
tsNew.caption := 'New Window';
frmForm2.Hide;
with frmForm2 do
begin
Parent := tsNew;
Top := 10;
Left := 10;
end;
frmForm2.Show;
frmForm2.Align := alClient;
end;
procedure TForm1.mnuOptionAClick(Sender: TObject);
begin
ShowMessage('Click from TMenu Control + A');
end;
procedure TForm1.mnuOptionBClick(Sender: TObject);
begin
ShowMessage('Click from TMenu Control + B');
end;
procedure TForm1.mnuOptionCClick(Sender: TObject);
begin
ShowMessage('Click from TMenu Control + C');
end;
end.
Example for Child Form:
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Vcl.ToolWin, Vcl.ActnMan,
Vcl.ActnCtrls, Vcl.ActnMenus, System.Actions, Vcl.ActnList, StdStyleActnCtrls,
Vcl.StdCtrls;
type
TForm2 = class(TForm)
ActionList1: TActionList;
Action1: TAction;
Action2: TAction;
Action3: TAction;
Label1: TLabel;
procedure Action1Execute(Sender: TObject);
procedure Action2Execute(Sender: TObject);
procedure Action3Execute(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.Action1Execute(Sender: TObject);
begin
ShowMessage('Control + B from ActionList');
end;
procedure TForm2.Action2Execute(Sender: TObject);
begin
ShowMessage('Control + A from ActionList');
end;
procedure TForm2.Action3Execute(Sender: TObject);
begin
ShowMessage('Control + C from ActionList');
end;
end.
An MDI client form is a top level window and this directly gets the shortcut, handing it over to the ActionList. When the form is parented to the PageControl the shortcut is handled by the main form which preferences its own menu before asking any ActionList.
You might overcome that by overriding the main forms IsShortCut
method and write some code that first checks the action lists before falling back to the menu. For the code look up the original IsShortCut
implementation and tweak it to your needs.
This is a simple example which first tries to look for an ActionList before calling the inherited method:
...
function IsShortCut(var Message: TWMKey): Boolean; override;
...
function TForm1.IsShortCut(var Message: TWMKey): Boolean;
function DispatchShortCut(const Owner: TComponent) : Boolean;
var
I: Integer;
Component: TComponent;
ts:TTabSheet;
begin
Result := False;
{ Dispatch to all children }
for I := 0 to Owner.ComponentCount - 1 do
begin
Component := Owner.Components[I];
ts := (TCustomActionList(Component).Owner.GetParentComponent as TTabSheet);
if (ts.TabIndex = Self.PageControl1.ActivePageIndex) then
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;
begin
Result := DispatchShortCut(Self);
if not Result then
Result := inherited;
end;