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

Question

我有一个带有导航栏的闪亮应用程序，我想让这个导航栏变得粘稠。我检查了这个解释了这一点的页面，我试图将 CSS 和 JS 代码放入闪亮但没有成功（要查看它，运行应用程序，在表中选择 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)

是否可以使导航栏具有粘性？

标签： javascriptcssr

Answer 1

可以 position = c("fixed-top")在里面使用navbarPage。它服务于你的问题。

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)