How to simulate Word 2010-style Options category selector

Question

The Options dialog in Word 2010 implements the category selector via set of white "toggle" buttons that become orange when clicked (selected).

How would one re-implement such behavior in Delphi? A conformance with the current Windows theme is required (i.e. it must be possible to specify the button color as clWindow, not clWhite).

EDIT: To clarify - I only have problems with the category selector on the left. Everything else is fairly simple.

Answer 1

You could use the TButtonGroup component.

Using VCL Styles is by far the easiest solution but as like you said, using styles in XE2 is quite uncomfortable, in my opinion this feature only really became viable in XE3.

Per your request to use the default painting methods I'm submitting my solution,

source code of the project available here.

This project requires an image, the image is zipped together with the project.

Compiled and tested in 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

There is a Panel container in there hosting the TButtonGroup, it is not needed, simply added for visual improvement.

If you want to change the color of the selection at runtime then I suggest using efg's Hue/Saturation method to change the Hue of the image, that way the color panel remains but the color will change.

To gain support for VCL Styles simply detach the ButtonGroup1DrawButton Event from the TButtonGroup component, that way the default DrawButton Event can kick in which adds support for that.

Answer 2

You can use a TListBox with style set to lbOwnerDrawFixed (if the size of the spacing isn't important) or lbOwnerDrawVariable if it is.

You can then handle OnDrawItem & OnMeasureItem accordingly.

Using clWindow will be no problem, however AFAIK the orange color is not part of the Windows theme, but you can obtain something that will match the theme by starting from clHighlight and then applying a hue shift, then lightness shift for the shading.

If your hue shift is constant, it'll automatically adapt to the theme colors.

Sample code (without the HueShift for the orange): drop a TListBox, set lbOwnerDrawFixed, adjust ItemHeight to 28, set font to "Segoe UI" and use the following 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;

If you're going to have more than one such components, it's of course preferable to just subclass TListBox, and if you want anti-aliasing for the RoundRect, GR32 or GDI+ can be used.

Note that for backward compatibility with XP, "Segoe UI" font should be set dynamically, as it's not available in XP (in XP "Arial" is a good fallback, "Tahoma" looks closer but isn't guaranteed to be there)

Answer 3

We use TMS Control's Advanced Poly Pager for this look. I highly recommend it. It's a very powerful and flexible set of controls. Specifically, we use TAdvPolyList for our Office-style dialogs with some custom tweaking to the colour scheme. (Note this is different to their TAdvOfficePager which doesn't look nearly as good. Don't accidentally mix the two up!)

It allows you to:

• Have a category selector on the left
• Is a page control, so is easy to have your controls on pages on the right (the same as a normal page control)
• Shows a visual link between the tab and page, something the Word screenshot you provided doesn't do (Word has a barrier in-between; this control doesn't. It's a better, more intuitive and well-linked UI deisgn.)
• Will certainly allow you to use color constants like clWindow if you wish, though anything would
• Has a wide variety of items that can go in the left panel, including images, text with images, links, etc. Your Word screenshot has subtle gray dividing lines separating some of the elements; I'm sure you can do this with this control too, whereas it would be trickier to reliably do with some of the other answers posters have given, such as custom-painting TListBox.
• Looks great!

The images on their site don't really show perfectly how to mimic an Office look, but from these two screenshots (high-res on their site) you should be able to see the sort of things you can achieve:

and

Our menus look similar to the second screenshot but with simple text items (nothing complex like checkboxes and images etc - I think they've put those there just to demonstrate that you can) and uses a colour scheme more like yours, plus we added blue headers to each page.

We bought it a couple of years ago and have never regretted it. Highly recommended.