1

Is there any option to customize the Slider tracker to an image or a Graphics object? What about simply changing its colour? For instance, get the change

enter image description here

I know about using Appearance to get "UpArrow" or "DownArrow", but not sure if it's possible to fully customize the appearance. I'm using version 12.3 on Windows 10. Any ideas?

Edit: I'm now aware of this approach. However, I'm also interested in a slider on which I'm able to apply Appearance -> "Labeled" and make it so it's editable (like in the normal Slider). Therefore I still need an alternative or an extended version of that approach.

sam wolfe
  • 4,663
  • 7
  • 37
  • HorizontalGauge can give you more flexibility here. – Dan Oak Jul 08 '21 at 17:18
  • @flinty I think not quite, since I don't know how to apply Appearance -> "Labeled" in that slider and make it so it's editable (like in the normal Slider). I will edit the question and make that clear. – sam wolfe Jul 09 '21 at 08:20
  • @samwolfe you can't - Mathematica has no api for editing a Slider beyond what you've already mentioned in Appearance. The head of Slider isn't Graphics. – flinty Jul 09 '21 at 09:05
  • @flinty You mean the slider function in István's answer in the linked question, not the inbuilt Slider, right? I can use Appearance -> "Labeled" on Slider and get the current value on the righ-side, which is itself editable (see Slider[1, Appearance -> "Labeled"] for example). All I need to do is to adapt István's answer to include the editable label. – sam wolfe Jul 09 '21 at 13:41

1 Answers1

1
ClearAll[labeledSlider]

Options[labeledSlider] = {"lineStyle" -> Directive[AbsoluteThickness@6, Black], 
   "thumbAppearance" -> Graphics[{EdgeForm@{Thick, Black}, White, Disk[]}, 
     ImageSize -> 20, AspectRatio -> 1]};

labeledSlider[Dynamic[var_], {min_, max_}, head_: Identity, 
  opts : OptionsPattern[{labeledSlider, Graphics}]] := 
 DynamicModule[{y = Mean[{min, max}]}, 
  Style[head@ Grid[{{Graphics[{CapForm@"Round", OptionValue["lineStyle"], 
         Line[{{-1, 0}, {1, 0}}], 
         Locator[Dynamic[{y, 0}, (y = Clip[First@#, {-1, 1}]; 
             var = Rescale[y, {-1, 1}, {min, max}]) &], 
          OptionValue["thumbAppearance"]]}, 
        FilterRules[{opts}, Options @ Graphics],
        ImageSize -> {300, 30}, AspectRatio -> .1, PlotRangePadding -> .1], 
       InputField[Dynamic[var, 
           (var = #; y = Rescale[#, {min, max}, {-1, 1}]) &], 
         Appearance -> "Frameless", ContinuousAction -> True, 
         DefaultBaseStyle -> "LabeledSlider", 
         FieldSize -> {{5, 10}, {1, 2}}, ImageMargins -> 0]}}, 
     AutoDelete -> False, 
     ItemSize -> {"Columns" -> {{Automatic}}, "Rows" -> {{Automatic}}}, 
     Spacings -> 1, 
     BaselinePosition -> {{1, 1}, Axis}], 
   Deployed -> True, 
   FontFamily :> CurrentValue["ControlsFontFamily"]]]

Examples:

{labeledSlider[Dynamic @ x, {-100, 100}], Dynamic @ x}

enter image description here

{labeledSlider[Dynamic @ x, {-100, 100}, 
  Panel[#, Background -> LightBlue] &], Dynamic @ x}

enter image description here

{labeledSlider[Dynamic @ x, {-100, 100}, 
   "thumbAppearance" -> Graphics[{EdgeForm@{Thick, Red}, Yellow, Rectangle[]}, 
    ImageSize -> 20, AspectRatio -> 1]], 
  Dynamic @ x}

enter image description here

{labeledSlider[Dynamic@x, {-100, 100}, 
    ImageSize -> Large, 
    "lineStyle" -> Directive[AbsoluteThickness@.1, Orange], 
    "thumbAppearance" -> Graphics[{EdgeForm@None, Blue, 
       Triangle[{{0, 0}, {1, 0}, {.5, -1}}]}, ImageSize -> 20]], 
  Dynamic @ x}

enter image description here

kglr
  • 394,356
  • 18
  • 477
  • 896
  • Brilliant! Is it somehow possible to keep the slider on the right (or left) whenever the input values exceeds (or undervalues) the limits? Similar to the original Slider. – sam wolfe Jul 09 '21 at 20:42