单击标题时展开/折叠闪亮框

Question

我开发了一个闪亮的应用程序，我们在用户界面中使用各种框对象。目前，通过单击框标题右侧的“+/-”符号来展开/折叠框，但我们需要单击标题（框标题上的任何位置）来展开/折叠。下面的代码（示例代码）如果您查看带有图表的框，我希望在单击标题时执行展开和折叠，即“直方图框标题”，而不仅仅是标题右侧的“+/-”符号：

    ## Only run this example in interactive R sessions
    if (interactive()) {
      library(shiny)

      # A dashboard body with a row of infoBoxes and valueBoxes, and two rows of boxes
      body <- dashboardBody(
        # Boxes
        fluidRow(
          box(title = "Histogram box title",
              status = "warning", solidHeader = TRUE, collapsible = TRUE,
              plotOutput("plot", height = 250)
          )
        )


      )

      server <- function(input, output) {

        output$plot <- renderPlot({
          hist(rnorm(50))
        })
      }

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

Answer 1

使用 javascript 可以轻松实现这一点。您只需创建一个 JavaScript 函数并在标头代码中调用相同的函数即可。请参阅下面的代码以更好地理解。我提供了 3 个选项，请告诉我这是否适合您。

## Only run this example in interactive R sessions
if (interactive()) {
  library(shiny)

# javascript code to collapse box
jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"

  # A dashboard body with a row of infoBoxes and valueBoxes, and two rows of boxes
  body <- dashboardBody(
    # Including Javascript
    useShinyjs(),
    extendShinyjs(text = jscode),
    # Boxes
    fluidRow(
      box(id="box1",title = actionLink("titleId", "Histogram box title",icon =icon("arrow-circle-up")), 
          status = "warning", solidHeader = TRUE, collapsible = T,
          plotOutput("plot", height = 250)
      ),
      box(id="box2",title = p("Histogram box title", 
                          actionButton("titleBtId", "", icon = icon("arrow-circle-up"),
                                       class = "btn-xs", title = "Update")), 
          status = "warning", solidHeader = TRUE, collapsible = T,
          plotOutput("plot1", height = 250)
      ),
      box(id="box3",title = actionButton("titleboxId", "Histogram box title",icon =icon("arrow-circle-up")), 
          status = "warning", solidHeader = TRUE, collapsible = T,
          plotOutput("plot2", height = 250)
      )
    )


  )

  server <- function(input, output) {

    output$plot <- renderPlot({
      hist(rnorm(50))
    })
    output$plot1 <- renderPlot({
      hist(rnorm(50))
    })
    output$plot2 <- renderPlot({
      hist(rnorm(50))
    })

    observeEvent(input$titleId, {
      js$collapse("box1")
    })
    observeEvent(input$titleBtId, {
      js$collapse("box2")
    })
    observeEvent(input$titleboxId, {
      js$collapse("box3")
    })
  }

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