delphi - Delphi ActionMainMenuBar类别位置

我正在动态创建带有类别的ActionMainMenuBar，并且当按带有它们显示在ActionMainMenuBar下面的类别的按钮时，当ActionMainMenuBar对齐时，一切工作正常，但是alMainBottom（就像第二个选项菜单位于底部）。如果有足够的空间，它将始终尝试在下面显示它们。
有什么方法可以将类别位置设置为上方或执行“在下方没有足够的空间”之类的技巧，它将自动在上方显示类别菜单



RAD Studio 10.1，VCL
附言工具栏等也是一样

谢谢

最佳答案

是TCustomActionPopupMenu.PositionPopup单元中的Vcl.ActnMenus负责将菜单放置在问题下方的注释所指出的位置。您可以使用OnGetPopupClass事件为主菜单自定义弹出菜单类。或者，您可以通过子类化任何现有样式来创建自己的操作栏样式，而这根本不需要太多工作。另一种选择是挂接到方法TCustomActionPopupMenu.PositionPopup并根据需要“修复”其行为。

我将扩展这三种方法，但让我们从它们的共同点开始-方法PositionPopup的修改。它有两个参数：


AnOwner: TCustomActionBar-显示弹出菜单的操作栏（在您的情况下为主菜单）
ParentItem: TCustomActionControl-操作栏中的一项，用于调用弹出菜单。


特别是，仅当AnOwner对准底部并且ParentItem是TCustomMenuButton（顶级主菜单项）时，我们才感兴趣。这个想法是让PositionPopup计算菜单边界矩形，然后将其向上移动自身的高度加上ParentItem.Height的高度。仅当原始计算的位置在ParentItem以下并且其上方有足够的空间时，我们才这样做。

选项1：自定义弹出类别

您可以使用的事件OnGetPopupClass自定义弹出菜单类
TActionMainMenuBar：

type
  TMyThemedPopupMenu = class(TThemedPopupMenu)
  protected
    procedure PositionPopup(AnOwner: TCustomActionBar; ParentItem: TCustomActionControl); override;
  end;

procedure TMyThemedPopupMenu.PositionPopup(AnOwner: TCustomActionBar; ParentItem: TCustomActionControl);
var
  ParentItemPosition: TPoint;
begin
  inherited;
  if Assigned(AnOwner) and (AnOwner.Align = alBottom) and
     Assigned(ParentItem) and (ParentItem is TCustomMenuButton) then
  begin
    ParentItemPosition := ParentItem.ClientToScreen(Point(0, 0));
    if (ParentItemPosition.Y < Top) and (0 <= Top - Height - ParentItem.Height) then
      Top := Top - Height - ParentItem.Height;
  end;
end;

procedure TForm1.ActionMainMenuBar1GetPopupClass(Sender: TObject;
  var PopupClass: TCustomPopupClass);
begin
  if PopupClass = TThemedPopupMenu then
    PopupClass := TMyThemedPopupMenu;
end;

请注意，仅当原始类为TThemedPopupMenu时，此实现才用自定义类替换弹出类。当您没有将动作管理器的样式更改为Standard，XP或其他自定义样式，并且应用程序运行的平台支持主题时，就会发生这种情况。但是您可以轻松扩展它以支持TStandardMenuPopup和TXPStylePopupMenu。

选项2：自定义操作栏样式

我将继承TPlatformDefaultStyleActionBars的子类，因为它是默认样式。如上所述，它可以基于平台创建标准样式，XP样式或主题样式动作控件。我将再次只关注主题动作控件。此选项使用选项＃1中TMyThemedPopupMenu的实现。

type
  TMyActionBarStyle = class(TPlatformDefaultStyleActionBars)
  public
    function GetPopupClass(ActionBar: TCustomActionBar): TCustomPopupClass; override;
  end;

var
  MyActionBarStyle: TMyActionBarStyle;

function TMyActionBarStyle.GetPopupClass(ActionBar: TCustomActionBar): TCustomPopupClass;
begin
  Result := inherited GetPopupClass(ActionBar);
  if Result = TThemedPopupMenu then
    Result := TMyThemedPopupMenu;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ActionManager1.Style := MyActionBarStyle;
end;

{ ... }

initialization
  MyActionBarStyle := TMyActionBarStyle.Create;
finalization
  MyActionBarStyle.Free;
end.

请注意，我是在运行时在FormCreate中设置样式的，但您也可以将样式放入包中并通过RegisterActnBarStyle注册。这样一来，您就可以在设计时选择动作管理器的样式。

选项3：挂接TCustomActionPopupMenu.PositionPopup

如果您不想担心各种样式，则可以使用例如Delphi Detours Library。这将影响所有样式，因为它们的所有弹出菜单实现均继承自TCustomActionPopupMenu.PositionPopup。

uses System.Types, DDetours, Vcl.Controls, Vcl.ActnMan, Vcl.ActnMenus, Vcl.ActnPopup;

type
  TCustomActionPopupMenuAccess = class(TCustomActionPopupMenu);

var
  TrampolinePositionPopup: procedure(const Self; AnOwner: TCustomActionBar;
    ParentItem: TCustomActionControl);

procedure PositionPopupHooked(const Self; AnOwner: TCustomActionBar;
  ParentItem: TCustomActionControl);
var
  PopupMenu: TCustomActionPopupMenu;
  ParentItemPosition: TPoint;
begin
  TrampolinePositionPopup(Self, AnOwner, ParentItem);
  if Assigned(AnOwner) and (AnOwner.Align = alBottom) and
     Assigned(ParentItem) and (ParentItem is TCustomMenuButton) then
  begin
    PopupMenu := TCustomActionPopupMenu(@Self);
    ParentItemPosition := ParentItem.ClientToScreen(Point(0, 0));
    if (ParentItemPosition.Y < PopupMenu.Top) and (0 <= PopupMenu.Top - PopupMenu.Height - ParentItem.Height) then
      PopupMenu.Top := PopupMenu.Top - PopupMenu.Height - ParentItem.Height;
  end;
end;

initialization
  TrampolinePositionPopup := InterceptCreate(
    @TCustomActionPopupMenuAccess.PositionPopup, @PositionPopupHooked);
finalization
  InterceptRemove(@TrampolinePositionPopup);
end.