简体   繁体   中英

how to add Chevron(double arrow) to TActionMainMenuBar if some menu items do not fit horisontally

chevron
TActionMainMenuBar does not have this feature.
TActionToolBar adds Chevron automatically, but this menu have some customize commands.

How to add this feature to TActionMainMenuBar and hide customize commands from Chevron menu?
Or maybe emulate this feature?

The solution for TActionToolBar:

Copy Vcl.ActnMenus and Vcl.ActnCtrls to your project source folder.

Now modify procedure TCustomToolScrollBtn.DrawArrows in ActCtrls

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;

And change procedure TCustomizeActionToolBar.DoAddCustomizeItems in Vcl.ActnMenus Just comment code:

    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;

Now Chevron is visible if some elements are hidden, and in its menu there are no tools for customization.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM