javascript - 如何使 R 中的粘性导航栏 Shiny ？

Question

我有一个带导航栏的 Shiny 应用程序，我想让这个导航栏粘住。我检查了 this page对此进行了解释，我尝试将 CSS 和 JS 代码放在 shiny 中，但没有成功(要查看，请运行应用程序，在表中选择 50 或 100 个观察值，然后向下滚动)。

library(shiny)
library(dplyr)

ui <- navbarPage(
  tags$head(
    tags$style(HTML("
     #navbar {
      overflow: hidden;
      background-color: #333;
    }
    
    /* Navbar links */
    #navbar a {
      float: left;
      display: block;
      color: #f2f2f2;
      text-align: center;
      padding: 14px;
      text-decoration: none;
    }
    
    /* Page content */
    .content {
      padding: 16px;
    }
    
    /* The sticky class is added to the navbar with JS when it reaches its scroll position */
    .sticky {
      position: fixed;
      top: 0;
      width: 100%;
    }
    
    /* Add some top padding to the page content to prevent sudden quick movement (as the navigation bar gets a new position at the top of the page (position:fixed and top:0) */
    .sticky + .content {
      padding-top: 60px;
    }
    ")),
    tags$script(
      "// When the user scrolls the page, execute myFunction
      window.onscroll = function() {myFunction()};
      
      // Get the navbar
      var navbar = document.getElementById('navbar');
      
      // Get the offset position of the navbar
      var sticky = navbar.offsetTop;
      
      // Add the sticky class to the navbar when you reach its scroll position. Remove 'sticky' when you leave the scroll position
      function myFunction() {
        if (window.pageYOffset >= sticky) {
          navbar.classList.add('sticky')
        } else {
          navbar.classList.remove('sticky');
        }
      }"
    )
  ),
  tabPanel(
    title = "test tab",
    dataTableOutput("test_table")
  ),
  selected = "test tab"
)

server <- function(input, output, session) {
  
  output$test_table <- renderDataTable({
    mtcars %>%
      bind_rows(mtcars)
  })
  
}

shinyApp(ui, server)

是否可以使导航栏粘滞？

Answer 1

您可以在 navbarPage 中使用 position = c("fixed-top")。它可以解决您的问题。

library(shiny)
library(dplyr)

ui <- navbarPage(
  title = "",
  tabPanel(
    title = "test tab",
    br(),
    br(),
    br(),
    br(),
    dataTableOutput("test_table")
  ),
  selected = "test tab",
  position = c("fixed-top")
)

server <- function(input, output, session) {
  
  output$test_table <- renderDataTable({
    mtcars %>%
      bind_rows(mtcars)
  })
  
}

shinyApp(ui, server)