在行上双击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)