使用Delphi VCL样式的平面工具栏按钮 - 通过下拉菜单修复工具栏项目?

时间:2013-05-30 17:04:57

标签: delphi vcl-styles

这是this question关于在启用VCL样式时使工具栏按钮变平的后续行动。使用该问题的解决方案,现在我的大多数TActionToolbar按钮都是扁平的。但是,有一个工具栏按钮,其中包含一个带有其他操作的下拉菜单:

enter image description here

它仍然在它周围绘制按钮边缘。如何删除带有下拉菜单的工具栏按钮的按钮边框,以便它们与其他普通按钮匹配,看起来更像是在禁用VCL样式时?

1 个答案:

答案 0 :(得分:7)

此类按钮由TThemedDropDownButton类绘制,因此您必须覆盖此类和TThemedDropDownButton.DrawBackground方法。

使用same unit of the previous answer添加一个名为TThemedDropDownButtonEx

的新类
  TThemedDropDownButtonEx= class(TThemedDropDownButton)
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
  end;

然后像这样实现DrawBackground方法

procedure TThemedDropDownButtonEx.DrawBackground(var PaintRect: TRect);
const
  CheckedState: array[Boolean] of TThemedToolBar = (ttbButtonHot, ttbButtonCheckedHot);
var
  LIndex : Integer;
begin
  LIndex := SaveDC(Canvas.Handle);
  try
    if Enabled and not (ActionBar.DesignMode) then
    begin
      if (MouseInControl or IsChecked or DroppedDown) and
         (Assigned(ActionClient) and not ActionClient.Separator) then
      begin
        StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(CheckedState[IsChecked or (FState = bsDown)]), PaintRect);

       if IsChecked and not MouseInControl then
          StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(ttbButtonPressed), PaintRect);
      end
      else
        ;
    end
    else
      ;
  finally
    RestoreDC(Canvas.Handle, LIndex);
  end;
end;

最后以这种方式修改 TPlatformVclStylesStyle.GetControlClass 方法

更改此代码

if AnItem.HasItems then
  case GetActionControlStyle of
    csStandard: Result := TStandardDropDownButton;
    csXPStyle: Result := TXPStyleDropDownBtn;
  else
    Result := TThemedDropDownButton;
  end
else

由此

if AnItem.HasItems then
  case GetActionControlStyle of
    csStandard: Result := TStandardDropDownButton;
    csXPStyle: Result := TXPStyleDropDownBtn;
  else
    Result := TThemedDropDownButtonEx;
  end
else

enter image description here