0

我想根据复选框的值更改引导按钮的 css 类。如果复选框 ( input$x) 的值被选中,即。euqals TRUE,我想添加一个类,当值为 false 时,我想删除该类。下面的代码是我尝试过的,但它不起作用。有人知道为什么它不起作用吗?

library(shiny)
library(tidyverse)
library(htmltools)

ui = fluidPage(
  
  tags$style(
    HTML(
      ".testclass {background-color: pink;")),
  
  tags$div(style = "margin: 100px;",

  tags$input(type = "checkbox", "Check", id = "x"),    
      
  tags$button("Click", class="btn btn-default dropdown-toggle", id = "dropdownMenu1"))

  )

server = function(input, output, session){
  
  ### CUSTOM FUNCTIONS
  
  observeEvent(input$x, {
    if(isTRUE(input$x)){
      tagQuery(ui)$find("button")$filter(function(x, i) tagGetAttribute(x, "id") == "dropdownMenu1")$addClass("testclass")
    }else{
      tagQuery(ui)$find("button")$filter(function(x, i) tagGetAttribute(x, "id") == "dropdownMenu1")$removeClass("testclass")
    }
  })
}
shinyApp(ui, server)
4

1 回答 1

2

tagQuery不对 DOM 执行任何操作,它只是重写一个标签。你可以做:

library(shiny)
library(htmltools)

ui = fluidPage(
  
  tags$style(
    HTML(".testclass {background-color: pink;")
  ),
  
  tags$div(
    style = "margin: 100px;",
    
    tags$input(type = "checkbox", "Check", id = "x"),    
    
    uiOutput("mybutton")
  )
  
)

server = function(input, output, session){
  
  output[["mybutton"]] <- renderUI({
    btn <- tags$button("Click", class="btn btn-default dropdown-toggle", id = "dropdownMenu1")
    if(isTRUE(input$x)){
      btn <- tagQuery(btn)$addClass("testclass")
    }else{
      btn <- tagQuery(btn)$removeClass("testclass")
    }
    btn$selectedTags()
  })
  
}

shinyApp(ui, server)
于 2021-10-27T15:23:10.680 回答