扩展TActionManager - 绘制渐变？

Question

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

如果不使用第三方组件，我真的想做的一件事就是在菜单旁边呈现渐变：

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;

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

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

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