1

I'm trying to modify the color border of valueBox with the hex color code (e.g., '#12ff34') format. How does one access and set such value?

In the three valueBoxes below (shorter and modified version of the example found in 'help('box')'), how does one specify that the first should have, say, a red border, the second a black border, and the third a yellow border?

Thanks

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
)
PLA
  • 89
  • 1
  • 7

1 Answers1

1

We can use htmltools::tagQuery to achive this - here are a few options on how to apply it:

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
)
ismirsehregal
  • 30,045
  • 5
  • 31
  • 78