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

Question

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

我添加了一个工具栏，用于在leaflet.extras包中的addDrawToolbar地图上绘制形状/点。它允许用户绘制线条、形状。。。交互。最后，我希望能够将绘制形状的地图保存为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函数不知道绘制的多边形，只存储干净的传单地图，因为它启动了一个捕获网络快照的独立背景进程。

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

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