Conflict between TMenuItem and TActionList shortcuts

93 Views Asked by At

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.
1

There are 1 best solutions below

5
Uwe Raabe On BEST ANSWER

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;