无法在 Shiny 中更改 bs4Dash “深色”皮肤主题背景

Posted 2023-02-18

【中文标题】无法在 Shiny 中更改 bs4Dash “深色”皮肤主题背景

【英文标题】：Not able to change bs4Dash "dark" skin theme background in Shiny

【发布时间】：2021-05-30 09:19:18

【问题描述】：

您好，我正在玩 fresh 主题包和 bs4Dash。我要做的是更改应用程序的主要背景。但是，看起来包 bs4Dash 不会让我在选择“深色”主题时更改主背景。一旦我将切换开关切换到“浅色”皮肤，就会显示所需的背景颜色。看来我无法控制暗模式背景。

下面是一张照片以及可重现的代码。例如，我希望当皮肤被轻弹到深色模式时，背景颜色是下面代码中的浅蓝色。

library(bs4Dash)
library(shiny)
library(fresh)
# create the theme with a cyberpunk color palette
theme <- create_theme(
    bs4dash_vars(
        navbar_light_color = "#bec5cb",
        navbar_light_active_color = "#FFF",
        navbar_light_hover_color = "#FFF"
    ),
    bs4dash_yiq(
        contrasted_threshold = 10,
        text_dark = "#FFF",
        text_light = "#272c30"
    ),
    bs4dash_layout(
        main_bg = "#5E81AC"
    ),
    bs4dash_sidebar_light(
        bg = "#272c30",
        color = "#bec5cb",
        hover_color = "#FFF",
        submenu_bg = "#272c30",
        submenu_color = "#FFF",
        submenu_hover_color = "#FFF"
    ),
    bs4dash_status(
        primary = "#5E81AC", danger = "#BF616A", light = "#272c30"
    ),
    bs4dash_color(
        gray_900 = "#FFF", white = "#272c30"
    )
)

# create tribble for box global config
box_config <- tibble::tribble(
    ~background, ~labelStatus,
    "danger", "warning",
    "purple", "success",
    "success", "primary",
    "warning", "danger",
    "fuchsia", "info"
)

# box factory function
box_factory <- function(background, labelStatus) 
    box(
        title = "Cyberpunk Box",
        collapsible = TRUE,
        background = background,
        height = "200px",
        label = boxLabel(1, labelStatus)
    )


# pmap magic
boxes <- purrr::pmap(box_config, box_factory)

shinyApp(
    ui = dashboardPage(
        freshTheme = theme,
        header = dashboardHeader(
            leftUi = dropdownMenu(
                type = "messages",
                badgeStatus = "success",
                messageItem(
                    from = "Support Team",
                    message = "This is the content of a message.",
                    time = "5 mins"
                ),
                messageItem(
                    from = "Support Team",
                    message = "This is the content of another message.",
                    time = "2 hours"
                )
            )
        ),
        sidebar = dashboardSidebar(),
        body = dashboardBody(boxes),
        controlbar = dashboardControlbar(),
        title = "Fresh theming"
    ),
    server = function(input, output)  
)

【问题讨论】：

您好！尝试你的代码会导致我出错.. 里面是否提到了所有需要的包？

不是答案，但希望对您有所帮助.. ``` leftUi = tagList( dropdownMenu( type = "messages", badgeStatus = "success", messageItem( from = "Support Team", message = "这是一条消息的内容。", time = "5 mins" ), messageItem( from = "Support Team", message = "这是另一条消息的内容。", time = "2 hours" ) ) ) ```

我还必须在开始时添加 library(shinydashboardPlus) 才能获得一些东西..（但还不是你要找的东西，我担心..）

【参考方案1】：

鉴于可用的功能，我找不到或想办法根据需要设置暗模式背景颜色，但我承认我对这些包不太熟悉。

向fresh 提交有关此问题的问题可能会很有成效。

同时，这里有另一种方法，通过将另一个样式表注入应用程序来设置暗模式背景颜色。

library(bs4Dash)
library(shiny)
library(fresh)

# create the theme with a cyberpunk color palette
theme <- create_theme(
  bs4dash_vars(
    navbar_light_color = "#bec5cb",
    navbar_light_active_color = "#FFF",
    navbar_light_hover_color = "#FFF"
  ),
  bs4dash_yiq(
    contrasted_threshold = 10,
    text_dark = "#FFF",
    text_light = "#272c30"
  ),
  bs4dash_layout(
    main_bg = "#5E81AC"
  ),
  bs4dash_sidebar_light(
    bg = "#272c30",
    color = "#bec5cb",
    hover_color = "#FFF",
    submenu_bg = "#272c30",
    submenu_color = "#FFF",
    submenu_hover_color = "#FFF"
  ),
  bs4dash_status(
    primary = "#5E81AC", danger = "#BF616A", light = "#272c30"
  ),
  bs4dash_color(
    gray_900 = "#FFF", white = "#272c30"
  )
)

# create tribble for box global config
box_config <- tibble::tribble(
  ~background, ~labelStatus,
  "danger", "warning",
  "purple", "success",
  "success", "primary",
  "warning", "danger",
  "fuchsia", "info"
)

# box factory function
box_factory <- function(background, labelStatus) 
  box(
    title = "Cyberpunk Box",
    collapsible = TRUE,
    background = background,
    height = "200px",
    label = boxLabel(1, labelStatus)
  )


# pmap magic
boxes <- purrr::pmap(box_config, box_factory)

shinyApp(
  ui = dashboardPage(
    freshTheme = theme,
    header = dashboardHeader(
      ##### inject additional stylesheet here
      tags$style(html("
        .dark-mode .content-wrapper 
          background-color: #5E81AC;
        ")
      ),
      #####
      leftUi = dropdownMenu(
        type = "messages",
        badgeStatus = "success",
        messageItem(
          from = "Support Team",
          message = "This is the content of a message.",
          time = "5 mins"
        ),
        messageItem(
          from = "Support Team",
          message = "This is the content of another message.",
          time = "2 hours"
        )
      )
    ),
    sidebar = dashboardSidebar(),
    body = dashboardBody(boxes),
    controlbar = dashboardControlbar(),
    title = "Fresh theming"
  ),
  server = function(input, output)  
)