启用了Delphi VCL样式的平面工具栏按钮? [英] Flat toolbar buttons with Delphi VCL Styles enabled?

问题描述

没有启用VCL样式，我的TActionToolbar(s)看起来像平面工具栏.但是，如果我启用了几乎所有的VCL样式，突然所有工具栏按钮都看起来像3d按钮.

Without VCL styles enabled, my TActionToolbar(s) look like flat toolbars. However, if I enable pretty much any VCL style, suddenly all the toolbar buttons look like 3d buttons.

VCL Style Viewer应用程序显示具有平坦外观和按钮外观的工具栏按钮:

The VCL Style Viewer app shows toolbar buttons with both flat and button-like appearance:

启用VCL样式后，如何使TActionToolbar具有平坦的工具栏按钮样式而不是看起来像一堆按钮?

How can I make my TActionToolbar have the flat toolbar button style instead of looking like a bunch of buttons when I enable VCL Styles?

推荐答案

与 TPlatformDefaultStyleActionBars 类从此处开始，根据Windows版本(如果启用了vcl样式等)选择用于绘制控件的类.在这种情况下，选择了 csThemed TActionControlStyle ，并使用了 Vcl.ThemedActnCtrls 单元中定义的类.

The draw methods used by all the controls related to the TActionManager are handled by a TPlatformDefaultStyleActionBars class from here the classes used to paint the controls are selected depending of the windows version, if the vcl styles are enabled and so on. On this case the csThemed TActionControlStyle is selected and the classes defined in the Vcl.ThemedActnCtrls unit are used.

因此，要修改按钮的外观，您需要创建一个TActionBarStyleEx后代类，然后覆盖在 Vcl.ThemedActnCtrls 单元中定义的类和方法.幸运的是，这项工作已经在 Vcl样式实用程序项目.因此，只有您需要进行一些小的修改才能获得所需的结果.

So to modify the aspect of the buttons you need create a TActionBarStyleEx descendent class and then override the classes and methods defined in the Vcl.ThemedActnCtrls unit. fortunately this work was already done in the Vcl.PlatformVclStylesActnCtrls unit which is part of the Vcl Styles Utils project. So only you need make some small modifications in order to get desired results.

