在小型设备上将R闪亮导航栏转换为汉堡包

时间:2019-04-04 19:26:03

标签: r shiny responsive-design bootstrap-4

我有一个闪亮的应用程序,应该能够响应,因为我们希望最终用户在笔记本电脑和ipad上使用它。以下是闪亮应用程序基于导航栏的布局。现在,当我更改屏幕尺寸时,我希望将导航栏菜单转换为汉堡菜单,而不是一个对齐。

例如:我寻找的最终结果是这样的: https://www.w3schools.com/howto/tryit.asp?filename=tryhow_js_topnav

library(shiny)
library(shinyjs)

ui <- navbarPage(
  "Bootstrap scrollspy on multiple tabs",
  id = "navbar",
  header = div(
    useShinyjs(),
    extendShinyjs("www/app-shinyjs.js", functions = c("updateScrollspy")),
    includeCSS("www/app.css"),
    includeCSS("https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css"),
    includeScript("https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/js/bootstrap.min.js"),
    includeScript("https://cdnjs.cloudflare.com/ajax/libs/jquery-scrollTo/1.4.3/jquery.scrollTo.min.js")
  ),

  # tab 1 contains 4 sections and a scrollspy on the left with text
  tabPanel(
    "tab1",
    div(id = "tab1-content",
        fluidRow(
          column(
            4,
            div(
              id = "tab1-scrollspy",
              class = "potential-scrollspy",
              tags$ul(
                class = "nav nav-pills nav-stacked",
                tags$li(tags$a(href = "#section1-1", "Section 1-1")),
                tags$li(tags$a(href = "#section1-2", "Section 1-2")),
                tags$li(tags$a(href = "#section1-3", "Section 1-3")),
                tags$li(tags$a(href = "#section1-4", "Section 1-4"))
              )
            )
          ),
          column(
            8,
            div(id = "section1-1",
                class = "scrollspy-section",
                p('Section 1-1')
            ),
            div(id = "section1-2",
                class = "scrollspy-section",
                p('Section 1-2')
            ),
            div(id = "section1-3",
                class = "scrollspy-section",
                p('Section 1-3')
            ),
            div(id = "section1-4",
                class = "scrollspy-section",
                p('Section 1-4')
            )              
          )
        )
    )
  ),

  # tab 2 contains 3 sections and a scrollspy on the right without text
  tabPanel(
    "tab2",
    div(id = "tab2-content",
        fluidRow(
          column(
            8,
            div(id = "section2-1",
                class = "scrollspy-section",
                p('Section 2-1')
            ),
            div(id = "section2-2",
                class = "scrollspy-section",
                p('Section 2-2')
            ),
            div(id = "section2-3",
                class = "scrollspy-section",
                p('Section 2-3')
            )
          ),
          column(
            4,
            div(
              id = "tab2-scrollspy",
              class = "potential-scrollspy",
              `data-offset` = 50,
              tags$ul(
                class = "nav nav-pills nav-stacked",
                tags$li(tags$a(href = "#section2-1")),
                tags$li(tags$a(href = "#section2-2")),
                tags$li(tags$a(href = "#section2-3"))
              )
            )
          )
        )
    )
  )
)

server <- function(input, output, session) {
  # when changing tabs, update the scrollspy control
  observeEvent(input$navbar, {
    js$updateScrollspy(input$navbar)
  })
}

shinyApp(ui = ui, server = server)

1 个答案:

答案 0 :(得分:1)

我现在自己正在研究此问题,结果发现navbarPage()函数中仅存在一个参数将为您完成此操作:

navbarPage(..., collapsible = TRUE)

然后可以通过按Ctrl-Shift-M进入(在Firefox中)进入“响应式设计模式”来测试其是否正常工作