R Блестящий ключевой код пользовательского ввода - PullRequest
Новая
       25

R Блестящий ключевой код пользовательского ввода

0 голосов
/ 13 июня 2019

Я должен получить код ключа в textInput. Для этого я разработал следующий код: 

library(shiny)

ui <- fluidPage(

tags$script(sprintf('$(document).on("shiny:sessioninitialized", function(event) { // wait for shiny to be loaded
document.getElementById("%s").onkeydown = function(event) {
    Shiny.onInputChange("%s", [event.keyCode,event.timeStamp]);
};
});',"textInput","jsrow")),

HTML(sprintf("<div 'form-group shiny-input-container'>
                             <label for='%s'>%s</label>
                             <input class='form-control' charset='UTF-8' type='text' placeholder='%s' onkeydown = 'return (event.keyCode >=48 && event.keyCode <= 57)
                             || event.keyCode == 8||(event.keyCode >=37 && event.keyCode <= 40)||(event.keyCode >=33 && event.keyCode <= 34)||event.keyCode == 46
                             ||event.keyCode == 45||event.keyCode == 9||event.keyCode == 13||event.keyCode == 32||(event.keyCode >=16 && event.keyCode <= 18)||event.keyCode == 189
                             ||event.keyCode == 173||(event.keyCode >=112 && event.keyCode <= 123)||event.keyCode == 144||(event.keyCode >=96 && event.keyCode <= 105)' id='%s' required>
                             </div>", "textInput", "", "41741-155", "textInput")
)

)

server <- function(input, output, session) {

observeEvent(input$jsrow, {
    print(paste0("Value of input is ", input$jsrow[1]))
})

}

shinyApp(ui, server)

Но когда я модулирую textInput, код больше не работает. Есть идеи?

1 Ответ

0 голосов
/ 14 июня 2019

Может быть так: 

library(shiny)

textInput2 <- function(inputId, label, value = "", width = NULL, 
                       placeholder = NULL, onkeydown = NULL){
  input <- textInput(inputId, label, value, width, placeholder)
  input$children[[2]] <- 
    htmltools::tagAppendAttributes(input$children[[2]], onkeydown = "%s")
  tag <- as.character(input)
  HTML(sprintf(tag, onkeydown))
}

js <- "Shiny.setInputValue('jsrow', [event.keyCode,event.timeStamp]); 
       return !((event.which >=48 && event.which <= 57)
          || event.which == 8||(event.which >=37 && event.which <= 40)||(event.which >=33 && event.which <= 34)||event.which == 46
          ||event.which == 45||event.which == 9||event.which == 13||event.which == 32||(event.which >=16 && event.which <= 18)||event.which == 189
          ||event.which == 173||(event.which >=112 && event.which <= 123)||event.which == 144||(event.which >=96 && event.which <= 105))
          ;
       "

ui <- fluidPage(
  textInput2("textinput", "Enter text:", onkeydown = js)
)

server <- function(input, output){
  observeEvent(input$jsrow, {
    print(paste0("Value of input is ", input$jsrow[1]))
  })
}

shinyApp(ui, server)

А в модуле просто используйте ns как обычно.

EDIT 

js <- function(id) {sprintf("Shiny.setInputValue('%s_jsrow', [event.keyCode,event.timeStamp]); 
       return !((event.which >=48 && event.which <= 57)
       || event.which == 8||(event.which >=37 && event.which <= 40)||(event.which >=33 && event.which <= 34)||event.which == 46
       ||event.which == 45||event.which == 9||event.which == 13||event.which == 32||(event.which >=16 && event.which <= 18)||event.which == 189
       ||event.which == 173||(event.which >=112 && event.which <= 123)||event.which == 144||(event.which >=96 && event.which <= 105));", id)}


ui <- fluidPage(
  textInput2("textinput", "Enter text:", onkeydown = js("textinput"))
)

server <- function(input, output){
  observeEvent(input$textinput_jsrow, {
    print(paste0("Value of input is ", input$textinput_jsrow[1]))
  })
}
...