最终目标是允许用户从电子表格(如MS Excel)复制数据并粘贴到rhandontable对象中的应用程序,包括指定颜色名称或十六进制代码的文本.用户可以通过覆盖文本或通过光标 *** 作从选择器中选择颜色来编辑颜色.该应用程序后来将采用这些输入,执行计算,并以指定的颜色绘制图形.
以下是一些示例代码,显示两次尝试失败.任何建议将不胜感激.另外我也不了解JavaScript. colourpicker和rhandsontable小插曲是优秀的资源,但我仍然无法理解.
最小的例子
library(shiny); library(rhandsontable); library(colourpicker)hotDF <- data.frame(Value = 1:4,Status = TRUE,name = LETTERS[1:4],Date = seq(from = Sys.Date(),by = "days",length.out = 4),Colour = sapply(1:4,function(i) { paste0( '<div data-shiny-input-type="colour"> <input ID="myColour',i,'" type="text" data-init-value="#FFFFFF" data-show-colour="both" data-palette="square"/> </div>' )}),stringsAsFactors = FALSE) testColourinput <- function(DF){ ui <- shinyUI(fluIDPage( rHandsontableOutput("hot") )) server <- shinyServer(function(input,output) { DF2 <- transform(DF,Colour = c(sapply(1:4,function(x) { Jsonlite::toJsON(List(value = "black")) }))) #create DF2 for attempt #2 output$hot <- renderRHandsontable({ #Attempt #1 = use the HTML renderer #Results in no handsontable AND no HTML table <-- why no HTML table too? rhandsontable(DF) %>% hot_col(col = "Colour",renderer = "HTML") #Attempt #2 = use colourWidget #Results are the same as above. #rhandsontable(DF2) %>% # hot_col(col = "Colour",renderer = HTMLWidgets::Js("colourWidget")) }) }) #close shinyServer runApp(List(ui=ui,server=server)) } #close testcolorinput functiontestColourinput(DF = hotDF)
screengrab的扩展示例:
library(shiny); library(rhandsontable); library(colourpicker)#Colour cells IDeally would be a colourinput() control similar to the Date input controlhotDF <- data.frame(Value = 1:4,function(i) { paste0( '<div data-shiny-input-type="colour"> <input ID="myColour','" type="text" data-init-value="#FFFFFF" data-show-colour="both" data-palette="square"/> </div>' )}),stringsAsFactors = FALSE) testColourinput <- function(DF){ ui <- shinyUI(fluIDPage( sIDebarLayout( sIDebarPanel( #Standalone colour input colourinput("myColour",label = "Just the color control:",value = "#000000"),br(),HTML("Build the colour input from HTML Tags:"),HTML(paste0( "<div class='form-group shiny-input-container' data-shiny-input-type='colour'> <input ID='myColour",999,"' type='text' class='form-control shiny-colour-input' data-init-value='#FFFFFF' data-show-colour='both' data-palette='square'/> </div>" )) ),mainPanel( HTML("Failed attempt"),rHandsontableOutput("hot"),HTML("Success,but this is not a rhandsontable"),uioutput("tableWithColourinput") ) ) )) server <- shinyServer(function(input,output) { #create DF2 for attempt #2 DF2 <- transform(DF,function(x) { Jsonlite::toJsON(List(value = "black")) }))) output$hot <- renderRHandsontable({ #Attempt #1 = use the HTML renderer #Results in no handsontable AND no HTML table <-- why no HTML table too? rhandsontable(DF) %>% hot_col(col = "Colour",renderer = "HTML") #Attempt #2 = use colourWidget #Results are the same as above. #rhandsontable(DF2) %>% # hot_col(col = "Colour",renderer = HTMLWidgets::Js("colourWidget")) #Uncomment below to see the table without HTML formatting #rhandsontable(DF) #^This line was uncommented to obtain the screengrab }) #HTML table myHTMLtable <- data.frame(Variable = LETTERS[1:4],Select = NA) output$tableWithColourinput <- renderUI({ #create table cells rowz <- List() #Fill out table cells [i,j] with static elements for( i in 1:nrow( myHTMLtable )) { rowz[[i]] <- Tags$tr(lapply( myHTMLtable[i,1:ncol(myHTMLtable)],function( x ) { Tags$td( HTML(as.character(x)) ) } ) ) } #Add colourinput() to cells in the "Select" column in myHTMLtable for( i in 1:nrow( myHTMLtable ) ) { #Note: in the List rowz: # i = row; [3] = row information; children[1] = table cells (List of 1); # $Select = Column 'Select' rowz[[i]][3]$children[[1]]$Select <- Tags$td( colourinput(inputID = as.character(paste0("inputColour",i)),label = NulL,value = "#000000") ) } mybody <- Tags$tbody( rowz ) Tags$table( Tags$style(HTML( ".shiny-HTML-output th,td {border: 1px solID black;}" )),Tags$thead( Tags$tr(lapply( c("Variable!","Colour!"),function( x ) Tags$th(x))) ),mybody ) #close Tags$table }) #close renderUI }) #close shinyServer runApp(List(ui=ui,server=server)) } #close testcolorinput functiontestColourinput(DF = hotDF)解决方法 这完全不是一个答案,但我相当确定你不能在一个可以直接使用的内容中使用闪光的输入(可以在datatable里面看到 this).
这里有一些代码可以让输入渲染:
library(shiny); library(rhandsontable); library(colourpicker)DF <- data.frame(Value = 1:4,function(i) { as.character(colourinput(paste0("colour",i),NulL)) }),stringsAsFactors = FALSE) ui <- shinyUI(fluIDPage( rHandsontableOutput("hot"),verbatimtextoutput("test"))) server <- shinyServer(function(input,output) { output$hot <- renderRHandsontable({ rhandsontable(DF,allowedTags = "<div><input>") %>% hot_col(5,renderer = HTMLWidgets::Js("HTML")) %>% hot_col(5,renderer = HTMLWidgets::Js("safeHTMLRenderer")) }) output$test <- renderPrint({ sapply(1:4,function(i) { input[[paste0("colour",i)]] }) })})shinyApp(ui=ui,server=server)
问题是< input> colourinput内部的元素变成一个可直接输入,防止闪烁的Js代码转换成闪亮的输入.
如果您查看hot_col文档,您将看到一个类型的参数,它只有几个选项.我相信你只能使用这些可以直接输入的输入.
也许我错了,但我不认为你可以在一个可以控制的内容中渲染一个闪亮的输入.
编辑:
经过一番思考,我相信这是可能的,但它需要很多的JavaScript.您必须基本上写一个渲染器功能,从头重新创建闪亮的输入.也许在闪亮的JavaScript代码中有一个功能来做到这一点,但我并不是所有的熟悉闪亮的Js内部.
edit2:我试图写一个渲染器的功能,但它似乎还不行.我的猜测是这是不可能的:
library(shiny); library(rhandsontable); library(colourpicker)DF <- data.frame(Value = 1:4,Colour = 1:4 }),renderer = HTMLWidgets::Js(" function(instance,td,row,col,prop,value,cellPropertIEs) { var y = document.createElement('input'); y.setAttribute('ID','colour'+ value);y.setAttribute('type','text'); y.setAttribute('class','form-control shiny-colour-input'); y.setAttribute('data-init-value','#FFFFFF'); y.setAttribute('data-show-colour','both'); y.setAttribute('data-palette','square'); td.appendChild(y); return td;} ")) }) output$test <- renderPrint({ sapply(1:4,server=server)总结
以上是内存溢出为你收集整理的将控制输入和HTML小部件插入可控的单元格内全部内容,希望文章能够帮你解决将控制输入和HTML小部件插入可控的单元格内所遇到的程序开发问题。
如果觉得内存溢出网站内容还不错,欢迎将内存溢出网站推荐给程序员好友。
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)