delphi - 如何模拟 Word 2010 风格的 Options 类别选择器

Question

Word 2010 中的“选项”对话框通过一组白色“切换”按钮实现类别选择器，这些按钮在单击（选择）时变为橙色。

如何在 Delphi 中重新实现这种行为？需要符合当前的 Windows 主题（即必须可以将按钮颜色指定为 clWindow，而不是 clWhite）。

编辑：澄清一下-我只有左侧的类别选择器有问题。其他一切都相当简单。

Answer 1

您可以使用 TButtonGroup组件。

到目前为止，使用 VCL 样式是最简单的解决方案，但正如您所说，在 XE2 中使用样式非常不舒服，在我看来，这个功能只有在 XE3 中才真正可行。

根据您使用默认绘画方法的要求，我正在提交我的解决方案，

该项目的源代码可在此处获得。

该项目需要一个图像，图像与项目一起压缩。

在 XE4 中编译和测试。

---

---

type

  TButtonGroup = class(Vcl.ButtonGroup.TButtonGroup)
   protected
     procedure Paint; override;
  end;

  TForm1 = class(TForm)
    ButtonGroup1: TButtonGroup;
    Panel1: TPanel;
    procedure ButtonGroup1DrawButton(Sender: TObject; Index: Integer;
      Canvas: TCanvas; Rect: TRect; State: TButtonDrawState);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MBitmap : TBitmap;

implementation

{$R *.dfm}

procedure TButtonGroup.Paint;
var
  R : TRect;
begin
   inherited;
   R := GetClientRect;
   R.Top := Self.Items.Count * Self.ButtonHeight;
   {Remove the clBtnFace background default Painting}
   Self.Canvas.FillRect(R);
end;

procedure TForm1.ButtonGroup1DrawButton(Sender: TObject; Index: Integer;
  Canvas: TCanvas; Rect: TRect; State: TButtonDrawState);
var
  TextLeft, TextTop: Integer;
  RectHeight: Integer;
  ImgTop: Integer;
  Text : String;
  TextOffset: Integer;
  ButtonItem: TGrpButtonItem;
  InsertIndication: TRect;
  DrawSkipLine : TRect;
  TextRect: TRect;
  OrgRect: TRect;

begin

    //OrgRect := Rect;  //icon
    Canvas.Font := TButtonGroup(Sender).Font;

      if bdsSelected in State then begin
         Canvas.CopyRect(Rect,MBitmap.Canvas,
                         System.Classes.Rect(0, 0, MBitmap.Width, MBitmap.Height));
         Canvas.Brush.Color := RGB(255,228,138);
      end
      else if bdsHot in State then
      begin
        Canvas.Brush.Color := RGB(194,221,244);
        Canvas.Font.Color := clBlack;

      end
       else
        Canvas.Brush.color := clWhite;

      if not (bdsSelected in State)
      then
        Canvas.FillRect(Rect);


      InflateRect(Rect, -2, -1);


    { Compute the text location }
    TextLeft := Rect.Left + 4;
    RectHeight := Rect.Bottom - Rect.Top;
     TextTop := Rect.Top + (RectHeight - Canvas.TextHeight('Wg')) div 2; { Do not localize }
    if TextTop < Rect.Top then
      TextTop := Rect.Top;
    if bdsDown in State then
    begin
      Inc(TextTop);
      Inc(TextLeft);
    end;

    ButtonItem := TButtonGroup(Sender).Items.Items[Index];

    TextOffset := 0;

    { Draw the icon  - if you need to display icons}

