我希望此应用程序在点击后立即将坐标复制到剪贴板.

换句话说,我想摆脱复制按钮.

如果不可能,我希望在传单弹出窗口中出现复制按钮.

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)

推荐答案

rclipboardclipboard.js的R包装.使用JavaScript navigator.clipboard API和Shiny to JavaScript API,我们可以在没有这些依赖性的情况下实现您的目标.

定义JS函数将文本写入到剪贴板

在您的ui中添加shiny custom message handler.在本例中,是一个获取一些文本并将其复制到剪贴板的函数:

ui <- bslib::page_fluid(
  tags$script("
      Shiny.addCustomMessageHandler('txt', function (txt) {
        navigator.clipboard.writeText(txt);
    });
  "), # <- This is the only new UI element 
  textInput("copytext", "Copy this:", "Co-Ordinates!"),
  textInput("paste", "Paste here:"),
  leaflet输出("map")
)

将R中创建的坐标字符串传递给JS函数

在您的服务器逻辑中,将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)
  
}

输出

enter image description here

浏览器兼容性

根据您的IDE,这可能在预览面板中不起作用,因为可能不支持navigator.clipboard API.它应该在任何现代浏览器中工作.自2018年以来,Chrome、Firefox和歌剧院一直支持navigator.clipboard.writeText(),自2020年以来,Safari和Edge一直支持navigator.clipboard.writeText().有关更多浏览器兼容性详细信息,请参阅here.

R相关问答推荐

无法运行通过R中的Auto.arima获得的ARIMA模型

geom_Ribbon条件填充创建与数据不匹配的形状(ggplot 2 r)

如何使用stat_extract_all正确提取我的目标值?

R等效于LABpascal(n,1)不同的列符号

R箱形图gplot 2 4组但6个参数

如何使用R中的dhrr函数将李克特量表的因子列从长转换为宽?

从开始时间和结束时间导出时间

R Sapply函数产生的值似乎与for循环方法略有不同

为什么我的基准测试会随着样本量的增加而出现一些波动?

如何在R forestplot中为多条垂直线分配唯一的 colored颜色 ?

从多个线性回归模型中提取系数

按多列统计频次

R:用GGPLATE,如何在两个独立的变量中制作不同形状的散点图?

调换行/列并将第一行(原始数据帧的第一列)提升为标题的Tidyr类似功能?

我将工作代码重构为一个函数--现在我想不出如何传递轴列参数

ggplot R:X,Y,Z使用固定/等距的X,Y坐标绘制六边形热图

将列的值乘以在不同数据集中找到的值

每行不同列上的行求和

重写时间间隔模糊连接以减少内存消耗

臭虫?GradeThis::grade_this_code()在`-code-check`块中失败