javascript - R Shiny 的动态弹出窗口(可以移动)

Question

我在仪表板上工作，我想创建一个动态弹出窗口，即我们可以移动。我可以创建一个弹出窗口，但这个是静态的，我喜欢那个可以接受它并向右、向左移动的...

我的弹出窗口示例:

library(shiny)
library(shinyBS)

shinyApp(

  ui =
    fluidPage(
      sidebarLayout(
        box(actionButton("tabBut", "View Table")),
        mainPanel(
          bsModal("modalExample", "Data Table", "tabBut", size = "large",
                  dataTableOutput("distTable"))))),

  server =
    function(input, output, session) {
      output$distTable <- renderDataTable({
        x    <- faithful[, 2]
        bins <- seq(min(x), max(x), length.out = 30 + 1)
        tab <- hist(x, breaks = bins, plot = FALSE)
        tab$breaks <- sapply(seq(length(tab$breaks) - 1), function(i) {
          paste0(signif(tab$breaks[i], 3), "-", signif(tab$breaks[i+1],    3))})
        tab <- as.data.frame(do.call(cbind, tab))
        colnames(tab) <- c("Bins", "Counts", "Density")
        return(tab[, 1:3])}, 
        options = list(pageLength=10))}
)

result

而且我希望用户可以移动这个窗口。如果您有更改选项的想法，或者如果您知道除 BS Shiny 之外的任何其他方式来创建新窗口...

提前谢谢你，对不起我的英语!

Answer 1

你可以尝试多次:

1) 添加脚本

2) 添加可拖动

3) 编辑CSS

喜欢:

 ui =
    fluidPage(
      tags$head(HTML('<script src="//code.jquery.com/jquery-1.10.2.js"></script>
                    <script src="//code.jquery.com/ui/1.11.2/jquery-ui.js"></script>')),
        tags$script(HTML('  $(window).load(function(){
                        $("#modalExample").draggable({
                        handle: ".modal-header"
                                   });
                                   });')),
            tags$style(HTML("
            .modal-backdrop.in {
                opacity: 0;
            }    
                ")),
      sidebarLayout(
        box(actionButton("tabBut", "View Table")),
        mainPanel(

          bsModal("modalExample", "Data Table", "tabBut", size = "large",
                  dataTableOutput("distTable")))))