rshinyreportcaptureshinyscreenshot

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


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.


Solution

  • 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"))