在闪亮的仪表板标题右侧添加文本

Question

如何在仪表板标题侧栏图标右侧添加文本？似乎以前的类似解决方案在更新到

dashboardHeader()

后不再起作用。

这就是我在基本的闪亮仪表板设置中尝试做的事情：

我可以使用这个答案中的策略来获取标题中的文本，但它是右对齐的（我可能可以修复自定义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的解决方案。可能的（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

。

我还必须在 Geovany 代码中附加到标头的

id

中添加一个

div

，在本例中为

pageHeader

。

然后将其添加到服务器功能将更改标题文本以显示所选选项卡，并使用

switch

创建更美观的标题格式。注意

useShinyJs()

参数中的

dashboardPage

：

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)

Answer 3

用于自定义字体自动调整大小、位置等的 Geovany 代码的稍微修改版本将是：

directory1 中的 ui.R 文件包含：

    library(shiny)
    library(shinydashboard) 
    ui <- dashboardPage(
      dashboardHeader(
        title = "demo"
      ), 
      dashboardSidebar(), 
        dashboardBody( 
                    tags$script(HTML('
                                            $(document).ready(function() {
                                            $("header").find("nav").append(\'<div class="myClass"> Text Here </div>\');
                                            })
                                            ')),
                    tags$head(
   # Include our custom CSS
                                        includeCSS("styles.css"),
                                )
          )
    ) 

directory1 中的 server.R 文件包含：

    library(shiny)
    library(shinydashboard) 
    server <- function(input, output) { } 

一个 css 样式表（directory1 中的 style.css），使用以下代码控制调整窗口大小时的文本参数，具有定义的最大尺寸和无限缩小：

.myClass { 
line-height: 50px;
text-align: center;
font-family: "Arial";
padding: 0 15px;
color: black;
font-size: 2vw;
    }
@media (min-width: 1200px) {
  .myClass {
    line-height: 50px;
    text-align: center;
    font-family: "Arial";
    padding: 0 15px;
    color: black;
    font-size: x-large
  }
}

运行使用：

shiny::runApp("path to directory1")

Answer 4

添加填充属性可能是一个可能的解决方案。可以根据您的要求探索其他选项，例如宽度、边框和边距。

library(shiny)
library(shinydashboard) 
ui <- dashboardPage(dashboardHeader(title = "demo",
                                    tags$li(class = "dropdown", 
                                            style = "padding: 10px 1200px 0px 0px;",
                                            tags$p("foo")
                                    )
), dashboardSidebar(), dashboardBody()) 
server <- function(input, output) { } 
shinyApp(ui, server)

希望这有帮助！

Answer 5

Paul 的回答没有为我生成任何选项卡，这里是生成选项卡的代码：

library(shinyjs)
library(shiny)
library(shinydashboard) 

ui <- dashboardPage(
  dashboardHeader(
    title = "demo"
  ), 
  dashboardSidebar(
    sidebarMenu(
      id = "tabs",
      menuItem("Tab 1", tabName = "tab1"),
      menuItem("Tab 2", tabName = "tab2"),
      menuItem("Tab 3", tabName = "tab3")
    )
  ), 
  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, session) {
  observeEvent(input$tabs, {
    header <- switch(input$tabs,
                     tab1 = "Tab 1",
                     tab2 = "Tab 2",
                     tab3 = "Tab 3")
    shinyjs::html("pageHeader", header)
  })
  
  observeEvent(input$tabs, {
    updateTabItems(session, "tabs", input$tabs)
  })
} 

shinyApp(ui, server)