如何在Shiny中保存带有绘制形状/点的传单地图？ [英] How to save a leaflet map with drawn shapes/points on it in Shiny?

问题描述

此问题是如何保存问题的后续问题Shiny 中的传单地图，以及在Shiny中保存传单。

This question is a follow-up to the questions How to save a leaflet map in Shiny, and Save leaflet map in Shiny.

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

I add a toolbar to draw shapes/points on the map that is addDrawToolbar in the leaflet.extras package. That lets users to draw lines, shapes, ... interactively. In the end I want one to be able to save the map with the drawn shapes as a pdf or png.

我编写了以下代码，使用了问题的答案：如何在Shiny中保存传单地图。但它无助于实现我的目标。

I have coded up the following making use of the answer to the question: How to save a leaflet map in Shiny. But it does not help achieve my goal.

有没有人可以帮助我？

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 函数我不知道绘制的多边形，只是存储干净的传单 - 地图，因为它启动了一个捕获webshot的隔离后台进程。

Apparently the mapshot function is not aware of drawn polygons and just stores the clean leaflet-map, as it launches an isolated background process which captures the webshot.

我会建议这个解决方法，其中捕获整个屏幕（使用此批处理 -file）并将其保存为 png 。 （仅适用于Windows ）

I would propose this workaround, which captures the whole screen (using this batch-file) and saves it as png. (only for Windows)

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

This is not very beautiful as it will also capture the windows and browser menu bars, although that could be adapted in the batch-file.

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

The batch-file must be in the same directory and must be named 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文件，如下所示：

To remove the browser and Windows toolbar, I manipulated the .bat-file like this:

第66行：

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

第75行：

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

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

This works on my machine, but you will have to adapt the values or even come up with a better solution, since I have to admit that I'm not too good at batch scripting. This will hide the toolbars, but there will be a black strip at the bottom.

这篇关于如何在Shiny中保存带有绘制形状/点的传单地图？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！