Question

我使用了shineWidgets中此链接drop-down checkbox input in shiny的dropdownButton函数，稍作修改，使文本为黑色。

我希望dropdownButton看起来像我在其上方的selectInput下拉菜单尽可能多。我让它们在侧栏中与列（1，）函数对齐，但我也希望dropdownButton的宽度与selectInput的宽度相同。

我还将下拉选项的宽度设置为宽度= 200以上的selectInput的宽度，但我希望下拉列表按钮也是大小相同。

有人可以帮我修改dropDownButton函数或我的UI，以便这样吗？

library(shiny)
library(shinydashboard)


dropdownButton2 <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {

  status <- match.arg(status)
  # dropdown button content
  html_ul <- list(
    class = "dropdown-menu",
    style = if (!is.null(width)) 
      paste0("width: ", validateCssUnit(width), ";"),
    lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;color:black")
  )
  # dropdown button apparence
  html_button <- list(
    class = paste0("btn btn-", status," dropdown-toggle"),
    type = "button", 
`    data-toggle` = "dropdown"
  )
  html_button <- c(html_button, list(label))
  html_button <- c(html_button, list(tags$span(class = "caret")))
  # final result
  tags$div(
    class = "dropdown",
    do.call(tags$button, html_button),
    do.call(tags$ul, html_ul),
    tags$script(
  "$('.dropdown-menu').click(function(e) {
  e.stopPropagation();
});")
  )
  }

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(width = 325,
               selectInput('month',label='Filter 1:',choices= month.name,multiple = FALSE,selected = "March"),
               br(),
               column(1,
               h5(strong(("Filter 2:"))),
               dropdownButton2(
                 label = "Filter 2:", status = "default", width = 200,#circle = FALSE,
                 checkboxGroupInput(inputId = "check1", label = "Choose", choices = c("A","B","C"))
               )
                 )),
  dashboardBody()         
  )

server <- function(input, output){
}

shinyApp(ui = ui, server = server)

Answer 1

您可以在css代码中添加tags$style(type = 'text/css', ".btn-default{width: 275px;}")代码ui，如下所示：

ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(width = 325,
                     selectInput('month',label='Filter 1:',choices= month.name,multiple = FALSE,selected = "March"),
                     br(),
                     column(1,
                            h5(strong(("Filter 2:"))),
                            tags$style(type = 'text/css', ".btn-default{width: 275px;}"),
                            dropdownButton2(
                              label = "Filter 2:", status = "default", width = 200,#circle = FALSE,
                              checkboxGroupInput(inputId = "check1", label = "Choose", choices = c("A","B","C"))
                            )
                     )),
    dashboardBody()         
  )

在添加标签时，您会得到以下内容：

<强> [编辑]：我后来意识到插入符号没有像selectInput那样正确对齐，因此对齐我进一步添加了几个css标记，如下所示：

ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(width = 325,
                     selectInput('month',label='Filter 1:',choices= month.name,multiple = FALSE,selected = "March"),
                     br(),
                     column(1,
                            h5(strong(("Filter 2:"))),

                            tags$style(type = 'text/css', ".btn-default{width: 275px;}"),
                            tags$style(type = 'text/css', ".btn .caret{position: relative;}"),
                            tags$style(type = 'text/css', ".caret{top: 45%; right:-35%}"),
                            dropdownButton2(
                              label = "Filter 2:", status = "default", width = 200,#circle = FALSE,
                              checkboxGroupInput(inputId = "check1", label = "Choose", choices = c("A","B","C"))
                            )
                     )),
    dashboardBody()         
  )

其他标签导致插入符号对齐如下：

在dashboardSidebar中的dropdownButton对齐方式

1 个答案: