How do I create ActionBars recursively at runtime?

StackOverflow https://stackoverflow.com/questions/19059204

Question

I am writing a class which will map a large legacy application's TMainMenu hierarchy to TActionMainMenuBar items.

The most important method, which borrows heavily from a EDN CodeCentralC article by Steve Trevethen, looks like this. I apologize for the length, but this really is probably the shortest length of code I could meaningfully show in this case:

procedure TMainMenuSkin.DoLoadMenu(
    ActionList: TCustomActionList;
    Clients: TActionClients;
    AMenu: TMenuItem;
    SetActionList: Boolean = True;
    bRecurseFlag:Boolean = False);
var
  I: Integer;
  J: Integer;
  AC: TActionClientItem;
  ca : TCustomAction;
  newAction : TSkinnedMenuAction;
  aci:TActionClientItem;
  submenuitem : TMEnuItem;

  procedure PopulateNodeFromMenuItem(menuitem:TMenuItem);
  begin
        newAction := TSkinnedMenuAction.Create(Application.MainForm);
        menuitem.FreeNotification(newAction);
        newAction.FMenuItem := menuitem;
        newAction.Name := 'action_'+newAction.FMenuItem.Name;
        FNewMenuActions.Add(newAction);
        newAction.ActionList := ActionManager;
        newAction.Tag := menuitem.Tag;
        ca := newAction;
        ca.ImageIndex  := menuitem.ImageIndex;
        ca.HelpContext := menuitem.HelpContext;
        ca.Visible     := menuitem.Visible;
        ca.Checked     := menuitem.Checked;
        ca.Caption     := menuitem.Caption;
        ca.ShortCut    := menuitem.ShortCut;
        ca.Enabled     := menuitem.Enabled;
        ca.AutoCheck   := menuitem.AutoCheck;
        ca.Checked     := menuitem.Checked;
        ca.GroupIndex  := menuitem.GroupIndex;
        AC.ImageIndex  := menuitem.ImageIndex;
        AC.ShortCut := menuitem.ShortCut;
        AC.Action := newAction;
  end;
begin
  if not Assigned(AMenu) then
      exit;
  AMenu.RethinkHotkeys;
  AMenu.RethinkLines;
  Clients.AutoHotKeys := False;
  for I := 0 to AMenu.Count - 1 do
  begin
    AC := Clients.Add;
    AC.Caption := AMenu.Items[I].Caption;
    // Assign the Tag property to the TMenuItem for reference
    AC.Tag := Integer(AMenu.Items[I]);
    AC.Action := TContainedAction(AMenu.Items[I].Action);
    AC.Visible := AMenu.Items[I].Visible;
    // original sample code only created placeholders for submenus. I want to populate 
    // fully because I need the actions and their keyboard shortcuts to exist.
    submenuitem := AMenu.Items[I];
    if submenuitem.Count > 0 then
    begin
      if not bRecurseFlag then
          AC.Items.Add  // old busted way to work
      else
      begin
          // How do I recursively populate the Action Clients menu?
         DoLoadMenu(ActionList,  AC.ActionClients, submenuitem, true);
      end;
    end
    else
      if ((AMenu.Items[I].Caption <> '') and (AMenu.Items[I].Action = nil) and
          (AMenu.Items[I].Caption <> '-')) then
      begin
          PopulateNodeFromMenuItem( AMenu.Items[I] );
      end;
    AC.Caption := AMenu.Items[I].Caption;
    AC.ImageIndex := AMenu.Items[I].ImageIndex;
    AC.HelpContext := AMenu.Items[I].HelpContext;
    AC.ShortCut := AMenu.Items[I].ShortCut;
    AC.Visible := AMenu.Items[I].Visible;
  end;
end;

The most important line above is this one, and it's also the one that is wrong:

DoLoadMenu(ActionList,  AC.ActionClients, submenuitem, true);

If the code is written like that, then I get all the menu items displayed in a flattened form. So I need something like AC.GetMeSubItems.ActionClients in the line above, but I can't figure out what it is. AC is of type TActionClientItem and is a toolbar button itself also created at runtime.

What I can't figure out for the life of me is, if I need to populate the Actions list and the menu items all at once, recursively, how do I do it? Perhaps my thinking is constrained by the sample code I started out with here. It seems like I'm one line of code away from knowing how to do this.

I have a feeling that I'm just not understanding very well the complex hiearchical relationships of the various classes I'm messing with here.

Update: The following SEEMS to work, but I don't trust myself.

  aci := AC.Items.Add;
  DoLoadMenu(ActionList,  aci.Items, submenuitem, true);

enter image description here

Was it helpful?

Solution

Here's some code that I once wrote or found somewhere and which seems to do what you want to achieve: it is a converter class which copies the items of a Mainmenu to an ActionMainMenubar. It has some issues, but hopefully you can catch the point how it works.

The component assumes that you have a completed MainMenu on a form. You also need a TActionManager and an empty TActionMainMenubar. You create an instance of the TActionbarConverter in the OnCreate event of the MainForm, and assign its properties correspondingly, something like this:

procedure TForm1.FormCreate(Sender: TObject);
begin
  with TActionbarConverter.Create(self) do begin
    Form := self;
    ActionManager := Actionmanager1;
    ActionMainMenubar := ActionMainmenubar1;
  end;
end;

You can change properties of the ActionManager, or use your own ColorMap to modify the appearance.

I hope that I don't get banned here by posting almost 400 lines of code here (don't know how to upload files...).

unit ActnbarCnv;

interface

uses
  Classes, Menus, Forms, ComCtrls, ActnList, ActnMan, ActnMenus,
  StdStyleActnCtrls, XPStyleActnCtrls;

type
  TActionbarConverter = class(TComponent)
  private
    FForm : TCustomForm;
    FMainMenu : TMainMenu;
    FMainMenuToolbar : TToolbar;
    FActionManager : TActionManager;
    FActionMainMenubar : TActionMainMenubar;
    FNewMenuActions : TList;
    procedure ActionMainMenuBar_ExitMenuLoop(Sender:TCustomActionMenuBar;
      Cancelled: Boolean);
    procedure ActionMainMenubar_Popup(Sender:TObject; Item:TCustomActionControl);
    procedure SetActionMainMenubar(Value:TActionMainMenubar);
    procedure SetActionManager(Value:TActionManager);
    procedure SetForm(Value:TCustomForm);
  protected
    procedure AnalyzeForm;
    procedure Loaded; override;
    procedure LoadMenu(ActionList: TCustomActionList; Clients: TActionClients;
      AMenu: TMenuItem; SetActionList: Boolean = True);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ProcessMenu;
    procedure UpdateActionMainMenuBar(Menu: TMenu);
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Update;
  published
    property Form : TCustomForm read FForm write SetForm;
    property ActionManager : TActionManager read FActionManager write SetActionManager;
    property ActionMainMenubar : TActionMainMenubar read FActionMainMenubar write SetActionMainMenubar;
  end;

//==============================================================================
                                implementation
//==============================================================================

uses
  SysUtils;

//==============================================================================

{ TABMenuAction -
  This class is a special ActionBand menu action that stores the TMenuItem
  that it is associated with so that if it is executed it can actually call the
  TMenuItem.Click method simulating an actual click on the TMenuItem itself. }
type
  TABMenuAction = class(TCustomAction)
  private
    FMenuItem: TMenuItem;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    destructor Destroy; override;
    procedure ExecuteTarget(Target: TObject); override;
    function HandlesTarget(Target: TObject): Boolean; override;
  end;

//------------------------------------------------------------------------------

destructor TABMenuAction.Destroy;
begin
  if Assigned(FMenuItem) then FMenuItem.RemoveFreeNotification(Self);
  inherited;
end;

//------------------------------------------------------------------------------

procedure TABMenuAction.ExecuteTarget(Target: TObject);
begin
  if Assigned(FMenuItem) then FMenuItem.Click;
end;

//------------------------------------------------------------------------------

function TABMenuAction.HandlesTarget(Target: TObject): Boolean;
begin
  Result := True;
end;

//------------------------------------------------------------------------------

procedure TABMenuAction.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation = opRemove) and (AComponent = FMenuItem)
    then FMenuItem := nil;
end;



//------------------------------------------------------------------------------
//   TActionbarConverter
//------------------------------------------------------------------------------

constructor TActionbarConverter.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FNewMenuActions := TList.Create;
  if (AOwner is TCustomForm) then SetForm(TCustomForm(AOwner));
end;

//------------------------------------------------------------------------------

destructor TActionbarConverter.Destroy;
begin
  FNewMenuActions.Free;
  inherited Destroy;
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.ActionMainMenuBar_ExitMenuLoop(Sender:TCustomActionMenuBar;
  Cancelled: Boolean);
var
  I: Integer;
  AnAction: TObject;
