从＆＃34; addDrawToolbar＆＃34;更改形状的颜色在R传单

Question

我希望能够编辑使用＆＃34; addDrawToolbar＆＃34;绘制的形状的颜色和不透明度。传单的特点。

我写了这个简单的ShinyApp，到目前为止，只允许我在地图上绘图：

library(shiny)
library(leaflet)
library(leaflet.extras)

ui = fluidPage(
  leafletOutput("map", height = 600)
)

server = function(input,output,session){
  output$map = renderLeaflet(
    leaflet()%>%
      addTiles(urlTemplate = "http://mt0.google.com/vt/lyrs=m&hl=en&x={x}&y={y}&z={z}&s=Ga")%>%
      addMeasure(
        primaryLengthUnit = "kilometers",
        secondaryAreaUnit = FALSE
        )%>%
      addDrawToolbar(
        targetGroup='draw',
        editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()),
        circleOptions = filterNULL(list(shapeOptions = drawShapeOptions(),
                                        repeatMode = F,
                                        showRadius = T,
                                        metric = T,
                                        feet = F,
                                        nautic = F))) %>%
      setView(lat = 45, lng = 9, zoom = 3)
  )
}

shinyApp(ui,server)

Answer 1

更新的答案 - 动态变化

您可以使用addStyleEditor。我不得不对地图高度进行一些更改，以便可以看到完整的样式编辑器。如果页面太短，它似乎消失了。

<强>代码

library(shiny)
library(leaflet)
library(leaflet.extras)

ui = fluidPage(
  tags$style(type = "text/css", "#map {height: calc(100vh - 20px) !important;}"),
  leafletOutput("map")
)

server = function(input,output,session){
  output$map = renderLeaflet(
    leaflet()%>%
      addTiles(urlTemplate = "http://mt0.google.com/vt/lyrs=m&hl=en&x={x}&y={y}&z={z}&s=Ga")%>%
      addMeasure(
        primaryLengthUnit = "kilometers",
        secondaryAreaUnit = FALSE
      )%>%
      addDrawToolbar(
        targetGroup='draw',
        editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()),
        circleOptions = filterNULL(list(shapeOptions = drawShapeOptions(),
                                        repeatMode = F,
                                        showRadius = T,
                                        metric = T,
                                        feet = F,
                                        nautic = F))) %>%
      setView(lat = 45, lng = 9, zoom = 3) %>%
      addStyleEditor(position = "topright", 
                     openOnLeafletDraw = TRUE)
  )
}

shinyApp(ui,server)

原始答案 - 静态变化

只需在drawShapeOptions中向circleOptions添加参数，如下所示：

shapeOptions = drawShapeOptions(color = "red",
                                fillOpacity = 1,
                                fillColor = "yellow",
                                weight = 20)

有关更改不透明度，颜色，填充等的更多选项，请参阅documentation

完整示例

library(shiny)
library(leaflet)
library(leaflet.extras)

ui = fluidPage(leafletOutput("map", height = 600))

server = function(input, output, session) {
  output$map = renderLeaflet(
    leaflet() %>%
      addTiles(urlTemplate = "http://mt0.google.com/vt/lyrs=m&hl=en&x={x}&y={y}&z={z}&s=Ga") %>%
      addMeasure(primaryLengthUnit = "kilometers",
                 secondaryAreaUnit = FALSE) %>%
      addDrawToolbar(targetGroup = 'draw',
                     editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()),
                     circleOptions = filterNULL(list(shapeOptions = drawShapeOptions(color = "red",
                                                                                     fillOpacity = 1,
                                                                                     fillColor = "yellow",
                                                                                     weight = 20),
                                                     repeatMode = F,
                                                     showRadius = T,
                                                     metric = T,
                                                     feet = F,
                                                     nautic = F))) %>%
      setView(lat = 45, lng = 9, zoom = 3)
  )
}

shinyApp(ui, server)