reactively thay đổi màu sắc của một hộp thông tin, khi một nhấp chuột hoặc di chuột qua

Question

Tôi muốn sử dụng khuôn khổ reactiveValue, observe, observeEvent trong shiny và shinydashboard để có thể reactively thay đổi màu sắc của một hộp thông tin khi nhấp vào.

Tôi cũng muốn hiển thị hình ảnh với một số văn bản trong hộp bật lên khi di chuột qua hộp thông tin.

Là một cơ sở mã như một ví dụ tái sản xuất, vui lòng xem this

Nhưng mã là availible dưới đây:

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) 

Là có thể?

Answer 1

Điều bạn muốn làm có thể hoàn toàn được thực hiện bằng CSS và JavaScript, không sáng bóng. Đây là một giải pháp khả thi (có nhiều cách để đạt được những gì bạn muốn).

Bất kỳ hộp thông tin nào bạn di chuột qua sẽ chuyển thành màu xám và khi bạn nhấp vào nó sẽ chuyển sang màu xám khác. Hộp thông tin đầu tiên (trên cùng bên trái) cũng sẽ hiển thị cửa sổ bật lên có hình ảnh trong đó khi bạn di chuột lên đó. Để giải quyết câu hỏi về cách thay đổi màu nền khi di chuột/nhấp, tôi vừa thêm một chút CSS. Để có cửa sổ bật lên hiển thị hình ảnh, tôi đã sử dụng cửa sổ bật lên của Bootstrap. Nó khá đơn giản, hy vọng nó sẽ giúp

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)