CODEWITHSUNDEEP
javascriptcssrshinyshinydashboard
hartmut
hartmut

Reputation: 982

Shiny - dashboardPage - how can I add a button to box header

Using dashboardPage I made a dashboard made out of boxes.

I would like to be able to click somewhere on the header of a box to trigger some action. The only case I know where the header has a button is the case of expandable boxes. Would it be possible to generalize that so that, upon a click somewhere in the header of a box, some action is triggered?

My design goal is to have the info in the box update when the user clicks on this button, i.e., to have the content of the box change.

Thanks!

body <- dashboardBody(
  fluidRow(
    box(
      title = "Title 1", width = 4, solidHeader = TRUE, status = "primary",
      "Box content"
    ),
    box(
      title = "Title 1", width = 4, solidHeader = TRUE, status = "warning",
      "Box content"
    )
  )
)
# We'll save it in a variable `ui` so that we can preview it in the console
ui <- dashboardPage(
  dashboardHeader(title = "Row layout"),
  dashboardSidebar(),
  body
)
# Preview the UI in the console
shinyApp(ui = ui, server = function(input, output) { })

Upvotes: 5

Views: 4167

Answers (1)

Geovany
Geovany

Reputation: 5697

If you want a button in the right corner of the box header you could modify the original box function or you could use some JavaScript to add the button after the creation of the box.

An even simpler solution is to create a box title with an actionLink or with an actionButton. Bellow is a example for both cases. The first box has an actionLink as title, when the user clicks on it, the content of the box is updated. On the second box the title is created with plain text and with a small actionButton that will also update the box content. For the second box you could add some custom style to create a header of the same size of a normal box.

library(shiny)
library(shinydashboard)

body <- dashboardBody(
  fluidRow(
    box(
      title = actionLink("titleId", "Update", icon = icon("refresh")), 
      width = 4, solidHeader = TRUE, status = "primary",
      uiOutput("boxContentUI")
    ),
    box(
      title = p("Title 1", 
                actionButton("titleBtId", "", icon = icon("refresh"),
                  class = "btn-xs", title = "Update")
      ), 
      width = 4, solidHeader = TRUE, status = "warning",
      uiOutput("boxContentUI2")
    )
  )
)

ui <- dashboardPage(
  dashboardHeader(title = "Row layout"),
  dashboardSidebar(),
  body
)

server = function(input, output, session) { 
  output$boxContentUI <- renderUI({
    input$titleId
    pre(paste(sample(letters,10), collapse = ", "))
  }) 

  output$boxContentUI2 <- renderUI({
    input$titleBtId
    pre(paste(sample(LETTERS,10), collapse = ", "))
  })  
}

shinyApp(ui = ui, server = server)

Upvotes: 11

Related Questions