How do I take a screenshot of a shiny app upon button click?

Question

I have included a minimal example to work with. There is a download button, which upon click should download the shiny app screenshot as a pdf. The code is as follows.

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)

Thanks in advance!

Answer 1

For anyone who comes here after October 2020:

You can use the new shinyscreenshot package, which is as simple as calling shinyscreenshot::screenshot() and it will download a PNG file automatically.

Example:

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)

Answer 2

As mentioned in the comments, I tried to use the RSelenium package to take a screenshot inside a Shiny-App. But apparently there is the same problem as with webshots. The session gets blocked, so phantomjs cannot access the website.

I found a solution that works on Windows, but it requires this batch file and it will take a screenshot of the whole screen, not just the shiny-App. For Linux there are a lot of other tools which enable you to take screenshots per command-line, like ImageMagick or scrot.

Put the .bat-file in the same directory as your shiny-app, load the app, click download, allow the programm for windows/anti-virus and it will take a screenshot of your window.

You can also save several pictures, although I would come up with a more sophisticated naming method than mine. ;)

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)

To remove the browser and Windows toolbar, I manipulated the .bat-file a bit.

Line 66:

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

Line 75:

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

This works on my machine, but you will have to adapt the values or even come up with a better solution, since I have to admit that I'm not too good at batch scripting. This will hide the toolbars, but there will be a black strip at the bottom.

---

This is the experiment with RSelenium, which did not work.

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)