Dodawanie logo firmy do nagłówka ShinyDashboard

Question

Po prostu ciekawy, czy istnieje sposób na dodanie logo firmy do nagłówka ShinyDashboard? Kiedy patrzę na documentation, opisuje on zmianę "logo" w CSS, to jest po prostu konfiguracja tego, co dzieje się w lewym górnym rogu, o ile mogę to stwierdzić i chciałbym zachować tam tytuł.

Nie używam rozwijanych menu, więc chciałbym dodać logo mojej firmy w prawym górnym rogu, tam gdzie jest czerwone pole.

Czy ktoś ma jakiś pomysł, w jaki sposób można to zrobić z Shinydashboard? Dzięki.

Answer 1

pracuję z odrobiną hack na to, (a wiem, że nie o to poprosić, ale tu jest klikalny logo, a my jesteśmy w nim):

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

To powoduje umieszczenie błyszczącego tagu wewnątrz nagłówka. Drugie gniazdo w tym konkretnym błyszczący przedmiot jest szczelina logo (Będziesz potrzebował „logo.png” w/www/folder w katalogu app)

EDIT:

Właśnie sprawdziłem, jak i od teraz, ten siekać nie powinno być konieczne, można wstawić kod HTML bezpośrednio z funkcji dashboardHeader poprzez parametr title= (Przed, że parametr został tylko egzekwowanie tekst),

Myślę, że odpowiedź może być jeszcze przydatny jako metoda modyfikacji istniejących błyszczących funkcji, w których rzeczy zostały na stałe zakodowane.

Oto metoda teraz:

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

lub dodając trochę więcej magii do logo (ja również używać logo jako pasek ładowania):

# 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

Oto mój siekać (umieść swoje logo, jak wspomniano wcześniej, w podkatalogu www katalogu aplikacji).
Ponieważ dashboardHeader() spodziewa element tag typu li i klasy dropdown, możemy przekazać takie elementy zamiast dropdownMenu s:

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 
)