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

2022-01-12 00:00:00 r shiny leaflet javascript

这个问题是问题如何保存的后续问题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 函数不知道绘制的多边形，只存储干净的传单地图，因为它启动了一个隔离的后台进程捕获网络快照.

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.

我会提出这个解决方法，它捕获整个屏幕(使用这个 batch-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.

相关文章