Question

ShinyDashboardPlus具有左侧边栏菜单折叠但仍显示图标的功能。这样做的问题是，它不会隐藏侧栏中的任何按钮或输入选择。

我正在寻找以下两种解决方案：

1）像常规的shinydashboard一样完全折叠边栏（隐藏按钮和输入）

2）为使左侧菜单保持原状折叠，并在部分折叠时以某种方式隐藏这些功能

下面是显示该问题的代码：

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

header <- dashboardHeaderPlus(
      enable_rightsidebar = TRUE,
      rightSidebarIcon = "filter"
    )

sidebar <- dashboardSidebar(
  sidebarMenu(id = "menuChoice",
              menuItem("Tab 1", tabName = "Tab1", icon = icon("globe"))
  ),
  actionButton("Test", "Download", icon = icon("download")),
  selectInput(inputId = "TestChoice",label = "Selection", selected="Choice1",
              choices = c("Choice1","Choice2","Choice3"))
)

body <- dashboardBody()

rightsidebar <- rightSidebar()

ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)

server <- function(input, output) {}

shinyApp(ui, server)

Answer 1

我添加了一些jquery和CSS代码，以在关闭侧边栏时模拟Shinydashboard的正常行为（解决方案1）。

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

jscode <- HTML("
$(document).on('shiny:connected', function(event) {
  $('.sidebar-toggle').on('click', function() {
    if ($('body')[0].className != 'skin-blue sidebar-mini sidebar-collapse') {
      $('#sidebarCollapsed').css('display', 'none')
    } else {
      $('#sidebarCollapsed').css('display', 'block')
    }
  })
});
")

csscode <- HTML("
.sidebar-mini.sidebar-collapse .content-wrapper {
      margin-left: 0px !important;
}")

header <- dashboardHeaderPlus(
  enable_rightsidebar = TRUE,
  rightSidebarIcon = "filter"
)

sidebar <- dashboardSidebar(collapsed = T,
  tags$head(tags$script(jscode)),
  tags$head(tags$style(csscode)),
  sidebarMenu(id = "menuChoice",
              menuItem("Tab 1", tabName = "Tab1", icon = icon("globe"))
  ),
  actionButton("Test", "Download", icon = icon("download")),
  selectInput(inputId = "TestChoice",label = "Selection", selected="Choice1",
              choices = c("Choice1","Choice2","Choice3"))
)
body <- dashboardBody()
rightsidebar <- rightSidebar()

ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)

###########################/server.R/###############################
server <- function(input, output) {}

#Combines Dasboard and Data together----
shinyApp(ui, server)

使用某些CSS，您可以实现解决方案2，尽管您可能必须根据自己的喜好添加或调整某些CSS：

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

csscode <- HTML("
.sidebar-mini.sidebar-collapse .shiny-bound-input.action-button {
  margin: 6px 6px 6px 3px;
  max-width: 85%;
}
.sidebar-mini.sidebar-collapse .fa {
  font-size: initial;
}
.sidebar-mini.sidebar-collapse .btn-default {
  font-size: 0;
}
.sidebar-mini.sidebar-collapse #tohide {
  display: none;
}
")

header <- dashboardHeaderPlus(
  enable_rightsidebar = TRUE,
  rightSidebarIcon = "filter"
)

sidebar <- dashboardSidebar(collapsed = T,
                            tags$head(tags$style(csscode)),
                            sidebarMenu(id = "menuChoice",
                                        menuItem("Tab 1", tabName = "Tab1", icon = icon("globe"))
                            ),
                            actionButton("Test", "Download", icon = icon("download")),
                            div(id="tohide", 
                              selectInput(inputId = "TestChoice",label = "Selection", selected="Choice1",
                                          choices = c("Choice1","Choice2","Choice3"))
                                )
)

body <- dashboardBody()

rightsidebar <- rightSidebar()

ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)

server <- function(input, output) {}

shinyApp(ui, server)

Answer 2

如here所述，您可以使用sidebar_fullCollapse = TRUE函数的shinydashboardPlus::dashboardPagePlus()自变量，例如：

shinyApp(
  ui = dashboardPagePlus(
    header               = dashboardHeaderPlus(),
    sidebar              = dashboardSidebar(),
    sidebar_fullCollapse = TRUE,
    body                 = dashboardBody(),
  ),
  server = function(input, output) { }
)

此：

完全折叠侧边栏，因此不留图标；
不折叠标题中的仪表板标题。

在ShinyDashboardPlus中完全折叠左侧边栏

2 个答案: