在行上雙擊R Shiny中的數據表中的圖像彈出窗口

Question

我希望在數據表中的行上雙擊彈出一個圖像。 我編寫的當前代碼在雙擊該行時顯示警告消息。 我想用圖像替換該警報消息。 建議實現相同。

碼

library(shiny)
library(shinydashboard)
library(DT)

ui <- shinyUI(

dashboardPage (
dashboardHeader(title="Report"),
dashboardSidebar(sidebarMenu(menuItem("Table",tabName="Table"))),
dashboardBody(      
  tabItems(
    tabItem(tabName = "Table",
            DT::dataTableOutput("DataTable")    
    )
  ))

))

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

output$DataTable <- DT::renderDataTable({
datatable(iris,rownames=FALSE,selection = 'single',options = list(
  searching = FALSE,ordering=FALSE,
  dom = 'Bfrtip',
  buttons = c('copy','excel', 'pdf', 'print', 'colvis'),
  columnDefs = list(list(visible=FALSE, targets=c(2))),
  rowCallback = JS(
    "function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {",
    "var full_text = aData[2]",
    # Tooltip for the rows
    "$('td:eq(1)', nRow).attr('title', full_text);",
    # Showing a hand as a cursor
    "$('td:eq(1)', nRow).css('cursor','pointer');",
    "$('td:eq(1)', nRow).css('font-weight','bold');",
    "}")
  ),
 #On double Click show Alert Message
 callback = JS('
              table.on("dblclick.dt","tr", function() {
              var data=table.row(this).data();
              alert("You clicked on "+data[4]+"\'s row");} 
              )
              ')    )
})
})

shinyApp(ui,server)

Answer 1

使用“ SweetAlert”代替傳統的JS Alert彈出窗口在“數據表”行單擊上添加圖像。

編輯：

請從此鏈接https://github.com/t4t5/sweetalert下載Sweet Alert插件JS和CSS文件，並將這兩個文件放在www文件夾中。 文件位置-sweetalert-master \\ dist

這是最終代碼：

library(shiny)
library(shinydashboard)
library(DT)

ui <- shinyUI(

dashboardPage (
dashboardHeader(title="Report"),
dashboardSidebar(sidebarMenu(menuItem("Table",tabName="Table"))),
dashboardBody(
  # JS Script and CSS for SweetAlert Plugin
  tags$head(HTML("<script type='text/javascript' src='sweetalert.min.js'>   </script>")),
  tags$head(
       tags$link(rel = "stylesheet", type = "text/css", href = "sweetalert.css")
    ),
  tabItems(
    tabItem(tabName = "Table",
            DT::dataTableOutput("DataTable")    
    )
  ))

))

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

output$DataTable <- DT::renderDataTable({
datatable(iris,rownames=FALSE,selection = 'single',options = list(
  searching = FALSE,ordering=FALSE,
  dom = 'Bfrtip',
  buttons = c('copy','excel', 'pdf', 'print', 'colvis'),
  columnDefs = list(list(visible=FALSE, targets=c(2))),
  rowCallback = JS(
    "function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {",
    "var full_text = aData[2]",
    # Tooltip for the rows
    "$('td:eq(1)', nRow).attr('title', full_text);",
    # Showing a hand as a cursor
    "$('td:eq(1)', nRow).css('cursor','pointer');",
    "$('td:eq(1)', nRow).css('font-weight','bold');",
    "}")
 ),
 #On double Click show Alert Message
 callback = JS('
              table.on("dblclick.dt","tr", function() {
              var data=table.row(this).data();
          swal({
          title: "Sweet!",
          text: "Here a custom image.",
          imageUrl: "http://wallpaper-gallery.net/images/high-resolution-    image/high-resolution-image-2.jpg",
          imageSize: "400x300"
          });
} 
)
  '))
})
})

shinyApp(ui,server)