在 R/Shiny 中修改 valueBox 的颜色边框答案

【问题标题】：Modifying the color border of valueBox in R/Shiny在 R/Shiny 中修改 valueBox 的颜色边框
【发布时间】：2022-02-07 16:46:32
【问题描述】：

我正在尝试使用十六进制颜色代码（例如，'#12ff34'）格式修改 valueBox 的颜色边框。如何访问和设置这样的值？

在下面的三个 valueBoxes 中（'help('box')' 中示例的较短和修改版本），如何指定第一个应该有，比如说，一个红色边框，第二个应该有黑色边框，第三个是黄色边框？

谢谢

library(shiny)
library(shinydashboard)

# A dashboard body with a row of valueBoxes
body <- dashboardBody(
  
  # valueBoxes
  fluidRow(
    valueBox(
      uiOutput("orderNum"), "New Orders", icon = icon("credit-card")
    ),
    valueBox(
      tagList("60", tags$sup(style="font-size: 20px", "%")),
      "Approval Rating", icon = icon("line-chart"), color = "green"
    ),
    valueBox(
      htmlOutput("progress"), "Progress", icon = icon("users"), color = "purple"
    )
  )

)

server <- function(input, output) {
  output$orderNum <- renderText({
    x = 789
  })
  
  output$progress <- renderUI({
    tagList(8.90, tags$sup(style="font-size: 20px", "%"))
  })

}

shinyApp(
  ui = dashboardPage(
    dashboardHeader(),
    dashboardSidebar(),
    body
  ),
  server = server
)

【问题讨论】：

标签： css r shiny shinydashboard

【解决方案1】：

我们可以使用htmltools::tagQuery 来实现这一点 - 以下是一些关于如何应用它的选项：

library(shiny)
library(shinydashboard)
library(htmltools)

setBorderColor <- function(valueBoxTag, color){tagQuery(valueBoxTag)$find("div.small-box")$addAttrs("style" = sprintf("border-style: solid; border-color: %s; height: 106px;", color))$allTags()}

# A dashboard body with a row of valueBoxes
body <- dashboardBody(
  fluidRow(
    tagQuery(valueBox(
      uiOutput("orderNum"), "New Orders", icon = icon("credit-card")
    ))$find("div.small-box")$addAttrs("style" = "border-style: solid; border-color: #FF0000;")$allTags(),
    {vb2 <- valueBox(
      tagList("60", tags$sup(style="font-size: 20px", "%")),
      "Approval Rating", icon = icon("line-chart"), color = "green"
    )
    tagQuery(vb2)$find("div.small-box")$addAttrs("style" = "border-style: solid; border-color: #000000;")$allTags()
    },
    {vb3 <- valueBox(
      htmlOutput("progress"), "Progress", icon = icon("users"), color = "purple"
    )
    setBorderColor(vb3, "#FFFF00")},
    valueBoxOutput("vbox")
  )
  
)

myPalette <- colorRampPalette(c("red", "yellow", "green"))( 100 )

server <- function(input, output) {
  output$orderNum <- renderText({
    x = 789
  })
  
  output$progress <- renderUI({
    tagList(8.90, tags$sup(style="font-size: 20px", "%"))
  })
  
  output$vbox <- renderValueBox({
    invalidateLater(500)
    setBorderColor(valueBox(
      "Title",
      input$count,
      icon = icon("credit-card")
    ), sample(myPalette, 1))
  })
  
}

shinyApp(
  ui = dashboardPage(
    dashboardHeader(),
    dashboardSidebar(),
    body
  ),
  server = server
)

【讨论】：