Слишком высокое выпадающее меню View в XE2

Исторически сложилось так, что выпадающий список Delphi View имеет значительное количество элементов. С Delphi XE2 и несколькими необходимыми надстройками это число стало незначительно большим и едва соответствовало высоте моего экрана. Обычный TMainMenu, поддерживаемый Windows, может приспособиться к этому случаю и обеспечить возможность прокрутки или переноса. К сожалению, похоже, что главным меню RAD Studio является TActionMainMenuBar, который не может с этим справиться.

Что я могу с этим сделать? Пожалуйста, порекомендуйте. Если я добавлю еще одну надстройку, которая создает пункт меню «Вид», он начнет перемещать раскрывающееся меню и производить мошеннический щелчок при отпускании мыши. С двумя или тремя предметами больше будет невидимый предмет :-(


person Premature Optimization    schedule 15.09.2012    source источник
comment
Напишите надстройку, которая перемещает некоторые элементы в подменю.   -  person David Heffernan    schedule 15.09.2012


Ответы (2)


Вы можете попробовать следующее (добавьте этот модуль в пакет дизайна и установите его в IDE). Он находит ActionManager основной формы IDE и задает для него пользовательский стиль, определяющий новый класс для всплывающих меню. Этот класс всплывающего меню оборачивает элементы меню, если они обычно не помещаются на экране:

Меню упаковки

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.
person Ondrej Kelle    schedule 15.09.2012
comment
Контекстное меню редактора, вероятно, тоже выиграет от этого? - person Sertac Akyuz; 15.09.2012
comment
@SertacAkyuz Не в том виде, в каком он есть сейчас, так как я назначаю новый стиль только диспетчеру действий основной формы. (Я предполагаю, что вы имеете в виду контекстное меню редактора исходного кода, которое, похоже, не использует тот же диспетчер действий.) - person Ondrej Kelle; 15.09.2012
comment
Это тот самый, я понятия не имел, использовал ли он тот же менеджер действий или нет. Спасибо. - person Sertac Akyuz; 15.09.2012
comment
Спасибо! Я знаю, что вы придете и поделитесь своим всегда блестящим пониманием внутреннего устройства IDE :-) Я могу подтвердить, что действия редактора полностью изолированы от основных действий (вероятно, из-за их разного времени жизни). У Sertac есть хорошее замечание: всплывающее меню редактора — еще одно распространенное место для надстроек. После того, как я установил CnPack, он добавил множество элементов во всплывающее меню редактора, и меню продемонстрировало такое же поведение - без прокрутки / переноса, поэтому я предполагаю, что оно также основано на TActionBar. полуофициальная позиция Borland по этому поводу (сообщение №2) - person Premature Optimization; 17.09.2012
comment
@PrematureOptimization Спасибо, и если вам нужно решение для всех всплывающих меню в IDE, дайте мне знать или задайте другой вопрос. Если найду время попробую. - person Ondrej Kelle; 17.09.2012
comment
Может быть, вы можете повернуть свой широкоформатный экран на 90 градусов :) А если серьезно, это смехотворное разрешение. Вы можете увидеть около 5 строк кода одновременно! Почему бы не потратить 50 евро на обновление до монитора этого тысячелетия? - person Wouter van Nifterick; 20.09.2012
comment
@WoutervanNifterick Только для ясности: разрешение на снимке экрана было установлено специально, чтобы продемонстрировать перенос пунктов меню. :-) - person Ondrej Kelle; 20.09.2012

Согласно Wинспекции, главное меню в XE2 — TActionMainMenuBar. (Невозможно сделать снимок экрана с помощью Snagit, к сожалению, из-за того, как работает Wинспекция.)

Есть только три решения, которые я могу придумать:

  1. Установите меньше «необходимых надстроек» (которые вы, очевидно, рассмотрели бы и отклонили).

  2. Получите монитор большего размера, который поддерживает более высокое разрешение экрана, чтобы дать вам больше площади экрана (что, опять же, вы бы рассмотрели и отклонили).

  3. Напишите надстройку IDE, которая реорганизует меню View с помощью файла ToolsAPI. GExperts и JEDI JVcl у вас есть пример кода для доступа к существующим меню (и добавления ваших собственных) в IDE, который вы сможете адаптировать для этого.

person Ken White    schedule 15.09.2012
comment
Можете ли вы подтвердить мое предположение о том, что главное меню RAD Studio — это TActionMainMenuBar? Это может пролить свет на источник проблемы. - person Premature Optimization; 15.09.2012
comment
+1 для большего монитора. Если ваше view меню даже не подходит, оно определенно стоит вложений. - person Wouter van Nifterick; 15.09.2012
comment
@Wouter van Nifterick, это хорошо от точки зрения продавца дисплеев и просто глупо в противном случае, потому что это просто устанавливает новый предел достаточно для всех. - person Premature Optimization; 17.09.2012