如何在闪亮应用程序的平移和缩放功能中添加控件？

Posted 2023-02-14

【中文标题】如何在闪亮应用程序的平移和缩放功能中添加控件？

【英文标题】：How to add controls in pan&zoom functionality in shiny app?

【发布时间】：2022-01-19 15:52:13

【问题描述】：

我使用panzoom 包来平移和缩放我闪亮的应用程序中的 svg 文件。有没有办法拥有像this 这样的控件？

library(shiny)
library(DiagrammeR)
library(magrittr)

ui <- fluidPage(
  tags$head(
    tags$script(src = "https://unpkg.com/panzoom@9.4.0/dist/panzoom.min.js")
  ),

  grVizOutput("grr", width = "100%", height = "90vh"),

  tags$script(
    html('panzoom($("#grr")[0])')
  )
)

server <- function(input, output) 

  reactives <- reactiveValues()

  observe(
    reactives$graph <- render_graph(create_graph() %>%
                                      add_n_nodes(n = 2) %>%
                                      add_edge(
                                        from = 1,
                                        to = 2,
                                        edge_data = edge_data(
                                          value = 4.3)))
  )

  output$grr <- renderGrViz(reactives$graph)



shinyApp(ui, server)

【问题讨论】：

选项记录在here。你想做什么？

类似bumbu.me/svg-pan-zoom/demo/inline.html

【参考方案1】：

这是一种方法，但如果您在 +/- 按钮上单击过快，则会产生不良影响。

library(shiny)
library(shinyWidgets)
library(DiagrammeR)
library(magrittr)

js <- '
$(document).ready(function()
  var element = document.getElementById("grr");
  var instance = panzoom(element);
  $("#zoomout").on("click", function()
    instance.smoothZoom(0, 0, 0.9);
  );
  $("#zoomin").on("click", function()
    instance.smoothZoom(0, 0, 1.1);
  );
);
'

ui <- fluidPage(
  tags$head(
    tags$script(src = "https://unpkg.com/panzoom@9.4.0/dist/panzoom.min.js"),
    tags$script(HTML(js))
  ),

  grVizOutput("grr", width = "100%", height = "90vh"),

  actionGroupButtons(
    inputIds = c("zoomout", "zoomin"),
    labels = list(icon("minus"), icon("plus")),
    status = "primary"
  )

)

server <- function(input, output) 

  reactives <- reactiveValues()

  observe(
    reactives$graph <- render_graph(
      create_graph() %>%
        add_n_nodes(n = 2) %>%
        add_edge(
          from = 1,
          to = 2,
          edge_data = edge_data(
            value = 4.3
          )
        )
      )
  )

  output$grr <- renderGrViz(reactives$graph)



shinyApp(ui, server)

---

编辑

添加此 javascript 以防止不良影响：

  $("#zoomout").on("dblclick", function()
    return false;
  );
  $("#zoomin").on("dblclick", function()
    return false;
  );

【讨论】：

谢谢，也许你可以帮助你在闪亮的***.com/questions/70356501/…987654321@方面的专业知识

如何添加重置按钮？ ***.com/questions/70397174/…