r语言 - 在bs4card内嵌套动作按钮有困难

Question

我试图建立一个模块化闪亮的应用程序和应用程序中的一个重要组成部分是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)

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

Answer 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)