更改闪亮主题的色调 [英] Change the color tone of a shinytheme

问题描述

朋友们，可以更改使用的闪亮主题的色调吗？在我的例子中，我使用的是"United"，它使用橙色和灰色。不过，我想做一个稍微深一点的橙色，可以改一下吗？如果是的话，你能帮帮我吗？可执行代码如下。

library(shinyBS)
library(shiny)
library(shinyjs) 

ui <- fluidPage(
  navbarPage(theme = shinytheme("united"), collapsible = TRUE,
  titlePanel("Old Faithful Geyser Data"),

  sidebarLayout(
    sidebarPanel( 
      radioButtons("filter1", h3("Select properties"),
                   choices = list("All properties" = 1, 
                                  "Exclude properties" = 2),
                   selected = 1),
      title= "Select Proprierties",
      radioButtons("filter2", h3("Select farms"),
                   choices = list("All farms" = 1, 
                                  "Exclude farms" = 2),
                   selected = 1),
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 20,
                  value = 30),
      ## need to include at least one bs element, adapt
      bsTooltip("bins", "The wait times will be broken into this many equally spaced bins",
                "right", options = list(container = "body")) 

    ),

    mainPanel(
      plotOutput("distPlot")
    )
  )
))

## use JS to add an id attribute to the elements where you want to add the popover
add_id_js <- paste0(
  "$('#filter1').find('.radio > label').attr('id', function(i) {",
  "return 'filter1_row_' + i})")

server <- function(input, output, session) {
  ## once the UI is loaded, call JS function and attach popover to it
  session$onFlushed(function() {
    runjs(add_id_js)
    addPopover(session, "filter1_row_0", "My Popover", "Content")

  })


  output$distPlot <- renderPlot({
    # generate bins based on input$bins from ui.R
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)

    # draw the histogram with the specified number of bins
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

非常感谢各位朋友！！

推荐答案

我知道这是一个很老的问题，但由于没有答案，而且我也遇到了同样的问题，所以我想添加我找到的解决方案。

当我尝试对ShinyDashboard执行相同的操作时，我发现了这个post。但是，在了解fresh包的功能后，我找到了使用navBarPage解决问题的方法。

您只需将以下代码添加到您的代码中：

# This is to create your own theme. Depending on your needs, you can remove or keep some options.

mytheme <- create_theme(
  theme = "default",
  bs_vars_navbar(
    default_bg = "#75b8d1",
    default_color = "#FFFFFF",
    default_link_color = "#FFFFFF",
    default_link_active_color = "#75b8d1",
    default_link_active_bg = "#FFFFFF",
    default_link_hover_color = "firebrick"
  ),
  output_file = NULL
)

navbarPage(
  title = "Custom navbar",
  header = tagList(
    use_theme(mytheme) # <-- use your theme
  ),
  tabPanel("Tab 1"),
  tabPanel("Tab 2")
)

请注意，当我加载您的代码时，会收到以下警告：

警告消息：1：在liderInput()中：value应小于或 等于max(值=30，最大值=20)。2：导航容器 需要bslib::nav()/shiny::tabPanel()和/或的集合 bslib::nav_menu()/shiny::navbarMenu()。请考虑使用header或 footer如果希望将内容放在每个面板的上方(或下方) 内容。

所以，为了尝试我添加给您的代码，我修复了它们。

library(shinyBS)
library(shiny)
library(shinyjs) 
library(fresh)

# This is to modify the header background color. It uses fresh package.
mytheme <- create_theme(
  adminlte_color(
    light_blue = "#9d6708"
  )
)

mytheme <- create_theme(
  theme = "default",
  bs_vars_navbar(
    default_bg = "#9d6708",
  ),
  output_file = NULL
)


ui <- fluidPage(
  navbarPage( 
       title = "Old Faithful Geyser Data",
       
       collapsible = TRUE,
       header = tagList(
         use_theme(mytheme) # <-- use your theme
       ),
       
       tabPanel(
         
         title = "Tab 1", 
             sidebarLayout(
               sidebarPanel( 
                 
                 radioButtons("filter1", h3("Select properties"),
                              choices = list("All properties" = 1, 
                                             "Exclude properties" = 2),
                              selected = 1),
                 title= "Select Proprierties",
                 radioButtons("filter2", h3("Select farms"),
                              choices = list("All farms" = 1, 
                                             "Exclude farms" = 2),
                              selected = 1),
                 sliderInput("bins",
                             "Number of bins:",
                             min = 1,
                             max = 30,
                             value = 20),
                 ## need to include at least one bs element, adapt
                 bsTooltip("bins", "The wait times will be broken into this many equally spaced bins",
                           "right", options = list(container = "body")) 
                 
               ),
               
               mainPanel(
                 plotOutput("distPlot")
               )
             )
        ))
)

## use JS to add an id attribute to the elements where you want to add the popover
add_id_js <- paste0(
  "$('#filter1').find('.radio > label').attr('id', function(i) {",
  "return 'filter1_row_' + i})")

server <- function(input, output, session) {
  ## once the UI is loaded, call JS function and attach popover to it
  session$onFlushed(function() {
    runjs(add_id_js)
    addPopover(session, "filter1_row_0", "My Popover", "Content")
    
  })
  
  
  output$distPlot <- renderPlot({
    # generate bins based on input$bins from ui.R
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    
    # draw the histogram with the specified number of bins
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

我不知道您想要哪种橙色，但我更改为此色调#9d6708只是为了向您显示不同之处。

如果您要检查fresh程序包并使用NavbarPage，请查看更多info。

这篇关于更改闪亮主题的色调的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！