Delphi 如何模拟Word 2010样式选项类别选择器

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

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

---

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

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

不太难，但有点乱。您可能需要一个框架来包含按钮部分

唯一困难的是分隔条，但也许您可以通过对其子类化并具有特定属性来实现

问候,

A

您可以使用该组件

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

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

该项目的源代码可用

此项目需要一个图像，图像与项目压缩在一起

在XE4中编译和测试

---

---

类型
TButtonGroup=类（Vcl.ButtonGroup.TButtonGroup）
受保护的
程序漆；推翻
结束；
TForm1=类（TForm）
按钮组1:TButtonGroup；
小组1：TPanel；
过程按钮Group1DrawButton（发送方：ToObject；索引：Integer；
画布：TCanvas；Rect:TRect；状态：TButtonDrawState）；
过程表单创建（发送方：ToObject）；
销毁程序表（发送方：TObject）；
私有的
{私有声明}
公众的
{公开声明}
结束；
变量
表1:TForm1；
MBitmap:TBitmap；
实施
{$R*.dfm}
程序TButtonGroup.Paint；
变量
R:TRect；
开始
继承；
R:=GetClientRect；
R.Top:=Self.Items.Count*Self.ButtonHeight；
{删除clBtnFace背景默认绘制}
Self.Canvas.FillRect（R）；
结束；
过程TForm1.ButtonGroup1DrawButton（发送方：ToObject；索引：Integer；
画布：TCanvas；Rect:TRect；状态：TButtonDrawState）；
变量
TextLeft，TextTop：整数；
矩形高度：整数；
ImgTop：整数；
文本：字符串；
text偏移量：整数；
ButtonItem:TGrpButtonItem；
插入指示：TRect；
DrawSkipLine:TRect；
TextRect:TRect；
OrgRect:TRect；
开始
//OrgRect:=Rect//偶像
Canvas.Font:=TButtonGroup（发送方）.Font；
如果在状态中选择了BDS，则开始
CopyRect（Rect，MBitmap.Canvas，
System.Classes.Rect（0，0，MBitmap.Width，MBitmap.Height））；
Canvas.Brush.Color:=RGB（255228138）；
结束
否则，如果处于热态，则
开始
Canvas.Brush.Color:=RGB（194221244）；
Canvas.Font.Color:=clBlack；
结束
其他的
Canvas.Brush.color:=clWhite；
如果没有（在状态中选择）
然后
Canvas.FillRect（Rect）；
充气（直肠，-2，-1）；
{计算文本位置}
TextLeft:=Rect.Left+4；
RectHeight:=Rect.Bottom-Rect.Top；
TextTop:=Rect.Top+（RectHeight-Canvas.TextHeight（'Wg'））第2部分；{不本地化}
如果TextTop-1）和
//（ButtonItem.ImageIndex

DFM：

对象格式1:t格式1
左=0
Top=0
标题='Form1'
ClientHeight=398
ClientWidth=287
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;

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

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;