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

Question

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

请参考下面的屏幕截图： - 我们可以在选择“图表”或“仪表板”时更改“首先”的颜色？

下面是可重用的代码：-

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",startExpanded = TRUE,
             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)

Answer 1

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 来适当地为这个元素着色。
• 最后一件事是最初将类分配给第一个元素（还没有点击）。