I want to change the global colour of input sliders reactively.

I know you can change colours with chooseSliderSkin (in the shinyWidgets package) which edits the CSS. This works if the call to chooseSliderSkin is in the UI section but I'm not sure how to move it to the server side so it can see the input value for the colour I want to change it to.

When I run the code below, the "Flat" skin is not applied, the bars are a strange colour (but the labels are the right colour?) and the change only happens once.

library(shinydashboard)
library(shiny)
library(shinyWidgets)

ui <- dashboardPage(
  dashboardHeader(
    title = "Title"),
  dashboardSidebar(
    radioGroupButtons(
      inputId = "switch",
      choices = c("Red"="true", "Blue"="false"),
      justified=TRUE
    ),
    sliderInput("abc", "abc", 0, 1, .5, .1),    
    sliderInput("def", "def", 0, 1, .5, .1)    
  ),
  
  dashboardBody( 
    uiOutput("slidercols")
  )
)

server <- function(input, output) {
  output$slidercols <- renderUI({
    chooseSliderSkin(skin="Flat", ifelse(input$switch=="true", "red", "blue"))
  }) 
}

shinyApp(ui, server)

This is how chooseSliderSkin is meant to work (and it does but is obviously unreactive):

library(shinydashboard)
library(shiny)
library(shinyWidgets)

ui <- dashboardPage(
  dashboardHeader(
    title = "Title"),
  dashboardSidebar(
    radioGroupButtons(
      inputId = "switch",
      choices = c("Red"="true", "Blue"="false"),
      justified=TRUE
    ),
    sliderInput("abc", "abc", 0, 1, .5, .1),    
    sliderInput("def", "def", 0, 1, .5, .1)  
  ),
  
  dashboardBody( 
    chooseSliderSkin(skin="Flat", "red")
  )
)

server <- function(input, output) { 
}

shinyApp(ui, server)

CodePudding user response：

Works by modifying the function:

myChooseSliderSkin <- function(skin = c(
  "Shiny", "Flat", "Big", "Modern", "Sharp", "Round", "Square",
  "Nice", "Simple", "HTML5"
), color = NULL) {
  skin <- match.arg(arg = skin)
  if(packageVersion("shiny") > "1.5.0.9000" && 
     skin %in% c("Nice", "Simple", "HTML5")) {
    warning(paste0(
      "Skin '", skin,
      "' is deprecated, please see ", 
      "http://ionden.com/a/plugins/ion.rangeSlider/skins.html ",
      "for available ones."
    ))
    skin <- "Flat"
  }
  cssColor <- NULL
  if (!is.null(color)) {
    stopifnot(length(color) == 1)
    if (skin %in% c("Shiny", "Modern", "HTML5")) {
      cssColor <- tags$style(
        sprintf(
          ".irs-bar-edge, .irs-bar, .irs-single, .irs-from, .irs-to {background: %s !important;}",
          color
        ),
        if (skin == "Modern") {
          sprintf(
            ".irs-from:after, .irs-to:after, .irs-single:after {border-top-color: %s !important;}",
            color
          )
        },
        if (skin == "Modern") {
          sprintf(
            ".irs-from:before, .irs-to:before, .irs-single:before {border-top-color: %s !important;}",
            color
          )
        }
      )
    } else if (skin == "Flat") {
      asb_ <- shinyWidgets:::asb("#ed5565", color)
      angle <- asb_[1]
      saturate <- asb_[2]
      brightness <- asb_[3]
      colImg <- paste0(
        ".irs-bar-edge, .irs-bar, .irs-single:after, .irs-from:after, .irs-to:after, .irs-slider",
        " {",
        "-webkit-filter: hue-rotate(", angle, "deg) saturate(",
        saturate, "%) brightness(", brightness, "%); ",
        "filter: hue-rotate(", angle, "deg) saturate(",
        saturate, "%) brightness(", brightness, "%);",
        "}"
      )
      cssColor <- tags$style(
        colImg,
        HTML(paste(
          ".irs-single, .irs-from, .irs-to, .irs-handle>i:first-child",
          sprintf(
            "{background: %s !important;}", color
          )
        )),
        HTML(paste(
          ".irs-single:before, .irs-from:before, .irs-to:before",
          sprintf(
            "{border-top-color: %s !important;}", color
          )
        ))
      )
    }
  }
  if (packageVersion("shiny") > "1.5.0.9000") {
    tagList(
      cssColor,
      htmltools::htmlDependency(
        name = "ionrangeslider-skin",
        version = packageVersion("shinyWidgets"),
        package = "shinyWidgets",
        src = c(href = "shinyWidgets/ion-rangeslider", file = "assets/ion-rangeslider"),
        script = c("jquery.initialize.min.js", "custom-skin.js"),
        stylesheet = "ion.rangeSlider.min.css",
        head = sprintf(
          "<script type='custom-slider-skin'>{\"name\":\"%s\"}</script>", 
          tolower(skin)
        )
      )
    )
  } else {
    tagList(
      cssColor,
      htmltools::attachDependencies(
        x = tags$div(),
        value = shinyWidgets:::sliderInputDep(skin),
        append = FALSE
      )
    )
  }
}

Then:

  output$slidercols <- renderUI({
    color <- ifelse(input$switch, "red", "blue")
    myChooseSliderSkin(skin = "Modern", color)
  })