在地图上单击，将坐标复制到剪贴板

Question

我希望这个应用程序在单击时立即将坐标复制到剪贴板。

换句话说，我想去掉复制按钮。

如果这是不可能的，我希望复制按钮出现在传单弹出窗口中。

library(shiny)
library(bslib)
library(rclipboard)
library(leaflet)

base_map <- leaflet() |> 
  addTiles()
# The UI
ui <- bslib::page_fluid(
  
  rclipboardSetup(),
  # Add a text input
  textInput("copytext", "Copy this:", "Co-Ordinates!"),
  # UI ouputs for the copy-to-clipboard buttons
  uiOutput("clip"),
  # A text input for testing the clipboard content.
  textInput("paste", "Paste here:"),
  leafletOutput("map")
  
)

# The server
server <- function(input, output, session) {
  
  # Add clipboard buttons
  output$clip <- renderUI({
    rclipButton(
      inputId = "clipbtn",
      label = "rclipButton Copy",
      clipText = input$copytext, 
      icon = icon("clipboard"),
    )
  })
  
  output$map <- renderLeaflet(base_map)
  
  observe({
    click <- input$map_click
    text <- paste0(click$lat, ", ", click$lng)
    
    leafletProxy("map") |>
      addPopups(
        lat = click$lat, 
        lng = click$lng, 
        popup = text
      )
    
    updateTextInput(session, "copytext", value = text)
  }) |> 
    bindEvent(input$map_click)
  
}

shinyApp(ui, server)

Answer 1

您可以使用 JavaScript

rclipboard

 API 来完成此操作，无需使用 

navigator.clipboard 等任何软件包。

在您的

ui

中添加一个闪亮的自定义消息处理程序函数，该函数需要一些文本并将其复制到剪贴板：

ui <- bslib::page_fluid(
  tags$script("
      Shiny.addCustomMessageHandler('txt', function (txt) {
        navigator.clipboard.writeText(txt);
    });
  "),  
  # Add a text input
  textInput("copytext", "Copy this:", "Co-Ordinates!"),
  # A text input for testing the clipboard content.
  textInput("paste", "Paste here:"),
  leafletOutput("map")
)

然后用您在 R 中创建的值更新此值，在服务器逻辑中将

session$sendCustomMessage("txt", text)

添加到观察事件：

server <- function(input, output, session) {

  output$map <- renderLeaflet(base_map)
  
  observe({
    click <- input$map_click
    text <- paste0(click$lat, ", ", click$lng)
    
    # Only this line is new
    session$sendCustomMessage("txt", text)
    
    leafletProxy("map") |>
      addPopups(
        lat = click$lat, 
        lng = click$lng, 
        popup = text
      )

    updateTextInput(session, "copytext", value = text)
  }) |> 
    bindEvent(input$map_click)
  
}

注意：根据您的 IDE，这可能无法在预览窗格中工作，因为可能不支持

navigator.clipboard

API。但是，它应该可以在任何现代浏览器中工作。