在 bs4card 内嵌套操作按钮有困难答案

【问题标题】：Having difficulty nesting action button inside bs4card在 bs4card 内嵌套操作按钮有困难
【发布时间】：2021-11-17 15:59:38
【问题描述】：

我正在尝试构建一个模块化的闪亮应用程序，应用程序中的一个重要组件是 bs4cards，它有一个下拉菜单，菜单中有一个保存按钮，可以保存卡片的内容。这是我构建的两个模块的代码。 bs4card 模块将包含 actionbttn 模块。

mod_actionbttn_ui <- function(id){
  ns <- NS(id)
  tagList(
    uiOutput(ns("button"))
  )
}

#' valuebox Server Functions
#'
#' 
mod_actionbttn_server <- function(id, label, icon, style, size, block){
  moduleServer(id, function(input, output, session){
    
    output$button <- renderUI({
      actionBttn(
                 label = req(rlabel()),
                 icon = req(ricon()),
                 style = req(rstyle()),
                 color = req(zsize()),
                 block = req(rblock())
      )
    })
    
    rlabel <- reactive(label)
    ricon <- reactive(icon)
    rstyle <- reactive(style)
    rsize <- reactive(size)
    rblock <- reactive(block)
  })
}

mod_bs4card_ui <- function(id){
  ns <- NS(id)
  tagList(
    uiOutput(ns("card")),
    mod_actionbttn_ui(ns("button"))
  )
}

#' valuebox Server Functions
#'
#' 
mod_bs4card_server <- function(id, title, status){
  moduleServer(id, function(input, output, session){
    
    output$card <- renderUI({
      bs4Card(title = req(rtitle()), 
              status = req(rstatus()),
              solidHeader = TRUE,
              width = NULL,
              collapsible = TRUE,
              collapsed = TRUE,
              closable = TRUE,
              maximizable = TRUE,
              dropdownMenu = mod_actionbttn_server("button"))
    })
    
    rtitle <- reactive(title)
    rstatus <- reactive(status)
  })
}

ui <- bs4DashPage(header = bs4DashNavbar(), 
                  sidebar = bs4DashSidebar(),
                  body =  fluidRow(
                    column(
                      width = 12,mod_bs4card_ui("bs4c")))
)

server <- function(input,output,session){
  mod_bs4card_server("bs4c",
                     title = "Some Title",
                     status = "navy")
}

shinyApp(ui = ui, server = server)

主要的问题是如何为动作按钮传递参数，我的意思是标签、图标、样式、样式等等。

【问题讨论】：

请发布完整的MRE，以便有人可以帮助您。我们无法猜测您在 ui 和 server 中所做的事情。
刚刚更新了应用代码。

标签： r shiny shinydashboard bs4dash

【解决方案1】：

我不确定您在寻找什么。以下内容有效，但您需要根据需要对其进行更新。

library(bs4Dash)

mod_actionbttn_ui <- function(id){
  ns <- NS(id)
  tagList(
    uiOutput(ns("button"))
  )
}

#' valuebox Server Functions
#'
#' 
mod_actionbttn_server <- function(id, label, status, zsize, block){
  moduleServer(id, function(input, output, session){
    ns <- session$ns
    output$button <- renderUI({
      actionBttn(inputId = ns("btn4"),
        label = "My actionbttn",
        #icon = icon("sliders"),
        style = "float",
        color = req(status()),
        size = zsize,
        block = block
      )
    })
    
    return(reactive(input$btn4))
  })
}

mod_bs4card_ui <- function(id){
  ns <- NS(id)
  tagList(
    fluidRow(column(6, uiOutput(ns("card")) ,
                    mod_actionbttn_ui(ns("button"))
                    )), 
  )
}

#' valuebox Server Functions
#'
mod_bs4card_server <- function(id, title, status){
  moduleServer(id, function(input, output, session){
    rtitle <- reactive(title)
    rstatus <- reactive(status)
    
    mybtn4 <- mod_actionbttn_server("button",rtitle,rstatus,"lg",TRUE)
    observe({print(mybtn4())})
    
    output$card <- renderUI({
      bs4Card(title = req(rtitle()), 
              status = req(rstatus()),
              solidHeader = TRUE,
              width = 12,
              collapsible = TRUE,
              collapsed = TRUE,
              closable = TRUE,
              maximizable = TRUE,
              #dropdownMenu = mod_actionbttn_server("button",rtitle,rstatus,"lg",TRUE)
              p("My Box Content",mybtn4())
              )
    })
    
  })
}

ui <- bs4DashPage(header = bs4DashNavbar(), 
                  sidebar = bs4DashSidebar(),
                  body =  bs4DashBody(fluidRow(
                    column(width = 12,mod_bs4card_ui("bs4c"))))
)

server <- function(input,output,session){
  mod_bs4card_server("bs4c",
                     title = "Some Title",
                     status = "primary")
}

shinyApp(ui = ui, server = server)

【讨论】：