Shinydashboard custom box colors to match brand


#1

I'm starting to build out a new shinydashboard and I'm creating a template that follows our company brand. I'm wanting to add additional background color options to the boxes that are our brand colors, i.e. "bg-company-red" and "bg-company-yellow". In the shinydashboard code for box it only allows validColors, so I can't just use my own tags and add the css for it.

My two options seem to be:

  1. Override the css for the validColors, but I don't like this because I'd like to share this with others in the company and if they happen to use some of the validColors they would get a color they don't expect if they loaded my css.
  2. Create a local copy of the box function that doesn't check for validColors so I can create my own background color tags. This isn't great for maintenance purposes.

I understand including the validColor check for the status tags because there are only so many statuses, but is it really needed for the background color? The default colors provide a nice color palette but it limits anyone that wants to easily customize their boxes. Is there something I'm missing? An easier solution?

#this is what I wanted to do (the corresponding css would be in a css file loaded to my app)
box(title = "test", background = "company-red", solidHeader = TRUE,
        collapsible = TRUE, plotOutput(ns("plot1")))

#I would have to do this and override the default css for bg-red
box(title = "test", background = "red", solidHeader = TRUE,
        collapsible = TRUE, plotOutput(ns("plot1")))

Here's the link to the box code on github for reference, the chunk of box code also below: https://github.com/rstudio/shinydashboard/blob/master/R/boxes.R

box <- function(..., title = NULL, footer = NULL, status = NULL,
                solidHeader = FALSE, background = NULL, width = 6,
                height = NULL, collapsible = FALSE, collapsed = FALSE) {

  boxClass <- "box"
  if (solidHeader || !is.null(background)) {
    boxClass <- paste(boxClass, "box-solid")
  }
  if (!is.null(status)) {
    validateStatus(status)
    boxClass <- paste0(boxClass, " box-", status)
  }
  if (collapsible && collapsed) {
    boxClass <- paste(boxClass, "collapsed-box")
  }
  if (!is.null(background)) {
    validateColor(background)
    boxClass <- paste0(boxClass, " bg-", background)
  }

  style <- NULL
  if (!is.null(height)) {
    style <- paste0("height: ", validateCssUnit(height))
  }

  titleTag <- NULL
  if (!is.null(title)) {
    titleTag <- h3(class = "box-title", title)
  }

  collapseTag <- NULL
  if (collapsible) {
    buttonStatus <- status %OR% "default"

    collapseIcon <- if (collapsed) "plus" else "minus"

    collapseTag <- div(class = "box-tools pull-right",
      tags$button(class = paste0("btn btn-box-tool"),
        `data-widget` = "collapse",
        shiny::icon(collapseIcon)
      )
    )
  }

  headerTag <- NULL
  if (!is.null(titleTag) || !is.null(collapseTag)) {
    headerTag <- div(class = "box-header",
      titleTag,
      collapseTag
    )
  }

  div(class = if (!is.null(width)) paste0("col-sm-", width),
    div(class = boxClass,
      style = if (!is.null(style)) style,
      headerTag,
      div(class = "box-body", ...),
      if (!is.null(footer)) div(class = "box-footer", footer)
    )
  )
}

#2

Yeah, I'm also very curious about this. Don't want to get my wrist slapped by the internal branding police...


#3

I think the best option is to create your own box function that doesn't check for valid colours. May not be ideal for maintenance but it will require you to add your custom company colour classes to the app's ccs anyway so there has to be some customisation from the default regardless.

If you don't want to add to the default css, you can create a function that explicitly asks for primary and background colour of the box like the one below.

The function will allow you to supply any colour of your choosing for both the text and the background of the box via the color and background arguments respectively.

I haven't tested it thoroughly but you will have to supply a valid css color name, hex code, rgb code etc, for both color and background for it to work.

If you're going to be using the same colour schemes a lot you could set defaults to the function arguments like color = "white", background = "#company-red-hex-code"

myBox <- function(..., title = NULL, footer = NULL, status = NULL,
                solidHeader = FALSE, color, background, width = 6,
                height = NULL, collapsible = FALSE, collapsed = FALSE) {
  
  boxClass <- "box"
  if (solidHeader || !is.null(background)) {
    boxClass <- paste(boxClass, "box-solid")
  }
  if (!is.null(status)) {
    validateStatus(status)
    boxClass <- paste0(boxClass, " box-", status)
  }
  if (collapsible && collapsed) {
    boxClass <- paste(boxClass, "collapsed-box")
  }
  
  style <-paste0("color: ", color, "; background-color: ", background, ";")
  if (!is.null(height)) {
    style <- paste0(style, " height: ", validateCssUnit(height))
  }
  
  titleTag <- NULL
  if (!is.null(title)) {
    titleTag <- h3(class = "box-title", title)
  }
  
  collapseTag <- NULL
  if (collapsible) {
    buttonStatus <- status %OR% "default"
    
    collapseIcon <- if (collapsed) "plus" else "minus"
    
    collapseTag <- div(class = "box-tools pull-right",
                       tags$button(class = paste0("btn btn-box-tool"),
                                   `data-widget` = "collapse",
                                   shiny::icon(collapseIcon)
                       )
    )
  }
  
  headerTag <- NULL
  if (!is.null(titleTag) || !is.null(collapseTag)) {
    headerTag <- div(class = "box-header", 
                     style = paste0("color: ", color, ";"),
                     titleTag,
                     collapseTag
    )
  }
  
  div(class = if (!is.null(width)) paste0("col-sm-", width),
      div(style = style,
          headerTag,
          div(class = "box-body", ...),
          if (!is.null(footer)) div(class = "box-footer", footer)
      )
  )
}

#4

Hi,

I did not have the time to look into this, but maybe this could help you:


#5

I adapted the above for value boxes. Couldn't figure out how to use tagAssert even with the shinydashboard function loaded, so I just commented it out for now.

I'm not very good at css, so if you would change anything, please let me know. Seems to work as intended though.

customValueBox <- function (value, subtitle, icon = NULL, color, background, width = 4, href = NULL) 
{
  #validateColor(color)
  #if (!is.null(icon)) 
  #tagAssert(icon, type = "i")

  style <- paste0("color: ", color, "; background-color: ", background, ";")

  boxContent <- div(class = "small-box", style = style, 
                    div(class = "inner", h3(value), p(subtitle)), if (!is.null(icon)) 
                      div(class = "icon-large", icon))
  if (!is.null(href)) 
    boxContent <- a(href = href, boxContent)
  div(class = if (!is.null(width)) 
    paste0("col-sm-", width), boxContent)
}