begin
  // Clear the top level menu sub item and add a single dummy item which
  // will cause them to be regenerated on the next menu loop.  This is done
  // because the IDE's menus can be very dynamic and this ensures that the
  // menus will always be up-to-date.
  for I := 0 to FActionManager.ActionBars[0].Items.Count - 1 do begin
    FActionManager.ActionBars[0].Items[I].Items.Clear;
    FActionManager.ActionBars[0].Items[I].Items.Add;
  end;
  // Any menuitems not linked to an action had one dynamically created for them
  // during the menu loop so now we need to destroy them
  while FNewMenuActions.Count > 0 do begin
    AnAction := TObject(FNewMenuActions.Items[0]);
    AnAction.Free;
    FNewMenuActions.Delete(0);
  end;
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.ActionMainMenubar_Popup(Sender:TObject;
  Item: TCustomActionControl);
begin
  // If the tag is not zero then we've already populated this submenu...
  if Item.ActionClient.Items[0].Tag <> 0 then exit;
  // ...otherwise this is the first visit to this submenu and we need to
  // populate the actual ActionClients collection.
  if Assigned(TMenuItem(Item.ActionClient.Tag).OnClick) then
    TMenuItem(Item.ActionClient.Tag).OnClick(TMenuItem(Item.ActionClient.Tag));
  Item.ActionClient.Items.Clear;
  TMenuItem(Item.ActionClient.Tag).RethinkHotkeys;
  LoadMenu(FActionManager, Item.ActionClient.Items, TMenuItem(Item.ActionClient.Tag), False);
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.AnalyzeForm;
var
  i : integer;
begin
  FMainMenu := nil;
  FMainMenuToolbar := nil;
  if Assigned(FForm) then begin
    for i:=0 to FForm.ComponentCount-1 do
      if (FForm.Components[i] is TMainMenu) then begin
        FMainMenu := FForm.Components[i] as TMainMenu;
        break;
      end;
    for i:=0 to FForm.ComponentCount-1 do
      if (FForm.Components[i] is TToolbar) then begin
        FMainMenuToolbar := FForm.Components[i] as TToolbar;
        if FMainMenuToolbar.Menu = FMainMenu
          then break
          else FMainMenuToolbar := nil;
      end;
  end;
  ProcessMenu;
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.Loaded;
begin
  AnalyzeForm;
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.LoadMenu(ActionList: TCustomActionList;
  Clients: TActionClients; AMenu: TMenuItem; SetActionList: Boolean = True);
{ This method dynamically builds the ActionBand menu from an existing
  TMenuItem. }
var
  I: Integer;
  AC: TActionClientItem;
begin
  AMenu.RethinkHotkeys;
  AMenu.RethinkLines;
  // Use the existing hotkeys from the TMenuItem
  Clients.AutoHotKeys := False;
  for I := 0 to AMenu.Count - 1 do begin
    AC := Clients.Add;
    AC.Caption := AMenu.Items[I].Caption;
    // Assign the Tag property to the TMenuItem for reference
    AC.Tag := Integer(AMenu.Items[I]);
    AC.Action := TContainedAction(AMenu.Items[I].Action);
    AC.Visible := AMenu.Items[I].Visible;
    // If the TMenuItem has subitems add an ActionClient placeholder.
    // Submenus are only populated when the user selects the parent item of the
    // submenu.
    if AMenu.Items[I].Count > 0 then
      AC.Items.Add  // Add a dummy indicating this item can/should be dynamically built
    else
      if (AMenu.Items[I].Caption <> '')
        and (AMenu.Items[I].Action = nil)
        and (AMenu.Items[I].Caption <> '-')
      then begin
        // The TMenuItem is not connected to an action so dynamically create
        // an action.
        AC.Action := TABMenuAction.Create(self); //Application.MainForm);
        AMenu.Items[I].FreeNotification(AC.Action);
        TABMenuAction(AC.Action).FMenuItem := AMenu.Items[I];
        FNewMenuActions.Add(AC.Action);
        AC.Action.ActionList := FActionManager;
        AC.Action.Tag := AMenu.Items[I].Tag;
        TCustomAction(AC.Action).ImageIndex := AMenu.Items[I].ImageIndex;
        TCustomAction(AC.Action).HelpContext := AMenu.Items[I].HelpContext;
        TCustomAction(AC.Action).Visible := AMenu.Items[I].Visible;
        TCustomAction(AC.Action).Checked := AMenu.Items[I].Checked;
        TCustomAction(AC.Action).Caption := AMenu.Items[I].Caption;
        TCustomAction(AC.Action).ShortCut := AMenu.Items[I].ShortCut;
        TCustomAction(AC.Action).Enabled := AMenu.Items[I].Enabled;
        TCustomAction(AC.Action).AutoCheck := AMenu.Items[I].AutoCheck;
        TCustomAction(AC.Action).Checked := AMenu.Items[I].Checked;
        TCustomAction(AC.Action).GroupIndex := AMenu.Items[I].GroupIndex;
        AC.ImageIndex := AMenu.Items[I].ImageIndex;
        AC.ShortCut := AMenu.Items[I].ShortCut;
      end;
    AC.Caption := AMenu.Items[I].Caption;
    AC.ImageIndex := AMenu.Items[I].ImageIndex;
    AC.HelpContext := AMenu.Items[I].HelpContext;
    AC.ShortCut := AMenu.Items[I].ShortCut;
    AC.Visible := AMenu.Items[I].Visible;
  end;
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) then
    if (AComponent=FForm) then SetForm(nil);
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.ProcessMenu;
begin
  if FMainMenu <> nil then begin
    if FMainMenutoolbar <> nil then begin
      FMainMenutoolbar.Menu := nil;
      FMainMenutoolbar.Visible := false;
    end;
    FForm.Menu := nil;

    if FActionManager=nil then begin
      FActionManager := TActionManager.Create(self);
