将公司徽标添加到ShinyDashboard标题中

Question

所以只是好奇,有没有办法在ShinyDashboard的标题中添加公司徽标？正如我正在查看文档时,它描述了更改CSS中的"徽标",这只是配置左上角的内容,尽管据我所知,我想保留我的标题.

我没有使用下拉菜单,因此我想在红色框所在的右上角添加我的公司徽标.

有没有人知道如何用Shinydashboard完成这项工作？谢谢.

Answer 1

我一直在努力解决这个问题,(我知道你没有要求它,但是我们在这里时,这里有一个可点击的标志):

library(shiny)
library(shinydashboard)

dbHeader <- dashboardHeader()
dbHeader$children[[2]]$children <-  tags$a(href='http://mycompanyishere.com',
                                           tags$img(src='logo.png',height='60',width='200'))

dashboardPage(
       dbHeader,
       dashboardSidebar(),
       dashboardBody()
)

所以这会在标题中嵌入一个有光泽的标签.这个特殊闪亮物体的第二个插槽是徽标插槽(你需要在app目录的/ www /文件夹中找到'logo.png')

编辑:

我刚刚检查过,现在,不再需要这个hack,你可以通过title=参数直接从dashboardHeader函数插入html ,(之前,该参数仅强制执行文本),

我认为答案可能仍然有用,作为修改现有闪亮函数的方法,其中事物是硬编码的.

这是现在的方法:

dashboardPage(
    dashboardHeader(title = tags$a(href='http://mycompanyishere.com',
                                    tags$img(src='logo.png')))

或者,为徽标添加更多魔力(我还使用我的徽标作为加载栏):

# Takes a location 'href', an image location 'src', a loading gif 'loadingsrc'
# height, width and alt text, and produces a loading logo that activates while
# Shiny is busy
loadingLogo <- function(href, src, loadingsrc, height = NULL, width = NULL, alt = NULL) {
  tagList(
    tags$head(
      tags$script(
        "setInterval(function(){
                     if ($('html').attr('class')=='shiny-busy') {
                     $('div.busy').show();
                     $('div.notbusy').hide();
                     } else {
                     $('div.busy').hide();
                     $('div.notbusy').show();
           }
         },100)")
  ),
  tags$a(href=href,
         div(class = "busy",  
             img(src=loadingsrc,height = height, width = width, alt = alt)),
         div(class = 'notbusy',
             img(src = src, height = height, width = width, alt = alt))
   )
  )
}

dashboardBody(
  dashboardHeader(title = loadingLogo('http://mycompanyishere.com',
                                      'logo.png',
                                      'loader.gif'),
  dashboardSidebar(),
  dashboardBody()
)

Answer 2

这是我的hack(如前所述,将您的徽标放入wwwapp目录的子目录中).
因为dashboardHeader()需要类型li和类的标记元素dropdown,我们可以传递这样的元素而不是dropdownMenus:

library(shiny)
library(shinydashboard)

dbHeader <- dashboardHeader(title = "My Dashboard",
                            tags$li(a(href = 'http://shinyapps.company.com',
                                      icon("power-off"),
                                      title = "Back to Apps Home"),
                                    class = "dropdown"),
                            tags$li(a(href = 'http://www.company.com',
                                      img(src = 'company_logo.png',
                                          title = "Company Home", height = "30px"),
                                      style = "padding-top:10px; padding-bottom:10px;"),
                                    class = "dropdown"))

server <- function(input, output) {}

shinyApp(
    ui = dashboardPage(
        dbHeader,
        dashboardSidebar(),
        dashboardBody()
    ),
    server = server
)