传单地图无法在全屏视频中正确显示

Question

我的应用程序中有两个选项卡，当我进入视频选项卡并单击全屏然后返回我的传单页面时，地图无法正常显示，请参阅下面的代码和屏幕截图。

• 第 1 步：单击视频选项卡
• 第2步：点击（视频的）全屏按钮
• 第3步：按ESC键
• 第 4 步：单击仪表板选项卡

ui.R

library("shinydashboard")
library("shiny")
library("leaflet")

dashboardPage(
  header = dashboardHeader(), 
  sidebar = dashboardSidebar(disable = FALSE, 
                             collapsed = FALSE, 
                             sidebarMenu(
                               menuItem("Dashboard", tabName = "dashboard"),
                               menuItem("Video", tabName = "video")
                             )
  ), 
  body = dashboardBody(
    tabItems(
      tabItem(tabName = "dashboard",
        fluidRow(
          column(width = 9, box(width = NULL, solidHeader = TRUE, leafletOutput("map", height=700)))
        )
      ),
      tabItem(
        tabName = "video",
        fluidRow(
          column(width = 9, tags$video(src = "http://mirrors.standaloneinstaller.com/video-sample/jellyfish-25-mbps-hd-hevc.mp4", type = "video/mp4", height = "320px", 
                                       weight = "640px", controls = "controls")
          )
        )
      )
    )
  )
)

服务器.R

library("shinydashboard")
library("shiny")
library("leaflet")

function(input, output, session){
  output$map <- renderLeaflet(
    leaflet() %>% 
      addTiles() %>% 
      setView(lng = -77.0387185, lat = 38.8976763, zoom = 10)
  )
}

Answer 1

这对我来说似乎是一个错误，但我不确定在哪一侧，传单/闪亮仪表板还是闪亮的，因为在使用

fluidPage

和

tabsetPanel

时似乎也会发生这种情况。

解决方法是在窗口上触发假调整大小事件，因为这显然可以解决问题，即使是手动完成。

jscode

等待单击侧边栏菜单列表并触发新的调整大小事件。确保在 HTML 中包含 Jquery 代码，方法是将

tags$head(tags$script(jscode))

添加到

dashboardBody

。

library(shinydashboard)
library(shiny)
library(leaflet)

jscode = HTML("
$(document).on('shiny:connected', function() {
  $('.sidebar-menu li').on('click', function(){
    window.dispatchEvent(new Event('resize'));
  });
});
")

ui <- {dashboardPage(
  header = dashboardHeader(), 
  sidebar = dashboardSidebar(disable = FALSE, 
                             collapsed = FALSE, 
                             sidebarMenu(
                               menuItem("Dashboard", tabName = "dashboard"),
                               menuItem("Video", tabName = "video")
                             )
  ), 
  body = dashboardBody(
    tags$head(tags$script(jscode)),
    tabItems(
      tabItem(tabName = "dashboard",
              fluidRow(
                column(width = 9, box(width = NULL, solidHeader = TRUE, leafletOutput("map", height=700)))
              )
      ),
      tabItem(
        tabName = "video",
        fluidRow(
          column(width = 9, tags$video(src = "http://mirrors.standaloneinstaller.com/video-sample/jellyfish-25-mbps-hd-hevc.mp4", type = "video/mp4", height = "320px", 
                                       weight = "640px", controls = "controls")
          )
        )
      )
    )
  )
)}

server <- function(input, output, session){
  output$map <- renderLeaflet(
    leaflet() %>% 
      addTiles() %>% 
      setView(lng = -77.0387185, lat = 38.8976763, zoom = 10)
  )
}

shinyApp(ui, server)