启用了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屋!