I have a ColourPicker that I use to determine the background color of an action button. What I would like to do is click on the action button and have the hex code that was clicked from the ColourPicker be copied to my clipboard. The goal is to then paste that value to be the background color in a cell of a data table. Right now, I am mostly worried about the copying part.
I have a button that I can copy-button so I can copy a text value, which is easy enough, but this is not what I am trying to do. What I would like to do is copy the hex code from the small button that is generated in my code, which can change color based on the color selected by the ColourPicker, and access just the hex code value of that button.
Do I need to reference the ID of the ColourPicker in order to access the hex code? Or could I just copy that hex code straight from the button? I haven't been able to find any packages that work with getting hex codes from objects.
For reference, this is basically what I have (much thanks again to @lz100)
library(shiny)
library(shinythemes)
library(sortable)
library(colourpicker)
library(glue)
library(png)
library(dplyr)
library(DT)
library(rclipboard)
# funcs
plate96 <- function(id) {
div(
style = "position: relative; height: 500px",
tags$style(HTML(
'
.wells {
height: 490px;
width: 750px;
overflow: hidden;
min-height: 20px;
padding: 19px;
margin-bottom: 20px;
border: 1px solid #e3e3e3;
border-radius: 4px;
-webkit-box-shadow: inset 0 1px 1px rgb(0 0 0 / 5%);
box-shadow: inset 0 1px 1px rgb(0 0 0 / 5%);
position: relative;
transform: translateX(50%);
}
.wells:after {
content: "";
height: 450px;
width: 690px;
border: 1px solid;
position: absolute;
transform: translate(15px, -100%);
z-index: -1;
}
.wells .corner-top {
position: absolute;
margin: -20px;
width: 43px;
height: 34px;
transform: rotate(45deg);
background-color: white;
z-index: 1;
left: 30px;
border-right: 1px solid;
}
.wells .corner-bot {
position: absolute;
margin: -20px;
width: 40px;
height: 40px;
transform: rotate(45deg);
background-color: white;
z-index: 1;
left: 35px;
bottom: 20px;
border-top: 1px solid;
}
.wells .html-widget {
transform: translateX(20px);
}
.wells thead tr th {
font-weight: 100;
}
.wells table:after {
content: "";
border: 1px solid #ccc;
position: absolute;
height: 410px;
width: 635px;
z-index: -1;
transform: translate(33px, -99%);
}
.wells table.dataTable.no-footer {
border-spacing: 3px;
border-bottom: unset;
}
.wells table.dataTable thead th {
border-bottom: unset;
}
.wells tbody tr td:not(:first-of-type) {
border-radius: 50%;
border: 1px solid black;
height: 15px;
width: 15px;
padding: 15px;
font-size: 0;
}
.wells table.dataTable.cell-border tbody tr td:first-of-type {
border: unset;
border-right: 1px solid #ccc;
font-weight: 900;
}
'
)),
div(
style = "position: absolute; left: 50%; transform: translateX(-100%);",
div(
class = "wells",
div(class = "corner-top"),
div(class = "corner-bot"),
DT::dataTableOutput(id, width = "90%", height= "100%")
)
)
)
}
renderPlate96 <- function(id, colors = rep("white", 96), byrow = TRUE) {
stopifnot(is.character(colors) && length(colors) == 96)
plate <- matrix(1:96, nrow = 8, ncol = 12, byrow = byrow, dimnames = list(LETTERS[1:8], 1:12))
colnames(plate) <- stringr::str_pad(colnames(plate), 2, "left", "0")
renderDataTable({
datatable(
plate,
options = list(dom = 't', ordering = F),
selection = list(target = 'cell'),
class = 'cell-border compact'
) %>%
formatStyle(
1:12,
cursor = 'pointer',
backgroundColor = styleEqual(1:96, colors, default = NULL)
)
})
}
# app code
ui <- fluidPage(
plate96("plate"),
tags$b("Wells Selected:"),
verbatimTextOutput("well_selected"),
rclipboardSetup(),
numericInput("num_conds",
label = h3("Enter the number of treatments/ conditions"),
min = 1,
max = 20,
value = 1),
uiOutput("cond_colors"),
htmlOutput("cond_buttons", align = 'center'),
# Add a text input
textInput("copytext", "Copy this:", "Test 1"),
# UI ouputs for the copy-to-clipboard buttons
uiOutput("clip"),
# A text input for testing the clipboard content.
textInput("paste", "Paste here:")
)
server <- function(input, output, session){
#####Number output for number of conditions#####
output$value = renderPrint({ input$num_conds })
#### Color selection for UI input####
output$cond_colors <- renderUI({
num_conds <- as.integer(input$num_conds)
lapply(1:num_conds, function(i) {
colourInput(paste0("colors", i),
label = (paste0("Select a color for condition ", i)),
show = c("both"),
value = "black",
palette = c("limited"),
)
})
})
#### Create action buttons for conditions to be selected####
output$cond_buttons <- renderUI({
num_conds = as.integer(input$num_conds)
lapply(1:num_conds, function(i) {
bg = input[[paste0("colors", i)]]
style = paste0(
collapse = " ",
glue("background-color:{bg};
color:#ffffff;
border-color:#000000")
)
label = input[[paste0("condID", i)]]
cond_buttons = actionButton(paste0("cond_buttons", i),
label = label,
style = style
)
})
})
# Add clipboard buttons
output$clip <- renderUI({
output$clip <- renderUI({
rclipButton(
inputId = "clipbtn",
label = "Test copy button",
clipText = input$copytext,
icon = icon("clipboard")
)
})
})
# Workaround for execution within RStudio version < 1.2
if (interactive()){
observeEvent(input$clipbtn, clipr::write_clip(input$copytext))
}
output$plate <- renderPlate96(
"plate",
colors = c(
rep("#eeeeee", 12),
rep("#27408b", 12),
rep("#0f8b44", 12),
rep("#9400d3", 12),
rep("#0701ff", 12),
rep("white", 36)
)
)
output$well_selected <- renderPrint({
input$plate_cells_selected
})
}
shinyApp(ui = ui, server = server)
And here is a picture to kind of explain what I am thinking. Before:
After:
CodePudding user response：
You could set an input value via client-side Javascript, using Shiny.setInputValue and process this value like those provided by UI input elements.
Simple example:
library(shiny)
ui <- shiny::fluidPage(
actionButton('colored_button', 'a green button',
style = 'background-color:#00ff00'
),
actionButton('button_get_color', 'get color'),
textOutput('color_message'),
## inject client-side javascript:
tags$script('
// bind JS code to the getter button:
document.getElementById("button_get_color")
.onclick = function(){
// set input value via JS:
Shiny.setInputValue("color",
// select colored button and get its background color:
document.getElementById("colored_button")
.style.backgroundColor)
}'
)
)
server <- function(input, output) {
observeEvent(input$button_get_color,{
## do stuff, e. g.
output$color_message <- renderPrint(input$color)
})
}
shinyApp(ui, server)
Edit:
- You can also use the colored button (or any page element) to set the input value: get the element by ID and have it trigger
Shiny.setInputValueon click (or other mouse event) - more information on communicating via JS here
- some suggestions on converting RGB to Hex