Ribbon - Выпадающее меню со скроллбаром. Точнее его отсутствие.

[WhiskasTM]

Здрасьте. Скандалы, интриги, расследования.
Кнопка обыкновенная: csButton + btSplit с выпадающим меню.
Назначение: Undo/Redo.
Особые фичи: хранит список действий и знает их кол-во, автоматически выделяет все предыдущие пункты + пара непримечательных бонусов.

3dsmax:


Office:


Пункты выпадающего меню не имеют заглушки под картинки(та, что всегда слева во всех меню вместе с дурацкой полоской) и есть вертикальный scrollbox. Это Windows где-то заныкал контрол и никому не сказал кроме автостола или они сами эти меню сделали обходными путями?

Вот такой код добавляет лишь самые обыкновенные пункты меню. Никакого скроллбара, никакого свойства у родителя overflow/maxitems в принципе нет.

procedure TMForm.FormCreate(Sender: TObject);
var
ActionClient : TActionClient;
ChildItem    : TActionClientItem;
  i: Integer;
begin
ActionClient := RibbonQuickAccessToolbar1.ActionControls[0].ActionClient;
for i := 0 to 100 do
begin
  ChildItem := ActionClient.Items.Add;
  ChildItem.CommandStyle := csButton;
  ChildItem.Caption := 'Deleted Index '+IntToStr(i);
end;
ChildItem := ActionClient.Items.Add;
ChildItem.CommandStyle := csSeparator;
end;

Вообщем, хочу как у них. Есть идеи?

[Stilet]

Windows где-то заныкал контрол

Очень сомневаюсь.
Возьми Spy++ наведи его на контрол и посмотри как класс называется, и точно ли это один единый контрол а не комбинация.

[Аватар]

Наверняка комбинация разных контролов, в основе скорее всего ComboBox

[WhiskasTM]

Меню динамическое и исчезает, но поймал вроде (если не промазал):

У самого риббона тоже родитель hWnd="404D6" .

В оффисе же "Net UI Tool Window" и если кликать ПКМ то будет:

____

Если будет borderless форма или combobox(что полегче) и создавать динамически, то как ловить нажатие по стрелке вон той кнопки? Именно по стрелке. DropDownMenu нету, потому как это action, у нас везде action, мы ведь action. Сабж, смахивает на отдельную форму + actionmanager как-то прикрепленный к основному риббону(чтобы цвета рендерились одинаково). Придется мучать((

[WhiskasTM]

Помимо формы.
Эти action контролы оказывается можно подменить на свои, унаследованные от TCustomActionControl и возвращать тип класса в GetControlClass(этот виртуальный обычно в движке прорисовки ActionManager-а, ActionBar вроде). Правда поведение контролов придется создавать почти с нуля, там они едва работают.

uses
Vcl.Ribbon, Vcl.RibbonActnMenus,  Vcl.RibbonActnCtrls, Vcl.RibbonStyleActnCtrls, Vcl.RibbonSilverStyleActnCtrls;

type
  TRibbonSmallSplitButton = class(Vcl.RibbonActnCtrls.TRibbonSmallSplitButton)
  protected
    function GetPopupClass:TCustomPopupClass;override;
  protected
    procedure DoDropDown(const SelectFirst:Boolean);override;
  end;

  TRibbonSilverStyleActionBars = class(Vcl.RibbonSilverStyleActnCtrls.TRibbonSilverStyleActionBars)
  public
    function GetControlClass(ActionBar:TCustomActionBar;AnItem:TActionClientItem):TCustomActionControlClass;override;
  end;

  TRibbonActionPopupMenu = class(Vcl.RibbonActnMenus.TRibbonActionPopupMenu)
  public
    function GetControlClass(AnItem:TActionClientItem):TCustomActionControlClass;override;
  end;

  TMForm = class(TForm)
    Manager: TActionManager;
    Ribbon: TRibbon;
    AMB: TRibbonApplicationMenuBar;
    QAT: TRibbonQuickAccessToolbar;
    Images: TImageList;
    actUndo: TAction;
    actRedo: TAction;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    Action4: TAction;
    Action5: TAction;
    Action6: TAction;
    Action7: TAction;
    procedure Action1Execute(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure Action3Execute(Sender: TObject);
    procedure Action4Execute(Sender: TObject);
    procedure Action6Execute(Sender: TObject);
    procedure Action7Execute(Sender: TObject);
    procedure Action5Execute(Sender: TObject);
    procedure actUndoExecute(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

implementation

{ Hack Button }

function TRibbonSmallSplitButton.GetPopupClass:TCustomPopupClass;
begin
Result := TRibbonActionPopupMenu;        //FMain.TRibbonActionPopupMenu
end;

procedure TRibbonSmallSplitButton.DoDropDown(const SelectFirst:Boolean);
begin
inherited DoDropDown(SelectFirst);
//OnDropDown etc.
end;

{ Hack Style }

function TRibbonSilverStyleActionBars.GetControlClass(ActionBar:TCustomActionBar;AnItem:TActionClientItem):TCustomActionControlClass;
begin
Result := inherited;
if Result.ClassNameIs('TRibbonSmallSplitButton') and (AnItem.Action.Name='actUndo') then
  Result := TRibbonSmallSplitButton;     //FMain.TRibbonSmallSplitButton
end;

{ Hack Popup }

function TRibbonActionPopupMenu.GetControlClass(AnItem:TActionClientItem):TCustomActionControlClass;
begin
Result := inherited;
if Result.ClassNameIs('TRibbonMenuItem') then
begin
  if AnItem.Action.Name='Action1' then
    Result := TRibbonSmallSplitButton else
  if AnItem.Action.Name='Action2' then
    Result := TRibbonApplicationMenuButton else
  if AnItem.Action.Name='Action3' then
    Result := TRibbonTextControl;
  if AnItem.Action.Name='Action4' then
    Result := TRibbonMenuItem else
  if AnItem.Action.Name='Action5' then
    Result := TRibbonRadioButtonControl else
  if AnItem.Action.Name='Action6' then
    Result := TRibbonComboControl else
  if AnItem.Action.Name='Action7' then
    Result := TRibbonToolScrollButton else
end;
end;

procedure TMForm.Action1Execute(Sender: TObject);
begin { Idle }end;

procedure TMForm.Action2Execute(Sender: TObject);
begin { Idle }end;

procedure TMForm.Action3Execute(Sender: TObject);
begin { Idle }end;

procedure TMForm.Action4Execute(Sender: TObject);
begin { Idle }end;

procedure TMForm.Action5Execute(Sender: TObject);
begin { Idle }end;

procedure TMForm.Action6Execute(Sender: TObject);
begin { Idle }end;

procedure TMForm.Action7Execute(Sender: TObject);
begin { Idle }end;

procedure TMForm.actUndoExecute(Sender: TObject);
begin { Idle }end;

//Перерегистрация
//  с
//  Vcl.RibbonSilverStyleActnCtrls.TRibbonSilverStyleActionBars
//  на
//  FMain.TRibbonSilverStyleActionBars
initialization
UnregisterActnBarStyle(RibbonSilverStyle); //Vcl.RibbonSilverStyleActnCtrls.TRibbonSilverStyleActionBars
RibbonSilverStyle.Free;
RibbonSilverStyle := TRibbonSilverStyleActionBars.Create; //FMain.TRibbonSilverStyleActionBars
RegisterActnBarStyle(RibbonSilverStyle);

Ну и сразу баг с Quick Access Toolbar:


Там просто запредельная засохшая паутина зависимостей, совершенно не расширяемая фигня Я пошел.