如何在按钮单击时截取闪亮的应用程序的屏幕截图？答案

【问题标题】：How do I take a screenshot of a shiny app upon button click?如何在按钮单击时截取闪亮的应用程序的屏幕截图？
【发布时间】：2017-07-31 12:45:42
【问题描述】：

我已经包含了一个可以使用的最小示例。有一个download 按钮，单击该按钮应将闪亮的应用程序屏幕截图下载为pdf。代码如下。

library(shiny)
server <- function(input, output) {
  output$distPlot <- renderPlot({
    hist(rnorm(input$obs), col = 'darkgray', border = 'white')
  })

}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100),
      actionButton("btn", "Download")

    ),
    mainPanel(plotOutput("distPlot"))
  )
)

shinyApp(ui = ui, server = server)

提前致谢！

【问题讨论】：

也许你需要appshot包
我试过了。但我不确定如何在闪亮中运行它。
我认为 webshot 还不可能。请参阅此issue。也许它与RSelenium 合作。看到这个answer

标签： r shiny

【解决方案1】：

正如 cmets 中提到的，我尝试使用 RSelenium 包在 Shiny-App 中截取屏幕截图。但显然与webshots 存在相同的问题。会话被阻止，因此phantomjs 无法访问该网站。

我找到了一个适用于 Windows 的解决方案，但它需要 this 批处理文件，它会截取整个屏幕的屏幕截图，而不仅仅是闪亮的应用程序。对于 Linux，还有很多其他工具可以让您按命令行截取屏幕截图，例如 ImageMagick 或 scrot。

将 .bat 文件与您的闪亮应用程序放在同一目录中，加载应用程序，单击下载，允许 windows/防病毒程序，它会截取您的窗口。

你也可以保存几张图片，虽然我会想出一个比我更复杂的命名方法。 ;)

library(shiny)
library(RSelenium)

ui <- {fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100),
      actionButton("btn", "Download")
    ),
    mainPanel(plotOutput("distPlot"))
  )
)}

server <- function(input, output, session) {
  output$distPlot <- renderPlot({
    hist(rnorm(input$obs), col = 'darkgray', border = 'white')
  })

  observeEvent(input$btn, {
    img = paste0("screen", runif(1,0,1000), ".png")
    str = paste('call screenCapture ', img)
    shell(str)
  })
}

shinyApp(ui = ui, server = server)

为了删除浏览器和 Windows 工具栏，我稍微操作了 .bat 文件。

第 66 行：

int height = windowRect.bottom - windowRect.top - 37;

第 75 行：

GDI32.BitBlt(hdcDest, 0, -80, width, height, hdcSrc, 0, 0, GDI32.SRCCOPY);

这适用于我的机器，但您必须调整这些值，甚至想出更好的解决方案，因为我不得不承认我不太擅长批处理脚本。这将隐藏工具栏，但底部会有一个黑色条带。

这是RSelenium 的实验，不起作用。

library(shiny)
library(RSelenium)

ui <- {fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100),
      actionButton("btn", "Download")

    ),
    mainPanel(plotOutput("distPlot"))
  )
)}

server <- function(input, output, session) {
  output$distPlot <- renderPlot({
    hist(rnorm(input$obs), col = 'darkgray', border = 'white')
  })

  observeEvent(input$btn, {
    cdat <- session$clientData
    url <- paste0(cdat$url_protocol,"//",cdat$url_hostname,":", cdat$url_port, cdat$url_pathname,cdat$url_search)
    rD <- rsDriver(browser = "firefox", chromever=NULL)
    remDr <- rD$client
    remDr$navigate(url)
    remDr$screenshot(file = tf <- tempfile(fileext = ".png"))
    shell.exec(tf) # on windows
    remDr$close()
    rD$server$stop()
  })
}

shinyApp(ui = ui, server = server)

【讨论】：

【解决方案2】：

对于 2020 年 10 月之后来到这里的任何人：

你可以使用新的shinyscreenshot包，就像调用shinyscreenshot::screenshot()一样简单，它会自动下载一个PNG文件。

例子：

library(shiny)
library(shinyscreenshot)

ui <- fluidPage(
  textInput("text", "Enter some text", "test"),
  actionButton("go", "Take a screenshot")
)

server <- function(input, output) {
  observeEvent(input$go, {
    screenshot()
  })
}

shinyApp(ui, server)

【讨论】：