delphi - XE2 の「表示」ドロップダウンメニューが高すぎる

Question

歴史的に、Delphi のビュードロップダウンにはかなりの数の項目があります。Delphi XE2 といくつかの必要なアドインを追加すると、この数値はわずかに大きくなり、画面の高さにほとんど収まりませんでした。Windows がサポートする通常の TMainMenu は、このケースに対応し、スクロールまたはラッピング機能を提供できます。残念ながら、RAD Studio のメインメニューは TActionMainMenuBar であり、これを処理できないようです。

私はそれで何ができますか？お知らせ下さい。View メニュー項目を作成するアドインをもう 1 つ追加すると、ドロップダウンメニューの位置が変更され、マウスを離したときに不正なクリックが発生します。2 つまたは 3 つのアイテムが増えると、見えないアイテムができます :-(

score 6 · Accepted Answer

次のことを試すことができます (このユニットをデザインパッケージに追加し、IDE にインストールします)。IDE メインフォームの ActionManager を検出し、そのスタイルを、ポップアップメニューの新しいクラスを定義するカスタムスタイルに設定します。このポップアップメニュークラスは、メニュー項目が通常画面に収まらない場合にラップします。

ラッピングメニュー

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.

score 3 · Accepted Answer

Winspectorによると、XE2 のメインメニューはTActionMainMenuBar. (残念ながら、Winspector の動作方法により、Snagit を使用してスクリーンキャプチャを取得することはできません。)

私が考えることができる解決策は3つだけです。

インストールする「必要なアドイン」の数を減らします (これは明らかに考慮して拒否したはずです)。
より広い画面領域を提供するために、より高い画面解像度をサポートするより大きなモニターを入手してください (これも考慮して拒否したはずです)。
Viewを使用してメニューを再編成する IDE アドインを作成しますToolsAPI。GExpertsまた、JEDI JVcl既存のメニューにアクセスする (および独自のメニューを追加する) ためのサンプルコードが IDE にあり、そのために適応できるはずです。

delphi - XE2 の「表示」ドロップダウン メニューが高すぎる

2 に答える 2

Related

Reference

delphi - XE2 の「表示」ドロップダウンメニューが高すぎる