如何在按下按钮时截取闪亮应用的屏幕截图?

adh*_*hok 9 r shiny

我已经包含了一个最小的例子.有一个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)
Run Code Online (Sandbox Code Playgroud)

提前致谢!

SeG*_*eGa 2

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

我找到了一个适用于 Windows 的解决方案,但它需要这个批处理文件,并且它将截取整个屏幕的屏幕截图,而不仅仅是闪亮的应用程序。对于 Linux,还有许多其他工具可以让您通过命令行截取屏幕截图,例如ImageMagickscrot

将 .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)
Run Code Online (Sandbox Code Playgroud)

为了删除浏览器和 Windows 工具栏,我对 .bat 文件进行了一些操作。

第 66 行:

int height = windowRect.bottom - windowRect.top - 37;
Run Code Online (Sandbox Code Playgroud)

第 75 行:

GDI32.BitBlt(hdcDest, 0, -80, width, height, hdcSrc, 0, 0, GDI32.SRCCOPY);
Run Code Online (Sandbox Code Playgroud)

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


这是实验过的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)
Run Code Online (Sandbox Code Playgroud)