單擊或懸停在信息框上時，可響應地更改信息框的顏色

Question

我想在shiny和shinydashboard使用reactiveValue 、 observe 、 observeEvent框架，以便能夠在單擊時被動地改變infoBox 的顏色。

我還希望它在將鼠標懸停在 infoBox 上時在彈出框中顯示帶有一些文本的圖像。

作為可重現示例的代碼基礎，請參閱此

但是下面的代碼是可用的：

 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)

那可能嗎？

Answer 1

你想做的事情完全可以用 CSS 和 JavaScript 來完成，而不是閃亮。 這是一種可能的解決方案（有很多方法可以實現您想要的）。

您懸停在其上的任何信息框都將變為灰色，當您單擊它時，它將變為不同的灰色。 當您將鼠標懸停在第一個信息框（左上角）上時，它還會顯示一個帶有圖像的彈出窗口。 為了解決如何在懸停/單擊時更改背景顏色的問題，我只添加了一些 CSS。 為了在懸停時顯示圖像的彈出窗口，我使用了 Bootstrap 的彈出窗口。 很簡單，希望能幫到你

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)