尝试此示例(这是

Try this sample (this is a modified version of the Vcl.PlatformVclStylesActnCtrls unit) I added some comments to show where the code must be modified.

unit Vcl.PlatformVclStylesActnCtrls;

interface

uses
   Vcl.ActnMan,
   Vcl.Buttons,
   Vcl.PlatformDefaultStyleActnCtrls;

type
  TPlatformVclStylesStyle = class(TPlatformDefaultStyleActionBars)
  public
    function GetControlClass(ActionBar: TCustomActionBar; AnItem: TActionClientItem): TCustomActionControlClass; override;
    function GetStyleName: string; override;
  end;

var
  PlatformVclStylesStyle: TPlatformVclStylesStyle;

implementation

uses
  Vcl.Menus,
  Winapi.Windows,
  System.SysUtils,
  Vcl.ActnMenus,
  Vcl.ActnCtrls,
  Vcl.ThemedActnCtrls,
  Vcl.Forms,
  Vcl.ListActns,
  Vcl.ActnColorMaps,
  Vcl.Themes,
  Vcl.XPActnCtrls,
  Vcl.StdActnMenus,
  Vcl.Graphics;

type
  TActionControlStyle = (csStandard, csXPStyle, csThemed);

  TThemedMenuItemEx = class(Vcl.ThemedActnCtrls.TThemedMenuItem)
  private
    procedure NativeDrawText(DC: HDC; const Text: string; var Rect: TRect; Flags: Longint);
  protected
    procedure DrawText(var Rect: TRect; var Flags: Cardinal; Text: string); override;
  end;

  TThemedMenuButtonEx = class(Vcl.ThemedActnCtrls.TThemedMenuButton)
  private
    procedure NativeDrawText(const Text: string; var Rect: TRect; Flags: Longint);
  protected
    procedure DrawText(var ARect: TRect; var Flags: Cardinal;
      Text: string); override;
  end;

  TThemedMenuItemHelper = class Helper for TThemedMenuItem
  private
   function GetPaintRect: TRect;
   property PaintRect: TRect read GetPaintRect;
  end;

  TThemedButtonControlEx = class(TThemedButtonControl)
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
  end;


{ TThemedMenuItemHelper }
function TThemedMenuItemHelper.GetPaintRect: TRect;
begin
 Result:=Self.FPaintRect;
end;

function GetActionControlStyle: TActionControlStyle;
begin
  if TStyleManager.IsCustomStyleActive then
    Result := csThemed
  else
  if TOSVersion.Check(6) then
  begin
    if StyleServices.Theme[teMenu] <> 0 then
      Result := csThemed
    else
      Result := csXPStyle;
  end
  else
  if TOSVersion.Check(5, 1) then
    Result := csXPStyle
  else
    Result := csStandard;
end;

{ TPlatformDefaultStyleActionBarsStyle }

function TPlatformVclStylesStyle.GetControlClass(ActionBar: TCustomActionBar;
  AnItem: TActionClientItem): TCustomActionControlClass;
begin
  if ActionBar is TCustomActionToolBar then
  begin
    if AnItem.HasItems then
      case GetActionControlStyle of
        csStandard: Result := TStandardDropDownButton;
        csXPStyle: Result := TXPStyleDropDownBtn;
      else
        Result := TThemedDropDownButton;
      end
    else
    if (AnItem.Action is TStaticListAction) or (AnItem.Action is TVirtualListAction) then
      Result := TCustomComboControl
    else
    case GetActionControlStyle of
      csStandard: Result := TStandardButtonControl;
      csXPStyle: Result := TXPStyleButton;
    else
      Result := TThemedButtonControlEx;//this is the class used to draw the buttons of the TActionToolbar
    end
  end
  else
  if ActionBar is TCustomActionMainMenuBar then
    case GetActionControlStyle of
      csStandard: Result := TStandardMenuButton;
      csXPStyle: Result := TXPStyleMenuButton;
    else
      Result := TThemedMenuButtonEx;
    end
  else
  if ActionBar is TCustomizeActionToolBar then
  begin
    with TCustomizeActionToolbar(ActionBar) do
      if not Assigned(RootMenu) or (AnItem.ParentItem <> TCustomizeActionToolBar(RootMenu).AdditionalItem) then
        case GetActionControlStyle of
          csStandard: Result := TStandardMenuItem;
          csXPStyle: Result := TXPStyleMenuItem;
        else
          Result := TThemedMenuItemEx;
        end
      else
      case GetActionControlStyle of
          csStandard: Result := TStandardAddRemoveItem;
          csXPStyle: Result := TXPStyleAddRemoveItem;
      else
          Result := TThemedAddRemoveItem;
      end
  end
  else
  if ActionBar is TCustomActionPopupMenu then
    case GetActionControlStyle of
      csStandard: Result := TStandardMenuItem;
      csXPStyle: Result := TXPStyleMenuItem;
    else
      Result := TThemedMenuItemEx;
    end
  else
  case GetActionControlStyle of
    csStandard: Result := TStandardButtonControl;
    csXPStyle: Result := TXPStyleButton;
  else
    Result := TThemedButtonControl;
  end
end;

function TPlatformVclStylesStyle.GetStyleName: string;
begin
  Result := 'Platform VclStyles Style';
end;

{ TThemedMenuItemEx }

procedure TThemedMenuItemEx.NativeDrawText(DC: HDC; const Text: string;
  var Rect: TRect; Flags: Integer);
const
  MenuStates: array[Boolean] of TThemedMenu = (tmPopupItemDisabled, tmPopupItemNormal);
var
  LCaption: string;
  LFormats: TTextFormat;
  LColor: TColor;
  LDetails: TThemedElementDetails;
  LNativeStyle : TCustomStyleServices;
begin
  LNativeStyle:=TStyleManager.SystemStyle;

  LFormats := TTextFormatFlags(Flags);
  if Selected and Enabled then
  begin
    LDetails := StyleServices.GetElementDetails(tmPopupItemHot);
    if TOSVersion.Check(5, 1) then
     SetBkMode(DC, Winapi.Windows.TRANSPARENT);
  end
  else
    LDetails := StyleServices.GetElementDetails(MenuStates[Enabled or ActionBar.DesignMode]);

  if not StyleServices.GetElementColor(LDetails, ecTextColor, LColor) or (LColor = clNone) then
    LColor := ActionBar.ColorMap.FontColor;

  LCaption := Text;
  if (tfCalcRect in LFormats) and ( (LCaption = '') or (LCaption[1] = cHotkeyPrefix) and (LCaption[2] = #0) ) then
    LCaption := LCaption + ' ';

  LNativeStyle.DrawText(DC, LDetails, LCaption, Rect, LFormats, LColor);
end;

procedure TThemedMenuItemEx.DrawText(var Rect: TRect; var Flags: Cardinal;
  Text: string);
var
  LRect: TRect;
begin
  if Selected and Enabled then
    StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tmPopupItemHot), PaintRect)
  else if Selected then
    StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tmPopupItemDisabledHot), PaintRect);

  if (Parent is TCustomActionBar) and (not ActionBar.PersistentHotkeys) then
    Text := FNoPrefix;
  Canvas.Font := Screen.MenuFont;

  if ActionClient.Default then
    Canvas.Font.Style := Canvas.Font.Style + [fsBold];

  LRect := PaintRect;
  NativeDrawText(Canvas.Handle, Text, LRect, Flags or DT_CALCRECT or DT_NOCLIP);
  OffsetRect(LRect, Rect.Left,
    ((PaintRect.Bottom - PaintRect.Top) - (LRect.Bottom - LRect.Top)) div 2);
  NativeDrawText(Canvas.Handle, Text, LRect, Flags);

  if ShowShortCut and ((ActionClient <> nil) and not ActionClient.HasItems) then
  begin
    Flags := DrawTextBiDiModeFlags(DT_RIGHT);
    LRect := TRect.Create(ShortCutBounds.Left, LRect.Top, ShortCutBounds.Right, LRect.Bottom);
    LRect.Offset(Width, 0);
    NativeDrawText(Canvas.Handle, ActionClient.ShortCutText, LRect, Flags);
  end;
