R Shiny dropdownButton无效大小?

时间:2017-08-30 15:43:50

标签: css r user-interface drop-down-menu shiny

我正在使用Shiny Widgets中此链接的dropdownButton,使用一个轻微的mod来使文本变黑。 drop-down checkbox input in shiny

我的目标是让我的侧边栏中的dropdownButton看起来尽可能像selectInput功能。我得到的按钮与selectInput的大小相同,并且插入符号正确,感谢另一篇文章的帮助,但是当我更改窗口大小时,我遇到了UI重叠问题。

有什么建议吗?请参阅下面的问题:enter image description here

两者都是来自相同代码的相同应用的屏幕截图,只是不同的窗口大小。我希望dropdownButton在将其大小与上面的selectInput匹配时保持一致。我也不明白为什么我的h5(" Filter 2 :)文本会因为窗口大小而分裂,我不希望它这样做。

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:"))),
                      tags$style(type = 'text/css', ".btn-default{width: 100%;}"),
                      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"))
                      ),
                      h5(strong(("Filter 3:"))),
                      dropdownButton2(
                        label = "Filter 3:", status = "default", width = 200,#circle = FALSE,
                        checkboxGroupInput(inputId = "check3", label = "Choose", choices = c("A","B","C"))
                      )
               )),
  dashboardBody()         
)

server <- function(input, output){
}


shinyApp(ui = ui, server = server)

1 个答案:

答案 0 :(得分:1)

@SarahGC - 您在代码中定义的columnwidth = 1,用于显示dropdownbuttons。只需更改该值,您的问题就会得到解决(文本不会在标签上分割按钮的宽度不会受到限制)。请注意width必须介于1到12之间。

column(11,
                          h5(strong("Filter 2:")),
                          tags$style(type = 'text/css', ".btn-default{width: 100%;}"),
                          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 = 100,#circle = FALSE,
                            checkboxGroupInput(inputId = "check1", label = "Choose", choices = c("A","B","C"))
                          ),
                          h5(strong("Filter 3:")),
                          dropdownButton2(
                            label = "Filter 3:", status = "default",width = 100,#circle = FALSE,
                            checkboxGroupInput(inputId = "check3", label = "Choose", choices = c("A","B","C"))
                          )
                   )