Overly tall "View" dropdown menu in XE2

Question

Historically Delphi's View dropdown has substantial number of items. With Delphi XE2 plus several necessary add-ins this number became marginally large and barely fitting my screen height. Normal TMainMenu backed by Windows can accommodate this case and provide either scrolling or wrapping capability. Unfortunately, it looks like RAD Studio's main menu is TActionMainMenuBar which cannot deal with that.

What can i do with that? Please advise. If I add just one more add-in which creates View menu item, it will start repositioning dropdown menu and producing rogue click upon mouse release. With two or three items more there will be an invisible item :-(

Write an add-in that moves some items off into sub menus – David Heffernan Sep 15 '12 at 08:58 — David Heffernan, Sep 15 '12 at 08:58

Ondrej Kelle · Accepted Answer · 2012-09-15T14:41:59.390

You could try the following (add this unit to a design package and install it in the IDE). It finds the IDE main form's ActionManager and sets its style to a custom style which defines a new class for popup menus. This popup menu class wraps its menu items if they normally wouldn't fit on screen:

Wrapping menu

unit TestUnit1;

interface

procedure InitializeStyle;

implementation

uses
  System.Types, System.Classes, System.SysUtils,
  Winapi.Messages, Winapi.Windows,
  Vcl.GraphUtil, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ActnMan, Vcl.ActnMenus, Vcl.StdActnMenus, Vcl.ActnCtrls,
  Vcl.PlatformDefaultStyleActnCtrls;

type
  THackCustomActionMenuBar = class(TCustomActionMenuBar);

  TStandardMenuPopupEx = class(TStandardMenuPopup)
  protected
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    procedure CustomAlignPosition(Control: TControl; var NewLeft, NewTop, NewWidth, NewHeight: Integer;
      var AlignRect: TRect; AlignInfo: TAlignInfo); override;
    procedure PositionPopup(AnOwner: TCustomActionBar; ParentItem: TCustomActionControl); override;
    procedure WMKeyDown(var Message: TWMKey); override;
  public
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  end;

  TPlatformDefaultStyleActionBarsEx = class(TPlatformDefaultStyleActionBars)
  public
    function GetPopupClass(ActionBar: TCustomActionBar): TCustomPopupClass; override;
    function GetStyleName: string; override;
  end;

{ TStandardMenuPopupEx }

var
  NextLeft, NextTop: Integer;

procedure TStandardMenuPopupEx.AlignControls(AControl: TControl; var Rect: TRect);
begin
  NextLeft := 0;
  NextTop := 0;
  inherited AlignControls(AControl, Rect);
end;

procedure TStandardMenuPopupEx.CustomAlignPosition(Control: TControl; var NewLeft, NewTop, NewWidth, NewHeight: Integer;
  var AlignRect: TRect; AlignInfo: TAlignInfo);
var
  ScreenPos: TPoint;
begin
  inherited CustomAlignPosition(Control, NewLeft, NewTop, NewWidth, NewHeight, AlignRect, AlignInfo);
  NewLeft := NextLeft;
  NewTop := NextTop;
  NextTop := NewTop + NewHeight;

  ScreenPos := ClientToScreen(Point(NewLeft, NewTop));
  if ScreenPos.Y + NewHeight > Screen.MonitorFromPoint(ScreenPos).Height then
  begin
    NextTop := 0;
    Inc(NextLeft, NewWidth);
  end;
end;

procedure TStandardMenuPopupEx.PositionPopup(AnOwner: TCustomActionBar; ParentItem: TCustomActionControl);
var
  Popup: TStandardMenuPopupEx;
begin
  inherited PositionPopup(AnOwner, ParentItem);
  if (ParentItem.Parent is TStandardMenuPopupEx) then
  begin
    Popup := TStandardMenuPopupEx(ParentItem.Parent);
    if Assigned(Popup.Selected) and Assigned(Popup.Selected.Control) then
      Left := Popup.ClientToScreen(Popup.Selected.Control.BoundsRect.BottomRight).X - 6;
  end;
end;

procedure TStandardMenuPopupEx.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  ScreenPos: TPoint;
  MonitorHeight: Integer;
begin
  ScreenPos := ClientToScreen(Point(ALeft, ATop));
  MonitorHeight := Screen.MonitorFromPoint(ScreenPos).Height;
  if ScreenPos.Y + AHeight > MonitorHeight then
    AHeight := MonitorHeight - ScreenPos.Y;

  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if HandleAllocated then
    RequestAlign;
end;

procedure TStandardMenuPopupEx.WMKeyDown(var Message: TWMKey);
var
  NextPos: TPoint;
  Sibling: TControl;
begin
  case Message.CharCode of
    VK_RIGHT:
      if Assigned(Selected) and not Selected.HasItems and Assigned(Selected.Control) then
      begin
        NextPos := Point(Selected.Control.BoundsRect.Right + 1, Selected.Control.BoundsRect.Top);
        Sibling := ControlAtPos(NextPos, False);
        if Assigned(Sibling) then
        begin
          SelectItem(Sibling as TCustomActionControl);
          Exit;
        end;
      end;
    VK_LEFT:
      if Assigned(Selected) and not Selected.HasItems and Assigned(Selected.Control) then
      begin
        NextPos := Point(Selected.Control.BoundsRect.Left - 1, Selected.Control.BoundsRect.Top);
        Sibling := ControlAtPos(NextPos, False);
        if Assigned(Sibling) then
        begin
          SelectItem(Sibling as TCustomActionControl);
          Exit;
        end;
      end;
  end;
  inherited;
end;

{ TPlatformDefaultStyleActionBarsEx }

function TPlatformDefaultStyleActionBarsEx.GetPopupClass(ActionBar: TCustomActionBar): TCustomPopupClass;
begin
  if ActionBar is TCustomActionToolBar then
    Result := inherited GetPopupClass(ActionBar)
  else
    Result := TStandardMenuPopupEx;
end;

function TPlatformDefaultStyleActionBarsEx.GetStyleName: string;
begin
  Result := 'Platform Default Ex (with wrapping menus)';
end;

function FindMainActionManager: TActionManager;
var
  I: Integer;
begin
  Result := nil;
  if Assigned(Application) and Assigned(Application.MainForm) then
    for I := 0 to Application.MainForm.ComponentCount - 1 do
      if Application.MainForm.Components[I] is TActionManager then
      begin
        Result := TActionManager(Application.MainForm.Components[I]);
        Break;
      end;
end;

var
  ExStyle: TPlatformDefaultStyleActionBarsEx = nil;

procedure InitializeStyle;
var
  ActionManager: TActionManager;
begin
  ActionManager := FindMainActionManager;
  if Assigned(ActionManager) then
  begin
    ExStyle := TPlatformDefaultStyleActionBarsEx.Create;
    ActionManager.Style := ExStyle;
  end;
end;

procedure FinalizeStyle;
var
  ActionManager: TActionManager;
begin
  if not Assigned(ExStyle) then
    Exit;
  ActionManager := FindMainActionManager;
  if Assigned(ActionManager) then
  begin
    ActionManager.Style := PlatformDefaultStyle;
    FreeAndNil(ExStyle);
  end;
end;

initialization
  InitializeStyle;

finalization
  FinalizeStyle;

end.

The editor 'context' menu would probably benefit from this too? — Sertac Akyuz, Sep 15 '12 at 13:43
@SertacAkyuz Not as it stands now, since I only assign the new style to the main form's action manager. (I assume you mean source code editor's context menu which seems not to use the same action manager.) — Ondrej Kelle, Sep 15 '12 at 13:47
That's the one, I had no idea if it used the same action manager or not.. Thanks. — Sertac Akyuz, Sep 15 '12 at 14:04
Thank you! I know you will show up and share your always brilliant insights into IDE internals :-) I can confirm that, editor's actions are completely isolated from main actions (due their distinct lifetime probably). Sertac has a good point, editor's popup menu is another common place for add-ins. Once i've installed CnPack, it added tons of items into editor's popup menu, and menu exhibited the same behaviour - no scrolling/wrapping, so i presume it is TActionBar based too. [Borland's semi-official position on that (post #2)](http://www.delphigroups.info/2/88/297027.html) — Premature Optimization, Sep 16 '12 at 21:55
@PrematureOptimization Thank you, and if you need a solution for all popup menus in the IDE let me know, or post another question. If I find the time I'll give it a try. — Ondrej Kelle, Sep 17 '12 at 08:38
Maybe you can rotate your widescreen by 90 degrees :) Seriously though, this is a ridiculous resolution. You can see about 5 lines of code at once! Why not spend €50 for an upgrade to a monitor from this millenium? — Wouter van Nifterick, Sep 20 '12 at 00:45
@WoutervanNifterick Only to make clear, the resolution on the screenshot was set on purpose to demonstrate the wrapping of the menu items. :-) — Ondrej Kelle, Sep 20 '12 at 06:49

Ken White · Answer 2 · 2012-09-15T05:34:11.053

3

According to Winspector, the main menu in XE2 is TActionMainMenuBar. (Can't get a screen capture using Snagit, because of the way Winspector works, unfortunately.)

There are only three solutions that I can think of:

Install fewer "necessary add-ins" (which you obviously would have considered and rejected).
Get a larger monitor that supports a higher screen resolution to give you more screen area (which again you would have considered and rejected).
Write an IDE add-in that reorganizes the View menu using the ToolsAPI. GExperts and the JEDI JVcl have sample code for accessing existing menus (and adding your own) to the IDE that you should be able to adapt to do so.

edited Sep 15 '12 at 05:34

answered Sep 15 '12 at 04:48

Ken White

123,280
14
225
444

Can you confirm my assumption about what RAD Studio's main menu is TActionMainMenuBar? This might shed the light on the source of problem. – Premature Optimization Sep 15 '12 at 05:07
+1 for larger monitor. If your `view` menu doesn't even fit, it's definitely going to be worth the investment. – Wouter van Nifterick Sep 15 '12 at 12:49
@Wouter van Nifterick, it is good from display salesman PoV and just a silly otherwise, because it merely sets a new *enough for everyone* limit. – Premature Optimization Sep 16 '12 at 21:51

Overly tall "View" dropdown menu in XE2

2 Answers2