//    if (FImages <> nil) and (ButtonItem.ImageIndex > -1) and
//        (ButtonItem.ImageIndex < FImages.Count) then
//    begin
//      ImgTop := Rect.Top + (RectHeight - FImages.Height) div 2;
//      if ImgTop < Rect.Top then
//        ImgTop := Rect.Top;
//      if bdsDown in State then
//        Inc(ImgTop);
//      FImages.Draw(Canvas, TextLeft - 1, ImgTop, ButtonItem.ImageIndex);
//      TextOffset := FImages.Width + 1;
//    end;


    { Show insert indications }

    if [bdsInsertLeft, bdsInsertTop, bdsInsertRight, bdsInsertBottom] * State <> [] then
    begin
      Canvas.Brush.Color := clSkyBlue;
      InsertIndication := Rect;
      if bdsInsertLeft in State then
      begin
        Dec(InsertIndication.Left, 2);
        InsertIndication.Right := InsertIndication.Left + 2;
      end
      else if bdsInsertTop in State then
      begin
        Dec(InsertIndication.Top);
        InsertIndication.Bottom := InsertIndication.Top + 2;
      end
      else if bdsInsertRight in State then
      begin
        Inc(InsertIndication.Right, 2);
        InsertIndication.Left := InsertIndication.Right - 2;
      end
      else if bdsInsertBottom in State then
      begin
        Inc(InsertIndication.Bottom);
        InsertIndication.Top := InsertIndication.Bottom - 2;
      end;
      Canvas.FillRect(InsertIndication);
      //Canvas.Brush.Color := FillColor;
    end;

    if gboShowCaptions in TButtonGroup(Sender).ButtonOptions then
    begin
      { Avoid clipping the image }
      Inc(TextLeft, TextOffset);
      TextRect.Left := TextLeft;
      TextRect.Right := Rect.Right - 1;
      TextRect.Top := TextTop;
      TextRect.Bottom := Rect.Bottom -1;
      Text := ButtonItem.Caption;
      Canvas.TextRect(TextRect, Text, [tfEndEllipsis]);
    end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MBitmap := TBitmap.Create;
  try
  MBitmap.LoadFromFile('bg.bmp');
  except
    on E : Exception do
      ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
  end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MBitmap.Free;
end;

DFM：

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 398
  ClientWidth = 287
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  StyleElements = []
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    AlignWithMargins = True
    Left = 5
    Top = 5
    Width = 137
    Height = 388
    Margins.Left = 5
    Margins.Top = 5
    Margins.Right = 5
    Margins.Bottom = 5
    Align = alLeft
    BevelKind = bkFlat
    BevelOuter = bvNone
    Color = clWhite
    ParentBackground = False
    TabOrder = 0
    StyleElements = [seFont]
    object ButtonGroup1: TButtonGroup
      AlignWithMargins = True
      Left = 4
      Top = 4
      Width = 125
      Height = 378
      Margins.Left = 4
      Margins.Top = 4
      Margins.Right = 4
      Margins.Bottom = 2
      Align = alClient
      BevelInner = bvNone
      BevelOuter = bvNone
      BorderStyle = bsNone
      ButtonOptions = [gboFullSize, gboGroupStyle, gboShowCaptions]
      DoubleBuffered = True
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Segoe UI'
      Font.Style = []
      Items = <
        item
          Caption = 'General'
        end
        item
          Caption = 'Display'
        end
        item
          Caption = 'Proofing'
        end
        item
          Caption = 'Save'
        end
        item
          Caption = 'Language'
        end
        item
          Caption = 'Advanced'
        end>
      ParentDoubleBuffered = False
      TabOrder = 0
      OnDrawButton = ButtonGroup1DrawButton
    end
  end
end

那里有一个 Panel 容器托管 TButtonGroup，它不是必需的，只是为了视觉改进而添加。

如果您想在运行时更改选择的颜色，那么我建议使用efg 的 Hue/Saturation 方法来更改图像的色调，这样颜色面板会保留但颜色会改变。

要获得对 VCL 样式的支持，只需将 ButtonGroup1DrawButton 事件从 TButtonGroup 组件中分离出来，这样默认的 DrawButton 事件就可以启动，从而增加对它的支持。

Answer 2

您可以使用样式设置为 lbOwnerDrawFixed（如果间距的大小不重要）或 lbOwnerDrawVariable（如果是）的 TListBox。

然后，您可以相应地处理 OnDrawItem 和 OnMeasureItem。

