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

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 事件处理程序，它将 class has-selected-child 分配给被单击元素的父元素（并从中删除此 class所有其他元素）
然后我们定义一些 CSS 来适当地为这个元素着色。
最后一件事是将 class 初始分配给第一个元素（还没有点击）。

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

R shiny- How to change color of menuitem when any submenuitem is selected

css

r

shiny

shinydashboard

说明