在Shiny中观察模态(简单)关闭

时间:2017-07-21 19:50:34

标签: r shiny modal-dialog

我正在寻找一种方法,当easy-close选项为TRUE时,基于关闭Shiny模式触发事件(因此在模态外点击会关闭它)。由于没有ID链接到模态,我似乎无法捕捉到这个事件。我尝试在“观察”事件中包装模态,但这只会触发开启但不会关闭模态。

任何想法...... 感谢

示例:如果此模态通过单击其外部关闭,我想触发事件,因此不是关闭按钮。以下代码仅在打开时触发......

library(shiny)
ui <- fluidPage(
  fluidRow(
    actionButton(inputId = "enterText", label = "Enter name", align = "left"),
    h1(textOutput("myOutput"))
  )
)

server <- function(input, output, session) {
  myText <- reactiveValues(input = "...")
  myModal = modalDialog(h3("Enter a string, then click outside this modal to close and display the text"),
                        textInput(inputId = "myString", label = "Enter a string: "),
                        title = "Input", easyClose = TRUE, footer = modalButton("Dismiss"))
  test = observe(myModal)

  #Open the modal when button clicked
  observeEvent(input$enterText,{
    showModal(myModal)
    })

  #Observe the modal, should fire when it CLOSES by clicking outside the modal (easy-close)
  observeEvent(test, {
    myText$input = input$myString
    print("observed")
  }, ignoreInit = T)

  output$myOutput = renderText(myText$input)

}

shinyApp(ui = ui, server = server)

2 个答案:

答案 0 :(得分:4)

SBista在评论中的链接可能有用 - 我还没有尝试过 - 但是我想为那些不想搞乱HTML并且没有使用HTML的人提供一个更简单的答案。 #39; t要求使用easyClose = TRUE,就像OP一样。

这只是取代了模态的默认&#34;解雇&#34;具有您自己的操作按钮的按钮,允许您在关闭模式时执行一些其他操作。这是通过footer =参数设置的。

在此示例中,模态包含复选框,在模态关闭之前不会生效。

library(shiny)
shinyApp(
  ui <- fluidPage(
    fluidRow(
      ## Button to display modal:
      actionButton(inputId = "display_modal",label = "Display modal"),
      ## Print the choices that were made in the modal:
      h1(textOutput("checked_letters"))
    )
  ),

  server <- function(input, output) {
    ## These values allow the actions made in the modal to be delayed until the
    #  modal is closed
    values = reactiveValues(to_print = "",   ## This is the text that will be displayed
                            modal_closed=F)  ## This prevents the values$to_print output from 
                                             #  updating until the modal is closed

    ## Open the modal when button clicked
    observeEvent(input$display_modal,{
      values$modal_closed <- F
      showModal(modalDialog(
        checkboxGroupInput("checkboxes",label = "Select letters",
                           choices = LETTERS[1:7]),
        ## This footer replaces the default "Dismiss" button,
        #  which is 'footer = modalButton("Dismiss")'
        footer = actionButton("dismiss_modal",label = "Dismiss")
        ))
    })

    ## This event is triggered by the actionButton inside the modalDialog
    #  It closes the modal, and by setting values$modal_closed <- T, it
    #  triggers values$to_print to update.
    observeEvent(input$dismiss_modal,{
      values$modal_closed <- T
      removeModal()
    })
    ## values$to_print is only updated once the modal is closed.
    observe({
      if(values$modal_closed){
        values$to_print <- paste(input$checkboxes)
      }
    })
    ## Forward the values$to_print to the UI
    output$checked_letters = renderText({values$to_print})
  }
)

答案 1 :(得分:1)

类似于第一个答案,我的方法仅适用于easyClose = FALSE。不用将actionButtonobserveEvent一起使用,我们可以创建一个自定义函数modalActionButton,该函数基本上是从actionButton复制粘贴并仅添加data-dismiss = "modal":< / p>

我从下面的第一个答案改编了示例:

library(shiny)

# this is basically copied from actionButton() and just "`data-dismiss` = "modal" 
# from modalButton() is added:
modalActionButton <- function(inputId, label, icon = NULL, width = NULL, ...) {
  
  value <- restoreInput(id = inputId, default = NULL)
  tags$button(id = inputId, type = "button", style = if (!is.null(width)) 
    paste0("width: ", validateCssUnit(width), ";"), type = "button", 
    class = "btn btn-default action-button", `data-dismiss` = "modal", `data-val` = value, 
    list(shiny:::validateIcon(icon), label), ...)
  
}

shinyApp(

    ui <- fluidPage(
    fluidRow(
      ## Button to display modal:
      actionButton(inputId = "display_modal",label = "Display modal"),
      
      ## Print the choices that were made in the modal:
      h1(textOutput("checked_letters"))
    )
  ),
  
  server <- function(input, output) {
    
    values = reactiveValues(to_print = "")   ## This is the text that will be displayed

    observeEvent(input$display_modal, {
      showModal(modalDialog(
        checkboxGroupInput("checkboxes",label = "Select letters",
                           choices = LETTERS[1:7]),

        title = "This is a modal page with a 'modalActionButton' ",
        size = "l",
        easyClose = FALSE,
        # here is the modalActionButton
        footer = modalActionButton("close",
                                   "Close")
      ))
    })

    observeEvent(input$close, {
        values$to_print <- input$checkboxes
      })

    ## Forward the values$to_print to the UI
    output$checked_letters <- renderText({values$to_print})

   }
)