Search code examples
delphirtti

Conflict between TMenuItem and TActionList shortcuts


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.

Solution

  • 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;