Home > OS >  Can't take a screenshot from a shiny app with background image to use it as a report
Can't take a screenshot from a shiny app with background image to use it as a report

Time:11-27

I have this simplified app:

library(shiny)
library(shinyWidgets)
library(shinyscreenshot)
library(capture)

my_ids <- LETTERS[1:13]

ui <- fluidPage(

  #background image
  tags$img(
    src = "http://upload.wikimedia.org/wikipedia/commons/5/5d/AaronEckhart10TIFF.jpg",
    style = 'position: absolute; position: absolute;
      width: 1250px; height: 880px;'
  ),

  div(id = "container1",
      style="position: absolute;left: 30px; top: 170px; display: inline-block;vertical-align:middle; width: 300px;",
      radioGroupButtons(inputId = my_ids[1], label = "", choices = 0:3, selected = 0, checkIcon = list(yes = icon("check")), status = c("zero", "one", "two", "three"))
  ),

  div(style="position: absolute;left: 10px; top: 830px;",
      capture::capture(
        selector = "body",
        filename = "all-page.png",
        icon("camera"), "Take screenshot of all page"
      ))
)

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

  observeEvent(input$update, {
    updateRadioGroupButtons(session = session, inputId = my_ids[1], selected = 0)
  }, ignoreInit = TRUE)

}

shinyApp(ui, server)

In this app we have a background picture and the user can press some buttons that will generate a value shown on the background picture. The app works well.

Now I would like to take a screenshot of the picture with all elements on it (like buttons etc. to use it as a report.

How can I do this. I tried shinyscreenshot and capture.

I need the screenshot to print as a report on a DIN A4 format.

CodePudding user response:

Here is what I get after numerous trials and errors. This solution uses the JavaScript libraries jspdf and domtoimage.

The result is a pdf file in format A4. Unfortunately, that does not work with the icon.

library(shiny)
library(shinyWidgets)

js <- "
    function Export(){
      var $img = $('#img');
      var width = $img.width();
      var height = $img.height();
      domtoimage.toPng($('html')[0])
        .then(function (blob) {
          var pdf = new jsPDF('p', 'mm', 'a4');
          var imgProps = pdf.getImageProperties(blob);
          var pdfWidth = pdf.internal.pageSize.width;
          var pdfHeight = pdf.internal.pageSize.height;
          var widthRatio = pdfWidth / width;
          var heightRatio = pdfHeight / height;
          var ratio = Math.min(widthRatio, heightRatio);
          var w = imgProps.width * ratio;
          var h = imgProps.height * ratio;
          pdf.addImage(blob, 'PNG', 0, 0, w, h);
          pdf.save('allPage.pdf');
        });
    }
    "

my_ids <- LETTERS[1:13]

ui <- fluidPage(
  tags$head(
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jspdf/1.5.3/jspdf.min.js"),
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/dom-to-image/2.6.0/dom-to-image.min.js"),
    tags$script(HTML(js))
  ),
  
  #background image
  tags$img(
    id = "img",
    src = "http://upload.wikimedia.org/wikipedia/commons/5/5d/AaronEckhart10TIFF.jpg",
    style = 'position: absolute; width: 1250px; height: 880px;'
  ),
  
  div(id = "container1",
      style="position: absolute; left: 30px; top: 170px; display: inline-block; vertical-align: middle; width: 300px;",
      radioGroupButtons(
        inputId = my_ids[1], label = "", choices = 0:3, selected = 0, 
        #checkIcon = list(yes = icon("check")), 
        status = c("zero", "one", "two", "three")
      ),
      actionButton(
        "export", "Export to PDF", 
        onclick = "Export();"
      )
  )
  
)

server <- function(input, output, session){
  
  observeEvent(input$update, {
    updateRadioGroupButtons(session = session, inputId = my_ids[1], selected = 0)
  }, ignoreInit = TRUE)
  
}

shinyApp(ui, server)

EDIT

For the icon, you can use this CSS:

css <- ".check {position: absolute; left: 0; top: 50%; transform: translateY(-50%); display: inline-block; text-rendering: auto; line-height: 1}
.check:before {content: '\\2713';}"

and then:

checkIcon = list(yes = tags$i(class = "check", role = "presentation"))
  • Related