delphi - 扩展 TActionManager - 绘制渐变？

Question

我喜欢使用 TActionManager 中的 XPStyle 来创建我的菜单界面。

我真正想做的一件事是在不使用第 3 方组件的情况下沿菜单侧面渲染渐变:

XPColorMap 似乎没有更改此设置所需的属性，除非我忽略了一些非常明显的东西。

如果可能的话，我该如何做到这一点？

谢谢。

更新

感谢 wp_1233996 提供的优秀信息和代码示例，结果如下:

我不明白 Windows 7 上的 XP 样式菜单为何如此令人讨厌？我个人认为它看起来真的很好:)

Answer 1

http://edn.embarcadero.com/article/33461链接到 Jeremy North 撰写的一篇精彩文章，该文章解释了操作栏组件背后的一些魔力。我的解决方案基于这篇文章。

首先，负责绘制菜单项的类是 TXPStyleMenuItem(在单元 Vcl.XPActnCtrls 中)。创建一个继承自 TXPStyleMenuItem 的新类并重写 DrawBackground 方法。新方法应该是这样的:

uses
  ..., Vcl.XPActnCtrls, Vcl.GraphUtil, ...;

type
  TMyStyleMenuItem = class(TXPStyleMenuItem)
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
end;

procedure TMyStyleMenuItem.DrawBackground(var PaintRect: TRect);
// Some lines are copied from Delphi's TXPStyleMenuItem.DrawBackground.
var
  BannerRect: TRect;
  StartCol, EndCol: TColor;
begin
  inherited;

  BannerRect := PaintRect;
  BannerRect.Right := 25;
  StartCol := clGray; //or: Actionbar.ColorMap.UnusedColor;
  EndCol := clSilver; //or: Actionbar.ColorMap.Color;
  GradientFillCanvas(Canvas, StartCol, EndCol, BannerRect, gdHorizontal);

  if (Selected and Enabled) or (Selected and not MouseSelected) then
  begin
    if Enabled and not ActionBar.DesignMode then
      if not Separator or (Separator and ActionBar.DesignMode) then
        Canvas.Brush.Color := Menu.ColorMap.SelectedColor;
    Dec(PaintRect.Right, 1);
  end;
  if (not ActionBar.DesignMode and Separator) then exit;
  if not Mouse.IsDragging and ((Selected and Enabled) or
     (Selected and not MouseSelected)) then
  begin
    Canvas.FillRect(PaintRect);
    Canvas.Brush.Color := ActionBar.ColorMap.BtnFrameColor;
    Inc(PaintRect.Right);
    Canvas.FrameRect(PaintRect);
  end;
end;

在此代码中，渐变开始颜色和结束颜色是硬编码的。为了获得更好的灵 active ，最好从注释所示的颜色图中获取颜色。

为了使用这个新类而不是旧的 XPStyleMenuItem，请为 ActionMainMenubar 的事件 OnGetControlClass 实现一个事件处理程序:

procedure TForm1.ActionMainMenuBar1GetControlClass(Sender: TCustomActionBar;
  AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
  if ControlClass.InheritsFrom(TXPStyleMenuItem) then
    ControlClass := TMyStyleMenuItem;
end;