如果未启用VCL样式,我的TActionToolbar看起来像扁平工具栏。但是,如果我启用几乎任何VCL样式,突然所有工具栏按钮看起来像3d按钮。
VCL样式查看器应用程序显示工具栏按钮,具有平面和按钮状外观:
当我启用VCL样式时,如何让TActionToolbar具有平面工具栏按钮样式而不是看起来像一堆按钮?
答案 0 :(得分:11)
与TActionManager相关的所有控件使用的绘制方法由TPlatformDefaultStyleActionBars类处理,此处根据windows版本选择用于绘制控件的类,如果是vcl样式启用等等。在这种情况下,选择 csThemed TActionControlStyle ,并使用 Vcl.ThemedActnCtrls 单元中定义的类。
因此,要修改按钮的方面,需要创建一个TActionBarStyleEx
后代类,然后覆盖 Vcl.ThemedActnCtrls 单元中定义的类和方法。幸运的是,这项工作已在Vcl.PlatformVclStylesActnCtrls
单元中完成,该单元是Vcl Styles Utils项目的一部分。因此,只有您需要进行一些小的修改才能获得理想的结果。
尝试此示例(这是Vcl.PlatformVclStylesActnCtrls单元的修改版本)我添加了一些注释以显示代码必须修改的位置。
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的样式,如下所示:
ActionManager1.Style:=PlatformVclStylesStyle;
在
在