在shinydashboard标题右侧添加文本

Question

如何在仪表板标题侧边栏图标的右侧添加文本？似乎以前的类似解决方案不再适用于更新dashboardHeader().

这是我在基本的shinydashboard设置中尝试做的事情:

我可以使用此答案中的策略来获取标题中的文本,但它是正确的(我可以修复自定义css)并且也感觉非常hacky.

library(shiny)
library(shinydashboard) 
ui <- dashboardPage(dashboardHeader(title = "demo",
  tags$li(class = "dropdown",
    tags$p("foo")
  )
), dashboardSidebar(), dashboardBody()) 
server <- function(input, output) { } 
shinyApp(ui, server)

有一个更好的方法吗？

Answer 1

的dashboardHeader预期元素类型dropdownMenu。因此，很难找到一个不容易破解的解决方案。可能的（hacky）选项是：a）修改dashboardHeader函数，或b）创建标头后使用一些JavaScript代码添加文本。以下是我尝试使用JavaScript解决您的问题的尝试，也许可以为您提供帮助。

library(shiny)
library(shinydashboard) 
ui <- dashboardPage(
  dashboardHeader(
    title = "demo"
  ), 
  dashboardSidebar(), 
  dashboardBody(
    tags$head(tags$style(HTML(
      '.myClass { 
        font-size: 20px;
        line-height: 50px;
        text-align: left;
        font-family: "Helvetica Neue",Helvetica,Arial,sans-serif;
        padding: 0 15px;
        overflow: hidden;
        color: white;
      }
    '))),
     tags$script(HTML('
      $(document).ready(function() {
        $("header").find("nav").append(\'<span class="myClass"> Text Here </span>\');
      })
     '))
  )
) 
server <- function(input, output) { } 
shinyApp(ui, server)

Answer 2

添加到 Geovany & Tiffany 的答案中，如果您希望文本内容是动态的，您可以使用该shinyjs::html功能根据用户输入进行更改。

例如，我使用它在标题中显示所选选项卡的名称。只要您给侧边栏菜单一个id，就可以访问服务器功能中选定的选项卡名称，在我的情况下是tabs.

我也不得不添加id的div是附加在Geovany代码的头，在这种情况下pageHeader。

然后将此添加到服务器功能将更改标题文本以显示所选选项卡，switch用于创建更可呈现的标题格式。注意useShinyJs()indashboardPage参数：

library(shiny)
library(shinydashboard) 

ui <- dashboardPage(
        dashboardHeader(
          title = "demo"
        ), 
        dashboardSidebar(), 
        dashboardBody(
          tags$head(tags$style(HTML(
            '.myClass { 
            font-size: 20px;
            line-height: 50px;
            text-align: left;
            font-family: "Helvetica Neue",Helvetica,Arial,sans-serif;
            padding: 0 15px;
            overflow: hidden;
            color: white;
            }
            '))),
          tags$script(HTML('
                           $(document).ready(function() {
                           $("header").find("nav").append(\'<div id="pageHeader" class="myClass"></div>\');
                           })
                           '))
                           ),
        useShinyjs()
)

server <- function(input, output) {
  observeEvent(input$tabs, {
    header <- switch(input$tabs,
                     tab1 = "Tab 1",
                     tab2 = "Tab 2",
                     tab3 = "Tab 3")

    # you can use any other dynamic content you like
    shinyjs::html("pageHeader", header)
  })
} 

shinyApp(ui, server)