Question

此问题是对问题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)

Answer 1

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

我将建议这种解决方法，该方法捕获整个屏幕（使用此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);

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

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

1 个答案: