如果某些菜单项不适合水平放置,如何将Chevron(双箭头)添加到TActionMainMenuBar

时间:2013-02-21 13:27:54

标签: delphi menu delphi-xe2 tactionmanager

chevron
TActionMainMenuBar没有此功能。
TActionToolBar自动添加雪佛龙,但此菜单有一些自定义命令。

如何将此功能添加到TActionMainMenuBar并隐藏雪佛龙菜单中的自定义命令? 或者可以模仿这个功能?

1 个答案:

答案 0 :(得分:0)

TActionToolBar的解决方案:

将Vcl.ActnMenus和Vcl.ActnCtrls复制到项目源文件夹中。

现在在ActCtrls中修改过程TCustomToolScrollBtn.DrawArrows

procedure TCustomToolScrollBtn.DrawArrows;
const
  ArrowDirection: array[TAlign] of TScrollDirection = (sdDown, sdUp,
    sdDown, sdDown, sdDown, sdDown, sdDown);
var
  P: TPoint;
  TempCanvas: TCanvas;
  LDetails: TThemedElementDetails;
  LColor: TColor;
begin
  case FDirection of
    sdUp,
    sdDown : P := Point(Width div 2 - FArrowSize, 3);
    sdRight,
    sdLeft : P := Point(Width div 2 - FArrowSize div 2, 3);
  end;
  TempCanvas := TCanvas.Create;
  TempCanvas.Handle := Canvas.Handle;
  try
    if TCustomActionToolBar(Parent).HiddenCount < 1 then
     begin
       self.Enabled:=false;
       exit;
     end else self.Enabled:=true;
   if TStyleManager.IsCustomStyleActive then
    begin
      if not Enabled then
        LDetails := StyleServices.GetElementDetails(ttbButtonDisabled)
      else
      if Self.FDown then
        LDetails := StyleServices.GetElementDetails(ttbButtonPressed)
      else
      if FMouseInControl then
        LDetails := StyleServices.GetElementDetails(ttbButtonHot)
      else
        LDetails := StyleServices.GetElementDetails(ttbButtonNormal);
      if not StyleServices.GetElementColor(LDetails, ecTextColor, LColor) then
        if Enabled then
          LColor := StyleServices.GetSystemColor(clBtnText)
        else
          LColor := StyleServices.GetSystemColor(clGrayText);
      TempCanvas.Pen.Color := LColor;
    end
    else
    if Enabled then
      TempCanvas.Pen.Color := ActionBar.ColorMap.FontColor
    else
      TempCanvas.Pen.Color := ActionBar.ColorMap.DisabledFontColor;
    if Parent is TCustomActionToolBar then
      if TCustomActionToolBar(Parent).HiddenCount > 0 then
          DrawChevron(TempCanvas, sdDown, Point(Width div 2 - FArrowSize, Height div 2 - FArrowSize), FArrowSize);
  finally
    TempCanvas.Handle := 0;
    TempCanvas.Free;
  end;
end;

并更改过程TCustomizeActionToolBar.DoAddCustomizeItems 在Vcl.ActnMenus中 只需注释代码:

    if Assigned(ActionBarItem) then
    begin
     {
      if AnActionClient.Items.Count > 0 then
        AddSeparator(AnActionClient.Items);
      FAddlItem := AnActionClient.Items.Add;
      FAddlItem.Caption := SAddRemoveButtons;
      AddItems(FAddlItem.Items, ActionBarItem.Items, ActionBarItem.Items.Count - 1);
      with TActionBarItem(RootMenu.ParentControl.ActionBar.ActionClient) do  AddItems(FAddlItem.Items, Items, Items.Count - 2);
      }
      if ActionBarItem.Items.Count > 0 then
      begin
       {
        FResetAction := TCustomAction.Create(Self);
        with FResetAction do
          Caption := SResetActionToolbar;
        if FAddlItem.Items.Count > 0 then
          AddSeparator(AnActionClient.Items);
        FResetItem := AnActionClient.Items.Add;
        with FResetItem do
        begin
          Action := FResetAction;
          UsageCount := -1;
        end;
        }
      end;
    end;
  end;

现在,如果隐藏了某些元素,则可以看到Chevron,并且在其菜单中没有用于自定义的工具。