//      FActionManager.Style := XPStyle;
    end else
      FActionManager.Actionbars.Clear;

    FActionManager.Images := FMainMenu.Images;
    FActionManager.Actionbars.Add;

    if FActionMainMenubar=nil then begin
      FActionMainMenubar := TActionMainMenubar.Create(self);
      if (FMainMenuToolbar <> nil)
        then FActionMainMenubar.Parent := FMainMenuToolbar.Parent
        else FActionMainMenubar.Parent := FForm;
    end;
    FActionMainMenubar.ActionManager := FActionManager;
    FActionMainMenubar.OnPopup := ActionMainMenubar_Popup;
    FActionMainMenubar.OnExitMenuLoop := ActionMainMenubar_ExitMenuLoop;

    UpdateActionMainMenubar(FMainMenu);
  end;
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.SetActionMainmenubar(Value:TActionMainMenubar);
begin
  if Value=nil then begin
    FActionMainMenubar := TActionMainMenubar.Create(self);
    if FMainmenuToolbar <> nil
      then FActionMainMenubar.Parent := FMainMenuToolbar.Parent
      else FActionMainMenubar.Parent := FForm;
  end else begin
    FActionMainMenubar.Free;
    FActionMainMenubar := value;
  end;
  Update;
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.SetActionManager(value:TActionManager);
begin
  if Value = nil then begin
    FActionManager := TActionManager.Create(self);
    FActionManager.Style := XPStyle;
  end else begin
    FActionManager := value;
//    if FMainMenu <> nil then FActionManager.Images := FMainMenu.Images;
  end;
  Update;
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.SetForm(value:TCustomForm);
begin
  if FForm <> Value then begin
    FForm := Value;
    AnalyzeForm;
  end;
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.Update;
begin
  AnalyzeForm;
end;

//------------------------------------------------------------------------------

procedure TActionbarConverter.UpdateActionMainMenuBar(Menu: TMenu);
{ This routine should probably also check for Enabled state although it would
  be very wierd to have a top level menu disabled. }

  function RefreshItems: Boolean;
  var
    I: Integer;
  begin
    Result := FMainMenu.Items.Count <> FActionManager.ActionBars[0].Items.Count;
    if not Result then
      for I := 0 to FMainMenu.Items.Count - 1 do
        if AnsiCompareText(
          FMainMenu.Items[I].Caption,
          FActionManager.ActionBars[0].Items[I].Caption ) <> 0
        then  begin
          Result := True;
          break;
        end;
  end;

begin
  if not (csLoading in FActionManager.ComponentState) and RefreshItems
  then begin
    // Clear any existing items and repopulate the TActionMainMenuBar
    FActionManager.ActionBars[0].Items.Clear;
    FActionManager.ActionBars[0].ActionBar := nil;
    LoadMenu(FActionManager, FActionManager.ActionBars[0].Items, FMainMenu.Items);
    FActionManager.ActionBars[0].ActionBar := FActionMainMenuBar;
    // Update the size of the main menu
    with FActionMainMenuBar do
      SetBounds(
        0,
        0,
        Controls[ControlCount-1].BoundsRect.Right + 2 + FActionMainMenuBar.HorzMargin,
        Height
      );
  end;
end;

end.
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top