R Shiny-选择任何子菜单项时如何更改菜单项的颜色

问题描述

我有一个闪亮的应用程序，其中有许多带有子菜单项的菜单项。在我的代码中，活动子菜单项以与非活动子菜单项不同的颜色突出显示。当任何子菜单项处于活动状态时，有人可以帮助更改菜单项的颜色（使其与子菜单项相同）？

请参考下面的截图：-当我们选择“图表”或“仪表板”时，我们可以改变“第一”的颜色吗？

以下是可重用的代码：-

library(shiny)
library(shinydashboard)
library(gapminder)

tabledata<-gapminder

header <- dashboardHeader(
  title = "Test Dashboard"
)

sidebar <- dashboardSidebar(
  sidebarMenu (
    menuItem("First",startExpanded = TRUE,menuSubItem("Dashboard",tabName = "tab1"),menuSubItem("Chart","tab2")
    ),menuItem("Second",menuSubItem("Detailed_view",tabName = "tab3")
    )
  )
)

body <- dashboardBody(
  tags$head(tags$style(HTML('
                            /* main sidebar */
                            .skin-blue .main-sidebar {
                            background-color: #EBEBEB;

                            }

                            /* active selected tab in the sidebarmenu */
                            .skin-blue .main-sidebar .sidebar .sidebar-menu .active a{
                            background-color: #E0E0E0;
                            color: #666666;
                            }

                            /* other links in the sidebarmenu */
                            .skin-blue .main-sidebar .sidebar .sidebar-menu a{
                            background-color: #EBEBEB;
                            color: #666666;
                            }

                            /* other links in the sidebarmenu when hovered */
                            .skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{
                            background-color: #E0E0E0;
                            color: #000000;
                            }
                            '))),tabItems(
    tabItem(tabName = "tab1",Box(title = "Table",width = 10,status = "warning",DT::dataTableOutput("table"))
    ),tabItem(tabName = "tab2",plotOutput("plot1")
    )
  )
)

ui <- dashboardPage(skin = "blue",header,sidebar,body)

server <- function(input,output) {
  
  output$table = DT::renderDataTable({
    DT::datatable(tabledata)
  })
  
  output$plot1<-renderPlot({
    plot(tabledata$year,tabledata$pop)
  })
  
}

shiny::shinyApp(ui,server)

解决方法

有点JavaScript是你的朋友：

js <- HTML("
$(function() {
   $('.menu-open > .active').parentsUntil('.sidebar','li').children('a:first-child').addClass('has-selected-child');
   $('.menu-open > li').on('click',function() {
      let $me = $(this);
      let $menu = $me.parents('.main-sidebar');
      $menu.find('.has-selected-child').removeClass('has-selected-child');
      $me.parentsUntil('.sidebar','li').children('a:first-child').addClass('has-selected-child');
   })
})")

body <- dashboardBody(
  tags$head(tags$script(js)),tags$head(tags$style(HTML('

                            /* selected parent */
                            .skin-blue .main-sidebar .sidebar .sidebar-menu .has-selected-child {
                            background-color: #E0E0E0;
                            color: #666666;
                            }
                            /* main sidebar */
                            .skin-blue .main-sidebar {
                            background-color: #EBEBEB;
                            }

                            /* active selected tab in the sidebarmenu */
                            .skin-blue .main-sidebar .sidebar .sidebar-menu .active a{
                            background-color: #E0E0E0;
                            color: #666666;
                            }

                            /* other links in the sidebarmenu */
                            .skin-blue .main-sidebar .sidebar .sidebar-menu a{
                            background-color: #EBEBEB;
                            color: #666666;
                            }

                            /* other links in the sidebarmenu when hovered */
                            .skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{
                            background-color: #E0E0E0;
                            color: #000000;
                            }
                            '))),tabItems(
    tabItem(tabName = "tab1",box(title = "Table",width = 10,status = "warning",DT::dataTableOutput("table"))
    ),tabItem(tabName = "tab2",plotOutput("plot1")
    )
  )
)

说明

• 我们为每个菜单项分配一个 click 事件处理程序，它将类 has-selected-child 分配给点击元素的父级（并从所有其他元素中删除此类）
• 然后我们定义一些 CSS 来适当地为这个元素着色。
• 最后一件事是将类最初分配给第一个元素（还没有点击）。