R 展开/折叠标题上的发光框单击

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

    ## 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
      )
    }

##仅在交互式R会话中运行此示例
if（interactive（））{
图书馆（闪亮）
#具有一行信息框和值框以及两行框的仪表板主体
body使用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
  )
}

##仅在交互式R会话中运行此示例
if（interactive（））{
图书馆（闪亮）
#折叠框的javascript代码
jscode您可以使用几行外部css和javascript对应用程序中的所有框执行此操作

当你点击标题时，JS会触发点击小部件。它必须是h3元素，因为小部件位于.box标题内，这将导致无限递归

$('.box').on('click', '.box-header h3', function() {
    $(this).closest('.box')
           .find('[data-widget=collapse]')
           .click();
});

但是我们需要让h3元素填充完整的.box标题，所以去掉标题填充（右边除外），将其添加到h3中，并使h3填充100%的方框宽度

.box-header {
  padding: 0 10px 0 0;
}
.box-header h3 {
  width: 100%;
  padding: 10px;
}

我认为Lisa DeBruine的答案更好，因为你可以点击整个标题，而不仅仅是标题

将其粘贴到一个小示例中：

if (interactive()) {
  body <- dashboardBody(
    useShinyjs(),
    
      tags$style(HTML("
      .box-header {
        padding: 0 10px 0 0;
      }
      .box-header h3 {
        width: 100%;
        padding: 10px;
      }")),
    
      fluidRow(
        box(id="box1", title = "Histogram box title",
            status = "warning", solidHeader = TRUE, collapsible = T,
            plotOutput("plot", height = 250)
        )
      )
    )
  
    server <- function(input, output) {
    
      output$plot <- renderPlot({
        hist(rnorm(50))
      })
    
      runjs("
      $('.box').on('click', '.box-header h3', function() {
          $(this).closest('.box')
                 .find('[data-widget=collapse]')
                 .click();
      });")
    }
  
  shinyApp(
    ui = dashboardPage(
      dashboardHeader(),
      dashboardSidebar(),
      body
    ),
    server = server
  )
}

if（交互式（））{
首先，感谢您的回复，这肯定有帮助。但它的行为有点奇怪。在我的应用程序中，我的侧边栏面板中有两个主框，每个框都有3个子框，其中包含不同的输入。将示例1应用到我的所有框中，第一个主框及其相应的子框工作正常，但不是我没有为第二个主框及其子框工作。我已经检查了所有内容，代码似乎到处都很好。你知道它是如何发生的吗？我不能在这里分享我的原始代码，但会尝试放置一个类似的例子。很高兴这很有帮助…！！关于你的新问题，代码只为一个主框工作…我能做的一切建议现在就请对以下两件事进行交叉检查：-1）如果您正确地包含了ShinyJS。2）如果所有的盒子ID都不同……如果它仍然不起作用，请创建一个可重用的示例……此外，如果它解决了您的目的……请接受/投票决定答案，以帮助他人解决问题……先生，您是对的，我搞砸了有了IDs，我已经纠正了它，它工作得非常好。再次感谢。我已经对答案进行了投票，但由于我是stackOverflow新手，没有达到要求的声誉分数，所以上面没有反映。但是非常感谢。很高兴我能帮上忙…！！因为这是你的问题，你可以接受答案。你只需要标记一个答案正确无误（单击绿色复选框图像）。有关说明，请参阅此链接（）