使用 shinydashboard 进行选项卡自定义

Question

我已经努力了几个小时来尝试做一个本应非常简单的选项卡自定义。

在附加的 Shiny 应用程序中，我希望选定的选项卡在其左侧、顶部和右侧以蓝色突出显示，而不是像默认情况下那样只在顶部突出显示。为此，我添加了 2 个自定义块（tags$head(...) 在应用程序的开头）。

它只是部分成功，因为某些原因，一行的第一个子选项卡的左侧仅在悬停时突出显示（最顶部的选项卡，以及同一行上的其他选项卡没有此问题).我希望左侧的行为类似于选项卡的右侧，即如果选择了选项卡，则始终突出显示，而不是依赖于悬停。

我一直在寻找“检查元素”有什么问题，但没有带来任何线索。我不知道我应该寻找什么选项（是否有任何地方可以找到所有可能的选项卡格式选项，例如 border-left-width ？），或者什么对象触发了这种烦人的行为。我该怎么做才能纠正这个问题？

我在 R 3.6.0 上有这个问题（我无法更新到 R 4.x.x，因为这个 reprex 中没有使用的包有问题），shinydashboard_0.7.2，shiny_1.7.1, RStudio 1.4.1717.

附加的应用程序（布局很奇怪，原因不是这里的重点，我还删除了一些其他自定义块，这使应用程序更难看，但允许只关注我的选项卡问题）：

library(shiny)
library(shinydashboard)

# Code for ui goes below --------------------------------------------------
ui <- dashboardPage(
    dashboardHeader(title = "Reprex"),
    dashboardSidebar(width = 350,
                     sidebarMenu(
                         id = "sidebarMenuID", menuItem("Results", tabName = "graphs", icon = icon("bar-chart"))
                     )),
    dashboardBody(
        # Tab Style: have top, left and right borders highlighted
        tags$head(
            tags$style(
                '.nav-tabs-custom .nav-tabs li.active a, .nav-tabs-custom .nav-tabs li.active:hover a {
      border-top-color: #3C8DBC;
      border-left-color: #3C8DBC;
      border-right-color: #3C8DBC;
      border-left-width: 5px;
      border-right-width: 5px;
    }'
            )
        ),
    
    tags$head(
        tags$style(
            '#site_nav li.active a, #site_nav li.active:hover a {
      border-top-color: #3C8DBC;
      border-left-color: #3C8DBC;
      border-right-color: #3C8DBC;
      border-top-width: 5px;
      border-left-width: 5px;
      border-right-width: 5px;
    }'
        )
    ),
    tabItems(tabItem(
        tabName = "graphs",
        tabsetPanel(id = "site_nav", #"site_tabs"
                    tabPanel("Tab 1",
                             fluidRow(
                                 tabBox(
                                     width = 12,
                                     height = NULL,
                                     tabPanel("Sub-tab 1",
                                              fluidRow(
                                                  tabBox(
                                                      width = 12,
                                                      height = NULL,
                                                      tabPanel("Sub-sub tab 1",
                                                               fluidRow(
                                                                   tabBox(
                                                                       width = 12,
                                                                       height = NULL,
                                                                       tabPanel("Sub-sub-sub tab 1",
                                                                                fluidRow(box(
                                                                                    title = "Some title",
                                                                                    width = 12
                                                                                )),
                                                                                fluidRow(box(
                                                                                    title = "Some title",
                                                                                    width = 12
                                                                                ))),
                                                                       tabPanel("Sub-sub-sub tab 2",
                                                                                fluidRow(box(
                                                                                    title = "Some title",
                                                                                    width = 12
                                                                                )),
                                                                                fluidRow(box(
                                                                                    title = "Some title",
                                                                                    width = 12
                                                                                )))
                                                                   )
                                                               )),
                                                      tabPanel("Sub-sub tab 2",
                                                               fluidRow(
                                                                   tabBox(
                                                                       width = 12,
                                                                       height = NULL,
                                                                       tabPanel("Sub-sub-sub tab 1",
                                                                                fluidRow(box(
                                                                                    title = "Some title",
                                                                                    width = 12
                                                                                )),
                                                                                fluidRow(box(
                                                                                    title = "Some title",
                                                                                    width = 12
                                                                                ))),
                                                                       tabPanel("Sub-sub-sub tab 2",
                                                                                fluidRow(box(
                                                                                    title = "Some title",
                                                                                    width = 12
                                                                                )),
                                                                                fluidRow(box(
                                                                                    title = "Some title",
                                                                                    width = 12
                                                                                )))
                                                                   )
                                                               ))
                                                  )
                                              )),
                                     tabPanel("Sub-tab 2",
                                              fluidRow(
                                                  box(
                                                      width = 12,
                                                      title = "Some title",
                                                      align = "centre",
                                                      background = "blue"
                                                  )
                                              ))
                                     
                                 )
                             )))
    ))
    )
)



####End of ui
# Server Code goes below --------------------------------------------------

server <- function(input, output, session) {
    
}

shinyApp(ui = ui, server = server)

Answer 1

你快到了。我认为有一个由 shiny 或 Bootstrap 定义的默认 class 将左边框设置为透明。将 css class .nav-tabs-custom .nav-tabs li:first-of-type.active a 添加到您的样式定义中。

我已经复制了下面的 tags$head 语句。我使用 shorthand 属性压缩了一些样式定义。我希望你不介意。 :-)（除非您想进一步自定义外观，否则您可以将这两个语句结合起来。）

希望有用！

tags$head(
    tags$style(
        "
        .nav-tabs-custom .nav-tabs li.active a,
        .nav-tabs-custom .nav-tabs li:first-of-type.active a,
        .nav-tabs-custom .nav-tabs li.active:hover a {
            border-color: #3C8DBC;
            border-bottom-color: none;
            border-width: 0 5px;
        }
        ",
        "
        #site_nav li.active a,
        #site_nav li.active:hover a {
            border-color: #3C8DBC;
            border-bottom-color: none;
            border-width: 0 5px;
        }
        "
    )
),

使用 shinydashboard 进行选项卡自定义

Tab customization with shinydashboard

r

shiny

shinydashboard