Javascript 单击或将鼠标悬停在“信息框”上，即可反应性地更改其颜色

我想在

shiny

和

shinydashboard

中使用

reactiveValue

、

observeEvent

框架，以便在单击时能够反应性地更改信息框的颜色

我还希望它显示一个图像与一些文本在弹出框时，悬停在信息框

作为可复制示例的代码基础，请参见

但代码如下所示：

 library(shinydashboard)

  ui <- dashboardPage(
    dashboardHeader(title = "Info boxes"),
    dashboardSidebar(),
    dashboardBody(
      # infoBoxes with fill=FALSE
      fluidRow(
        # A static infoBox
        infoBox("New Orders", 10 * 2, icon = icon("credit-card")),
        # Dynamic infoBoxes
        infoBoxOutput("progressBox"),
        infoBoxOutput("approvalBox")
      ),

      # infoBoxes with fill=TRUE
      fluidRow(
        infoBox("New Orders", 10 * 2, icon = icon("credit-card"), fill = TRUE),
        infoBoxOutput("progressBox2"),
        infoBoxOutput("approvalBox2")
      ),

      fluidRow(
        # Clicking this will increment the progress amount
        box(width = 4, actionButton("count", "Increment progress"))
      )
    )
  )

  server <- function(input, output) {
    output$progressBox <- renderInfoBox({
      infoBox(
        "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
        color = "purple"
      )
    })
    output$approvalBox <- renderInfoBox({
      infoBox(
        "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
        color = "yellow"
      )
    })

    # Same as above, but with fill=TRUE
    output$progressBox2 <- renderInfoBox({
      infoBox(
        "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
        color = "purple", fill = TRUE
      )
    })
    output$approvalBox2 <- renderInfoBox({
      infoBox(
        "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
        color = "yellow", fill = TRUE
      )
    })
  }

  shinyApp(ui, server)

库（ShinydaShashboard）
ui您想做的事情完全可以通过CSS和JavaScript来完成，而不是使用闪亮。这里有一个可能的解决方案（有很多方法可以实现你想要的）

您悬停在上面的任何信息框都将变为灰色，当您单击它时，它将变为不同的灰色。当您将鼠标悬停在第一个信息框（左上角）上时，它还会显示一个带有图像的弹出窗口。
为了解决如何在悬停/单击时更改背景颜色的问题，我只添加了一点CSS。为了在悬停状态下有一个显示图像的弹出窗口，我使用了Bootstrap的popover。这很简单，希望有帮助

library(shinydashboard)

mycss <- "
.info-box:hover,
.info-box:hover .info-box-icon {
  background-color: #aaa !important;
}
.info-box:active,
.info-box:active .info-box-icon {
  background-color: #ccc !important;
}
"

withPopup <- function(tag) {
  content <- div("Some text and an image",
                 img(src = "http://thinkspace.com/wp-content/uploads/2013/12/member-logo-rstudio-109x70.png"))
  tagAppendAttributes(
    tag,
    `data-toggle` = "popover",
    `data-html` = "true",
    `data-trigger` = "hover",
    `data-content` = content
  )
}

ui <- dashboardPage(
  dashboardHeader(title = "Info boxes"),
  dashboardSidebar(),
  dashboardBody(
    tags$head(tags$style(HTML(mycss))),
    tags$head(tags$script("$(function() { $(\"[data-toggle='popover']\").popover(); })")),
    # infoBoxes with fill=FALSE
    fluidRow(
      # A static infoBox
      withPopup(infoBox("New Orders", 10 * 2, icon = icon("credit-card"))),
      # Dynamic infoBoxes
      infoBoxOutput("progressBox"),
      infoBoxOutput("approvalBox")
    ),

    # infoBoxes with fill=TRUE
    fluidRow(
      infoBox("New Orders", 10 * 2, icon = icon("credit-card"), fill = TRUE),
      infoBoxOutput("progressBox2"),
      infoBoxOutput("approvalBox2")
    ),

    fluidRow(
      # Clicking this will increment the progress amount
      box(width = 4, actionButton("count", "Increment progress"))
    )
  )
)

server <- function(input, output) {
  output$progressBox <- renderInfoBox({
    infoBox(
      "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
      color = "purple"
    )
  })
  output$approvalBox <- renderInfoBox({
    infoBox(
      "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
      color = "yellow"
    )
  })

  # Same as above, but with fill=TRUE
  output$progressBox2 <- renderInfoBox({
    infoBox(
      "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
      color = "purple", fill = TRUE
    )
  })
  output$approvalBox2 <- renderInfoBox({
    infoBox(
      "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
      color = "yellow", fill = TRUE
    )
  })
}

shinyApp(ui, server)

库（ShinydaShashboard）
mycss Hi h.l.m.当然这是可能的。最后，Shiny生成html，您可以添加任意多的html/Javascript/JQuery/CSS。只要您不使用闪亮的服务器运行它，它会为自己声明很多东西，让您几乎两手空空。例如，你可以看到：或者准备好进行一次深度潜水，或者坚持用闪亮的方式。这看起来真的很好，谢谢！没什么。。。为什么将鼠标悬停在左上角的信息框上才有效？不同的信息框会出现不同的图像？鼠标悬停将颜色更改为灰色看起来不错，但是有没有一种方法可以使当您单击信息框时，它会永久更改颜色或增加信息框中的值？关于前几个问题：如果您阅读代码并查看在我的版本和您的版本之间发生的更改，您将看到为什么只有左上角的框具有单击效果。如果您查看对
infoBox
的所有调用，您将看到，对于第一个调用，我将其包装为对
的调用，并使用popup
（这是我在代码中定义的函数）。是的，您可以使用diff图像，现在带有弹出窗口的
使用硬编码图像，您只需将图像源作为参数传递即可。如果你想让颜色永久地改变或增加值，你需要一些更复杂的Javascript…看起来你正在尝试做一些需要一些基本Javascript和CSS知识的事情。我强烈建议你花几个小时学习JS和CSS的基础知识，这样你就能使应用程序更加强大和灵活。