web-dev-qa-db-fra.com

Ajout d'un logo d'entreprise à l'en-tête ShinyDashboard

Donc, juste curieux, existe-t-il un moyen d'ajouter un logo d'entreprise à l'en-tête d'un ShinyDashboard? Comme je regarde le documentation , il décrit la modification du "logo" dans le CSS, cela ne fait que configurer ce qui se passe dans le coin supérieur gauche, pour autant que je sache et je voudrais garder mon titre là-bas.

Je n'utilise pas les menus déroulants et je voudrais donc ajouter le logo de mon entreprise en haut à droite, là où se trouve la boîte rouge.

enter image description here

Quelqu'un sait-il comment cela peut être fait avec Shinydashboard? Merci.

29
decal

J'ai travaillé avec un peu de hack pour cela, (et je sais que vous ne l'avez pas demandé, mais voici un logo cliquable pendant que nous y sommes):

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

Donc, cela imbrique un shiny.tag à l'intérieur de l'en-tête. Le deuxième emplacement de cet objet brillant particulier est l'emplacement du logo (vous aurez besoin d'un 'logo.png' dans votre dossier/www/dans le répertoire de l'application)

MODIFIER:

Je viens de vérifier, et pour le moment, ce hack ne devrait plus être nécessaire, vous pouvez insérer le html directement depuis la fonction dashboardHeader via le title= paramètre, (Avant, ce paramètre appliquait uniquement le texte),

Je pense que la réponse pourrait encore être utile comme méthode pour modifier les fonctions brillantes existantes où les choses [~ # ~] sont [~ # ~] codées en dur si .

Voici la méthode maintenant:

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

ou, en ajoutant un peu plus de magie au logo (j'utilise aussi mon logo comme barre de chargement):

# 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()
)
43
Shape

Voici mon hack (mettez votre logo, comme cela a été mentionné précédemment, dans un sous-répertoire www de votre répertoire d'application).
Parce que dashboardHeader() attend un élément de balise de type li et de classe dropdown, nous pouvons passer de tels éléments au lieu de 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
)
23
Matt Flor