Adjust TogglerBar button size in Mathematica

Question

Is it possible to adjust the size/font of the TogglerBar, so that they are all equally large in case of different name size.

The example below is the solution proposed by Belisarius for : "Can TogglerBar be used as multiple CheckBox in Mathematica ?"

I would like each Button to be equally sized.

Manipulate[Graphics[
{
{White, Circle[{5, 5}, r]},(*For Mma 7 compatibility*)
If[MemberQ[whatToDisplay, "I am a Circle"],
{Red, Circle[{5, 5}, r]}],
If[MemberQ[whatToDisplay, "and I am a very nice Square"], {Blue,
Rectangle[{5, 5}, {r, r}]}],
If[MemberQ[whatToDisplay, "Other"], {Black,
 Line[Tuples[{3, 4}, 2]]}]
},
PlotRange -> {{0, 20}, {0, 10}}
],
{{r, 1, Style["Radius", Black, Bold, 12]}, 1, 5, 1,
ControlType -> Slider,
ControlPlacement -> Top},  
Control@{{whatToDisplay, True,
Style["What", Black, Bold, 12]}, {"I am a Circle",
"and I am a very nice Square", "Other"},
ControlType -> TogglerBar,
Appearance -> "Horizontal",
ControlPlacement -> Top}]

EDIT : It is trully ugly in the code (if we can still call that a code) but looks good on display.

Answer 1

Mathematica 8 introduced Overlay which allows multiple expressions to be easily overlaid atop each other. Coupled with Invisible (from v6), we have all the necessary ingredients to easily synchronize all of the button sizes without resorting to counting spaces or pixels. The following code illustrates their use, with the relevant parts emphasized:

DynamicModule[{options, allLabels, size, pad}
, options =
    { "I am a Circle" -> {Red, Circle[{5, 5}, size]}
    , "and I am a very nice Square" -> {Blue, Rectangle[{5, 5}, {size, size}]}
    , "Other" -> {Black, Line[Tuples[{3, 4}, 2]]}
    }
; allLabels = options[[All, 1]]
; pad[label_] :=
    Overlay[Append[Invisible /@ allLabels, label], Alignment -> Center]
; Manipulate[
    Graphics[what /. options /. size -> r, PlotRange -> {{0, 20}, {0, 10}}]
  , {{r, 1, "Radius"}, 1, 5, 1}
  , {{what, {}, "What"}, # -> pad[#] & /@ allLabels, TogglerBar}
  ]
]

The definition:

pad[label_] :=
  Overlay[Append[Invisible /@ allLabels, label], Alignment -> Center]

defines a function that stacks all of the labels invisibly atop one another, and then puts the desired label visibly on top of that. The result is the desired label with enough whitespace on either side to accommodate any of the other labels.

The Manipulate statement uses pad to create the labels for the TogglerBar:

{{what, {}, "What"}, # -> pad[#] & /@ allLabels, TogglerBar}

Note that the labels are specified in the form value -> label to allow the values to retain their original form without the Overlay and Invisible specifiers added by pad.

Answer 2

This is a way, although not completely satisfactory because the Panel length is not automatically calculated. Let's call it a first approach ...

Manipulate[
 Graphics[{{White, Circle[{5, 5}, r]},(*For Mma 7 compatibility*)
   If[MemberQ[whatToDisplay, "I am a Circle"], {Red, Circle[{5, 5}, r]}], 
   If[MemberQ[whatToDisplay, "and I am a very nice Square"],
                                               {Blue, Rectangle[{5, 5}, {r, r}]}], 
   If[MemberQ[whatToDisplay, "Other"], {Black, Line[Tuples[{3, 4}, 2]]}]}, 
  PlotRange -> {{0, 20}, {0, 10}}],
  {{r, 1, Style["Radius", Black, Bold, 12]}, 1, 5, 1, ControlType -> Slider, 
                                                 ControlPlacement -> Top}, 


 Control@{{whatToDisplay, True, Style["What", Black, Bold, 12]}, 
           (# ->  Panel[#, ImageSize -> 150, FrameMargins -> 0, 
                           Background -> White, 
                           Alignment -> Center]) & /@ 
           {"I am a Circle",  "and I am a very nice Square", "Other"}, 
           ControlType -> TogglerBar,
           Appearance -> "Horizontal", 
           ControlPlacement -> Top}]

Edit

here you have a better approach, with automatic size calculation:

(* get the Image Size first*)
ley = {"I am a Circle", "and I am  Square", "Other"};
sZ = Max[Dimensions[ImageData[Rasterize[#][[1]]]][[2]] & /@ ley];

Manipulate[
 Graphics[
 {{White, Circle[{5, 5}, r]},(*For Mma 7 compatibility*)
   If[MemberQ[whatToDisplay, "I am a Circle"], 
                                     {Red, Circle[{5, 5}, r]}], 
   If[MemberQ[whatToDisplay, "and I am a very nice Square"],
                                     {Blue, Rectangle[{5, 5}, {r, r}]}], 
   If[MemberQ[whatToDisplay, "Other"], 
                                     {Black, Line[Tuples[{3, 4}, 2]]}]}, 
  PlotRange -> {{0, 20}, {0, 10}}],

 (*Controls Follow *)

 {{r, 1, Style["Radius", Black, Bold, 12]}, 1, 5, 1, 
    ControlType      -> Slider, 
    ControlPlacement -> Top }, 

  Control@{{whatToDisplay, True, Style["What", Black, Bold, 12]},
    (# -> Panel[#, ImageSize    -> sZ, 
                   FrameMargins -> 0, 
                   Background   -> White, 
                   Alignment    -> Center]) & /@ ley,
     ControlType      -> TogglerBar, 
     Appearance       -> "Horizontal", 
     ControlPlacement -> Top}]

Answer 3

Mathematica may have an option somewhere to do this, but I don't know it. So, here is a proposed solution: First, this pads a string left and right so that it is of length n:

  Clear[strpad];
strpad[str_String, n_] := Module[
{strlength, exc, excr},
    strlength = StringLength@str;
    exc = Floor[(n - strlength)/2];
    excr = n - strlength - exc;
    StringJoin[
        Table[" ", {i, exc}],
        str,
        StringJoin[Table[" ", {i, excr}]]]]

Then, modify your program so that either you use these padded strings or add a Rule[#, strpad[#, 30]] & /@ immediately before {"I am a Circle", "and I am a very nice Square", "Other"}, so that your code becomes

 Manipulate[
   Graphics[{{White, Circle[{5, 5}, r]},(*For Mma 7 compatibility*)
 If[MemberQ[whatToDisplay, "I am a Circle"], {Red, 
 Circle[{5, 5}, r]}], 
  If[MemberQ[whatToDisplay, "and I am a very nice Square"], {Blue, 
 Rectangle[{5, 5}, {r, r}]}], 
  If[MemberQ[whatToDisplay, "Other"], {Black, 
 Line[Tuples[{3, 4}, 2]]}]}, 
 PlotRange -> {{0, 20}, {0, 10}}], {{r, 1, 
  Style["Radius", Black, Bold, 12]}, 1, 5, 1, ControlType -> Slider, 
 ControlPlacement -> Top}, 
Control@{{whatToDisplay, True, Style["What", Black, Bold, 12]}, 
  Rule[#, strpad[#, 30]] & /@ {"I am a Circle", "and I am a very nice Square", "Other"},ControlType -> TogglerBar, Appearance -> "Horizontal", 
 ControlPlacement -> Top}]