[英]How to save a leaflet map with drawn shapes/points on it in Shiny?
This question is a follow-up to the questions How to save a leaflet map in Shiny , and Save leaflet map in Shiny . 此问题是如何在Shiny中 保存传单地图以及在Shiny中 保存传单地图问题的后续。
I add a toolbar to draw shapes/points on the map that is addDrawToolbar
in the leaflet.extras package. 我添加工具栏的地图是上绘制形状/分
addDrawToolbar
在leaflet.extras包。 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.
最后,我希望能够将带有绘制形状的地图另存为pdf或png。
I have coded up the following making use of the answer to the question: How to save a leaflet map in Shiny . 我已经利用以下问题的答案编写了以下代码: 如何在Shiny中保存传单地图 。 But it does not help achieve my goal.
但这无助于实现我的目标。
Is there anyone who can help me? 有谁可以帮助我吗?
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)
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. 显然,
mapshot
函数不知道绘制的多边形,而只是存储干净的传单地图,因为它启动了一个隔离的后台进程来捕获Webshot。
I would propose this workaround, which captures the whole screen (using this batch -file) and saves it as png . 我将提出这种解决方法,该方法可捕获整个屏幕 (使用此批处理文件)并将其另存为png 。 ( only for Windows )
( 仅适用于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. 尽管它可以在批处理文件中进行修改,但它也可以捕获窗口和浏览器菜单栏,因此它不是很漂亮。
The batch-file must be in the same directory and must be named screenCapture.bat . 批处理文件必须位于同一目录中,并且必须命名为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)
To remove the browser and Windows toolbar , I manipulated the .bat-file like this: 为了删除浏览器和Windows工具栏 ,我对.bat文件进行了如下操作:
Line 66: 66行:
int height = windowRect.bottom - windowRect.top - 37;
Line 75: 第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.
这将隐藏工具栏,但底部将有一个黑条。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.