此问题是问题 How to save a leaflet map in Shiny 的后续问题, 和 Save leaflet map in Shiny .

我在 leaflet.extras 包中添加了一个工具栏来在 map 上绘制形状/点，即 addDrawToolbar。这让用户可以交互式地绘制线条、形状……。最后，我希望能够将带有绘制形状的 map 保存为 pdf 或 png。

我使用问题的答案编写了以下代码:How to save a leaflet map in Shiny .但这无助于实现我的目标。

有没有人可以帮助我？

library(shiny)
library(leaflet)
library(leaflet.extras)
library(mapview)


ui <- fluidPage(

    leafletOutput("map"),
    br(),
    downloadButton("download_pdf", "Download .pdf")
)

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


     foundational_map <- reactive({

        leaflet() %>% 

          addTiles()%>%

          addMeasure(
              primaryLengthUnit = "kilometers",
              secondaryAreaUnit = FALSE
           )%>%

          addDrawToolbar(
               targetGroup='draw',

               editOptions = editToolbarOptions(selectedPathOptions = 
                                       selectedPathOptions()),

                polylineOptions = filterNULL(list(shapeOptions = 
                                        drawShapeOptions(lineJoin = "round", 
                                        weight = 3))),

                circleOptions = filterNULL(list(shapeOptions = 
                                      drawShapeOptions(),
                                      repeatMode = F,
                                      showRadius = T,
                                      metric = T,
                                      feet = F,
                                      nautic = F))) %>%
           setView(lat = 45, lng = 9, zoom = 3) %>%
           addStyleEditor(position = "bottomleft", 
                 openOnLeafletDraw = TRUE)
 })


 output$map <- renderLeaflet({

         foundational_map()
                    })


 user_created_map <- reactive({

           foundational_map() %>%

            setView(lng = input$map_center$lng, lat = input$map_center$lat, 
                           zoom = input$map_zoom)
             })


 output$download_pdf <- downloadHandler(

         filename = paste0("map_", Sys.time(), ".pdf"),

         content = function(file) {
                 mapshot(user_created_map(), file = file)
  }
 )



 }

 shinyApp(ui = ui, server = server)

最佳答案

显然 mapshot 函数并不知道绘制的多边形，只存储干净的传单 map ，因为它启动了一个独立的后台进程来捕获网络截图。

我建议采用此解决方法，它捕获整个屏幕(使用此 batch 文件)并将其保存为 png。 (仅适用于 Windows)

这不是很漂亮，因为它还会捕获窗口和浏览器菜单栏，尽管这可以在批处理文件中进行调整。

批处理文件必须在同一目录中，并且必须命名为 screenCapture.bat。

library(shiny)
library(leaflet)
library(leaflet.extras)
library(mapview)

ui <- fluidPage(
  leafletOutput("map"),
  actionButton("download_pdf", "Download .pdf")
)

server <- function(input, output, session) {
  foundational_map <- reactive({
    leaflet() %>%
      addTiles()%>%
      addMeasure(
        primaryLengthUnit = "kilometers",
        secondaryAreaUnit = FALSE
      )%>%
      addDrawToolbar(
        targetGroup='draw',
        editOptions = editToolbarOptions(selectedPathOptions = 
                                           selectedPathOptions()),
        polylineOptions = filterNULL(list(shapeOptions = 
                                            drawShapeOptions(lineJoin = "round", 
                                                             weight = 3))),
        circleOptions = filterNULL(list(shapeOptions = 
                                          drawShapeOptions(),
                                        repeatMode = F,
                                        showRadius = T,
                                        metric = T,
                                        feet = F,
                                        nautic = F))) %>%
      setView(lat = 45, lng = 9, zoom = 3) %>%
      addStyleEditor(position = "bottomleft", 
                     openOnLeafletDraw = TRUE)
  })
  output$map <- renderLeaflet({
    foundational_map()
  })
  user_created_map <- reactive({
    foundational_map()
  })

  ## observeEvent which makes a call to the Batch-file and saves the image as .png
  observeEvent(input$download_pdf, {
    img = paste0("screen", runif(1,0,1000), ".png")
    str = paste('call screenCapture ', img)
    shell(str)
  })

}

shinyApp(ui = ui, server = server)

为了删除浏览器和 Windows 工具栏，我像这样操作 .bat 文件:

第 66 行:

int height = windowRect.bottom - windowRect.top - 37;

第 75 行:

GDI32.BitBlt(hdcDest, 0, -80, width, height, hdcSrc, 0, 0, GDI32.SRCCOPY);

这适用于我的机器，但您必须调整这些值，甚至想出更好的解决方案，因为我不得不承认我不太擅长批处理脚本。这将隐藏工具栏，但底部会有一个黑色 strip 。

关于javascript - 如何在 Shiny 中保存带有绘制形状/点的传单 map ？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/53650039/