end;

{ TThemedMenuButtonEx }
procedure TThemedMenuButtonEx.NativeDrawText(const Text: string; var Rect: TRect;
  Flags: Integer);
const
  MenuStates: array[Boolean] of TThemedMenu = (tmMenuBarItemNormal, tmMenuBarItemHot);
var
  LCaption: string;
  LFormats: TTextFormat;
  LColor: TColor;
  LDetails: TThemedElementDetails;
  LNativeStyle : TCustomStyleServices;
begin
  LNativeStyle:=TStyleManager.SystemStyle;

  LFormats := TTextFormatFlags(Flags);
  if Enabled then
    LDetails := StyleServices.GetElementDetails(MenuStates[Selected or MouseInControl or ActionBar.DesignMode])
  else
    LDetails := StyleServices.GetElementDetails(tmMenuBarItemDisabled);

  Canvas.Brush.Style := bsClear;
  if Selected then
    Canvas.Font.Color := clHighlightText
  else
    Canvas.Font.Color := clMenuText;

  if not StyleServices.GetElementColor(LDetails, ecTextColor, LColor) or (LColor = clNone) then
    LColor := ActionBar.ColorMap.FontColor;

  LCaption := Text;
  if (tfCalcRect in LFormats) and ( (LCaption = '') or (LCaption[1] = cHotkeyPrefix) and (LCaption[2] = #0) ) then
    LCaption := LCaption + ' ';

  if Enabled then
    LDetails := StyleServices.GetElementDetails(MenuStates[Selected or MouseInControl]);

  LNativeStyle.DrawText(Canvas.Handle, LDetails, LCaption, Rect, LFormats, LColor);
end;

procedure TThemedMenuButtonEx.DrawText(var ARect: TRect; var Flags: Cardinal;
  Text: string);
var
  LRect: TRect;
begin
  if Parent is TCustomActionMainMenuBar then
    if not TCustomActionMainMenuBar(Parent).PersistentHotkeys then
      Text := StripHotkey(Text);

  LRect := ARect;
  Inc(LRect.Left);
  Canvas.Font := Screen.MenuFont;
  NativeDrawText(Text, LRect, Flags or DT_CALCRECT or DT_NOCLIP);
  NativeDrawText(Text, LRect, Flags);
end;

{ TThemedButtonControlEx }
//Here you must modify the code to draw the buttons
procedure TThemedButtonControlEx.DrawBackground(var PaintRect: TRect);
const
  DisabledState: array[Boolean] of TThemedToolBar = (ttbButtonDisabled, ttbButtonPressed);
  CheckedState: array[Boolean] of TThemedToolBar = (ttbButtonHot, ttbButtonCheckedHot);
var
  SaveIndex: Integer;
begin
  if not StyleServices.IsSystemStyle and ActionClient.Separator then Exit;

  SaveIndex := SaveDC(Canvas.Handle);
  try
    if Enabled and not (ActionBar.DesignMode) then
    begin
      if (MouseInControl or IsChecked) and
         Assigned(ActionClient) {and not ActionClient.Separator)} then
      begin
        StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(CheckedState[IsChecked or (FState = bsDown)]), PaintRect);

        if not MouseInControl then
          StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(ttbButtonPressed), PaintRect);
      end
      else
        ;//StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(ttbButtonNormal), PaintRect);// the code to draw the button in normal state was commented to get the desired look and feel
    end
    else
      ;//StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(DisabledState[IsChecked]), PaintRect);// the code to draw the button in disabled state was commented to get the desired look and feel

  finally
    RestoreDC(Canvas.Handle, SaveIndex);
  end;
end;

initialization
  PlatformVclStylesStyle := TPlatformVclStylesStyle.Create;
  RegisterActnBarStyle(PlatformVclStylesStyle);
  DefaultActnBarStyle :=PlatformVclStylesStyle.GetStyleName;
finalization
  UnregisterActnBarStyle(PlatformVclStylesStyle);
  PlatformVclStylesStyle.Free;
end.

要使用它，只需将Vcl.PlatformVclStylesActnCtrls单元添加到您的项目中，然后像这样设置TActionManager的样式:

To use it only add the Vcl.PlatformVclStylesActnCtrls unit to your project and then set the Style of your TActionManager like so :

  ActionManager1.Style:=PlatformVclStylesStyle;

之前

之后

这篇关于启用了Delphi VCL样式的平面工具栏按钮?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！