Question

我开发了一个闪亮的应用程序，我们在ui中使用各种box对象。目前，通过单击＆＃34; + / - ＆＃34;框展开/折叠;在标题栏的右侧签名，但我们需要点击标题（框标题上的任意位置）展开/折叠。下面的代码（示例代码）如果你看一下图表框，我想要扩展＆amp;单击标题时执行折叠，即＆＃34;直方图框标题＆＃34;而不只是＆＃34; + / - ＆＃34;在标题的右侧签名：

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

Answer 2

您可以使用几行外部CSS和javascript对应用程序中的所有框执行此操作。

当您单击标题时，JS会触发对窗口小部件的单击。它必须是h3元素，因为该小部件位于.box-header内部，这将导致无限递归。

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

但是然后我们需要使h3元素填充整个.box-header，因此摆脱标题填充（右侧除外），将其添加到h3中，并使h3填充宽度的100％的盒子。

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

Answer 3

我认为 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
  )
}

在标题上展开/折叠闪亮框，然后点击

3 个答案: