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

Question

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

4

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

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

- WiseChirag

3个回答

0

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

- Goreg

0

你可以使用几行外部 CSS 和 JavaScript 来为应用程序中的所有框执行此操作。

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

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

但是我们需要让h3元素填满整个.box-header，因此除了右侧之外，去掉标题的padding，将其添加到h3中，并使h3填充盒子的100％宽度。

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

- Lisa DeBruine

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- kawsleo · Accepted Answer

使用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
  )
}