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

Question

这个问题是如何在Shiny中保存传单地图以及在Shiny中保存传单地图的问题的后续问题.

我添加了一个工具栏,用于addDrawToolbar在leaflet.extras包中的地图上绘制形状/点.这可以让用户以交互方式绘制线条,形状...... 最后,我希望能够将绘制的形状保存为pdf或png.

我编写了以下代码,使用了问题的答案:如何在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)

Answer 1

显然,该mapshot功能不知道绘制的多边形,只是存储干净的传单 - 地图,因为它启动了一个捕获webshot的独立后台进程.

我建议这个解决方法,它捕获整个屏幕(使用此批处理文件)并将其保存为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);

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