使用 clWindow 不会有问题，但是 AFAIK 橙色不是 Windows 主题的一部分，但是您可以通过从 clHighlight 开始，然后应用色调偏移，然后为阴影进行亮度偏移来获得与主题匹配的东西。

如果您的色调变化是恒定的，它会自动适应主题颜色。

示例代码（橙色没有 HueShift）：放置一个 TListBox，设置 lbOwnerDrawFixed，将 ItemHeight 调整为 28，将字体设置为“Segoe UI”并使用以下 OnDrawItem

var
   canvas : TCanvas;
   txt : String;
begin
   canvas:=ListBox1.Canvas;
   canvas.Brush.Style:=bsSolid;
   canvas.Brush.Color:=clWindow;
   canvas.FillRect(Rect);
   InflateRect(Rect, -2, -2);
   if odSelected in State then begin
      canvas.Pen.Color:=RGB(194, 118, 43);
      canvas.Brush.Color:=RGB(255, 228, 138);
      canvas.RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, 6, 6);
      canvas.Pen.Color:=RGB(246, 200, 103);
      canvas.RoundRect(Rect.Left+1, Rect.Top+1, Rect.Right-1, Rect.Bottom-1, 6, 6);
   end;
   canvas.Font.Color:=clWindowText;
   canvas.Brush.Style:=bsClear;
   txt:=ListBox1.Items[Index];
   Rect.Left:=Rect.Left+10;
   canvas.TextRect(Rect, txt, [tfLeft, tfSingleLine, tfVerticalCenter]);
end;

如果你要拥有多个这样的组件，当然最好只继承 TListBox，如果你想为 RoundRect 进行抗锯齿，可以使用 GR32 或 GDI+。

请注意，为了与 XP 向后兼容，“Segoe UI”字体应该动态设置，因为它在 XP 中不可用（在 XP 中“Arial”是一个很好的后备，“Tahoma”看起来更接近但不能保证在那里）

Answer 3

我们为此外观使用TMS Control 的Advanced Poly Pager 。我强烈推荐它。这是一组非常强大且灵活的控件。具体来说，我们TAdvPolyList用于 Office 风格的对话框，并对配色方案进行了一些自定义调整。（请注意，这与它们TAdvOfficePager看起来不太一样好。不要意外地将两者混为一谈！）

它允许您：

• 左侧有一个类别选择器
• 是一个页面控件，所以很容易把你的控件放在右边的页面上（和普通的页面控件一样）
• 显示选项卡和页面之间的视觉链接，这是您提供的 Word 屏幕截图所没有的（Word 之间有障碍；此控件没有。它是一个更好、更直观且链接良好的 UI 设计。）
• 如果你愿意，肯定会允许你使用像 clWindow 这样的颜色常量，尽管任何东西都会
• 左侧面板中有各种各样的项目，包括图像、带有图像的文本、链接等。您的 Word 屏幕截图有细微的灰色分隔线分隔一些元素；我相信您也可以使用此控件执行此操作，而可靠地使用海报给出的其他一些答案会更棘手，例如自定义绘画 TListBox。
• 看起来很棒！

他们网站上的图像并没有真正完美地展示如何模仿 Office 外观，但是从这两个屏幕截图（他们网站上的高分辨率）中，您应该能够看到您可以实现的目标：

和

我们的菜单看起来类似于第二个屏幕截图，但带有简单的文本项（没有复杂的复选框和图像等 - 我认为他们放在那里只是为了证明你可以）并使用更像你的配色方案，另外我们添加了蓝色每个页面的标题。

我们几年前买了它，从未后悔过。强烈推荐。

Answer 4

我原以为您可以使用两件事：右侧部分的页面控件。对于左侧的部分，我认为您有几个选项，主要可能是使用 1 列和速度按钮的 GridLayout。

不是特别难，就是有点乱。您可能可以使用框架来包含按钮部分。

唯一困难的一点是分隔条，但也许您可以通过对其进行子类化并具有特定属性来做到这一点。

问候，

一个