带有闪亮的传单 - 如何确保为用户提供最大的放大选项

Posted 2023-03-24

【中文标题】带有闪亮的传单 - 如何确保为用户提供最大的放大选项

【英文标题】：Leaflet with Shiny - how to ensure maximum zoom in option for the user

【发布时间】：2021-12-27 11:53:48

【问题描述】：

对于其中一个地图用例，需要在闪亮的应用程序中为用户提供最大放大选项。已尝试按照以下代码探索一些选项。想了解这是否是我们在使用传单的闪亮应用程序中可以拥有的最大限制，或者我错过了一些东西，非常感谢这里的一些指导。 reactjs 网络应用程序之一，可以进一步放大 - 不过这里我们使用的是 bing / google 地图许可证。

field <- raster::shapefile("sampleShapleFile.shp") # shapefile (field) imported

library(leaflet)
library(leaflet.extras)

leaflet(data = field ,
        options = leafletOptions(zoomSnap = 0.25, zoomDelta = 0.25)) %>%
  addFullscreenControl(position = "topleft", pseudoFullscreen = FALSE) %>%
  addBingTiles(
    "Aq4GyoG8kzfeKO7Nsav5_BcjVVA_d1ULSTeXeW2zM0aPuANIqhvV5IrFtMjOGX3s",
    imagerySet = c("AerialWithLabels"),
    group = "AerialWithLabels",
    options = tileOptions(minZoom = 0, maxZoom = 18)
  ) %>%
  addPolygons(
    fill = FALSE,
    stroke = TRUE,
    weight = 5,
    opacity = 1,
    color = "#FFFFFF"
  ) %>%
  addLegend("bottomright", color = "#FFFFFF", labels = "Test") %>%
  addMeasure(
    position = "bottomleft",
    primaryLengthUnit = "meters",
    primaryAreaUnit = "sqmeters",
    activeColor = "#10bae0",
    completedColor = "#241ad9"
  ) %>%
  addDrawToolbar(
    targetGroup = 'draw',
    polygonOptions = FALSE,
    circleOptions = FALSE,
    rectangleOptions = FALSE,
    markerOptions = FALSE,
    circleMarkerOptions = FALSE,
    editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())
  ) %>%
  addScaleBar(position = "topright",
              options = scaleBarOptions(
                maxWidth = 1,
                metric = TRUE,
                imperial = FALSE
              ))

【问题讨论】：

我不确定我是否完全理解您的问题，但是您是否探索过 setView leaflet？我发现在 setView 中使用 zoom 参数可以很好地控制缩放。

@SusanSwitzer 感谢您的回复 .... 使用 setView 我可以提供特定的缩放级别.....在这种情况下，使用 scaleBar ( + , - ) 用户控制缩放级别 ( Zoom In / Out) ,有没有办法可以进一步放大

【参考方案1】：

“addTiles”中的“maxNativeZoom”和“maxZoom”选项可用于增强 Google/Bing 地图的放大级别

有用的参考链接： https://gis.stackexchange.com/questions/78843/zoom-further-in-than-level-19-with-leaflet-javascript-api

https://github.com/digidem/leaflet-bing-layer/issues/8

## app.R ##
library(shiny)
library(shinydashboard)
library(leaflet)
library(leaflet.extras)

ui <- dashboardPage(dashboardHeader(),
                    dashboardSidebar(),
                    dashboardBody(leafletOutput("map")))

server <- function(input, output) 
  field <-
    raster::shapefile("sample.shp") # shapefile (field) imported
  
  
  
  output$map <- renderLeaflet(
    leaflet(data = field) %>%
      addFullscreenControl(position = "topleft", pseudoFullscreen = FALSE) %>%
      # addTiles(
      #   group = "Satellite",
      #   urlTemplate = "http://mt0.google.com/vt/lyrs=s&hl=en&x=x&y=y&z=z&s=Ga",
      #   options = tileOptions(maxZoom = 21 , maxNativeZoom = 18)
      # ) %>%
      addBingTiles("Aq4GyoG8kzfeKO7Nsav5_BcjVVA_d1ULSTeXeW2zM0aPuANIqhvV5IrFtMjOGX3s",
                   imagerySet = c("AerialWithLabels"),group = "AerialWithLabels",
                   maxNativeZoom = 18,maxZoom = 21
                   ) %>%
      addPolygons(
        fill = FALSE,
        stroke = TRUE,
        weight = 5,
        opacity = 1,
        color = "#FFFFFF"
      ) %>%
      addLegend("bottomright", color = "#FFFFFF", labels = "Test") %>%
      addMeasure(
        position = "bottomleft",
        primaryLengthUnit = "meters",
        primaryAreaUnit = "sqmeters",
        activeColor = "#10bae0",
        completedColor = "#241ad9"
      ) %>%
      addDrawToolbar(
        targetGroup = 'draw',
        polygonOptions = FALSE,
        circleOptions = FALSE,
        rectangleOptions = FALSE,
        markerOptions = FALSE,
        circleMarkerOptions = FALSE,
        editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())
      ) %>%
      addScaleBar(
        position = "topright",
        options = scaleBarOptions(
          maxWidth = 10,
          metric = TRUE,
          imperial = FALSE
        )
      )
    
  )
  
  


shinyApp(ui, server)