如何在 Shiny 中保存带有绘制形状/点的传单地图？答案

【问题标题】：How to save a leaflet map with drawn shapes/points on it in Shiny?如何在 Shiny 中保存带有绘制形状/点的传单地图？
【发布时间】：2019-05-08 01:40:07
【问题描述】：

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

我在leaflet.extras 包中的addDrawToolbar 的地图上添加了一个工具栏来绘制形状/点。这让用户可以交互地绘制线条、形状……。最后，我希望能够将带有绘制形状的地图保存为 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)

【问题讨论】：

看了SeGa的回答后，我把问题移到mapview，看看有没有人能帮助我们更好地理解这种情况。

标签： javascript r shiny leaflet

【解决方案1】：

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

我会提出这个解决方法，它捕获整个屏幕（使用这个batch-file）并将其保存为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);

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

【讨论】：