1

我是一个闪亮的 js 新手，似乎在这个问题上陷入了僵局。

我想创建一个下拉按钮，其标签会随着用户从该按钮中的选择而变化。

以下是我的最小可重现代码。我从这篇文章中获取了一个下拉按钮功能：闪亮的下拉复选框输入：

library(shiny)
library(shinyjs)

dropdownButton <- 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: 375px; overflow-y:scroll; max-height: 300px"), # width: validateCssUnit(width)
        lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
    )
    # 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 <- fluidPage(
  uiOutput("button")
)

server <- function(input, output) {
  output$button <- renderUI({
    list(
      useShinyjs(),
      dropdownButton(label = "Cut Table By:", status = "default",
        radioButtons("letters", 
          NULL, 
          choices = c("A", "B", "C", "D", "E"),
          selected = "B")
      )
    )
  }) 
}

shinyApp(ui, server)

我希望按钮的默认标签是“Cut Table by”（或者甚至可以是选项“B”），但是当用户选择另一个选项时，更改为该字母。

我认为最让我困惑的部分是嵌入在下拉功能中的单选按钮功能，并且我需要以某种方式使用对嵌入功能的输入来制作一个事件，该输入会影响对嵌入功能的输入。但也许情况比我想象的要简单。

谢谢您的帮助！

4

1 回答 1

2

您可以label在button标签中添加任何元素。因此，最简单的方法是使标签成为反应性标签textOutput，然后可以对选择的radioButton. 这样，您甚至不必更改您的dropdownButton功能。我所做的添加非常简单。只需要注意textOutput必须有inline = TRUE，以免在插入符号之前出现丑陋的中断。

我修改了你给定的代码：

library(shiny)
library(shinyjs)

dropdownButton <- 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: 375px; overflow-y:scroll; max-height: 300px"), # width: validateCssUnit(width)
        lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
    )
    # 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 <- fluidPage(
  uiOutput("button")
)

server <- function(input, output) {
  output$button <- renderUI({
    list(
      useShinyjs(),
      dropdownButton(label = textOutput("labels", inline = TRUE), status = "default",
        radioButtons("letters", 
          NULL, 
          choices = c("A", "B", "C", "D", "E"),
          selected = "B")
      )
    )
  }) 

  output$labels <- renderText(paste("Cut Table By:", input$letters))
}

shinyApp(ui, server)
于 2016-07-13T17:31:38.280 回答