我想改变输入滑块的全局颜色。
我知道你可以用chooseSliderSkin来改变颜色(在shinyWidgets包中),它可以编辑CSS。如果对chooseSliderSkin的调用位于UI部分,但我不知道如何将其移动到服务器端,这样它就可以看到要将其更改为的颜色的输入值。
当我运行下面的代码时,没有应用“平面”皮肤,这些条是奇怪的颜色(但是标签是正确的颜色吗?)这种变化只发生过一次。
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)
这就是chooseSliderSkin的工作方式(它确实如此,但显然是没有反应的):
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)
希望有一种方法能够将此解决方案推广到其他类似的CSS更改函数中,这些功能都是在UI中进行的。
发布于 2022-07-13 09:01:47
通过修改函数来工作:
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
)
)
}
}
然后:
output$slidercols <- renderUI({
color <- ifelse(input$switch, "red", "blue")
myChooseSliderSkin(skin = "Modern", color)
})
https://stackoverflow.com/questions/72959533
复制相似问题