0

我正在尝试构建一个模块化的闪亮应用程序,应用程序中的一个重要组件是 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)

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

4

1 回答 1

0

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

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)
于 2021-09-24T15:29:08.017 回答