折叠菜单闪亮，但在闪亮的应用程序中削减标题
我创建了一个像Google表单一样的闪亮应用。它工作正常，但当我使用页面顶部的按钮显示/隐藏侧边栏时，它会更改页面顶部的标题。我不希望这种情况发生。
问题似乎在这里：
runjs('
var el2 = document.querySelector(".skin-green");
el2.className = "skin-green sidebar-mini";
')# this is creating a sidebar mini, but it wraps up the title to trim it... I don't want that!
即使在style = "position: fixed; overflow: visible;",功能下添加sidebarMenu，它仍无效。
我该如何解决这个问题？解决方案的一部分seems here。
以下是完整代码：
# Apps
library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinyjs)
# Fields definition -------------------------------------------------------
# Define the fields we want to save from the form
fields <- c("name", # the order here will be the same as the one that is saved in a CSV!
"title_reference",
"year_publication",
"first_author",
"journal",
"Species",
"used_shiny",
"favourite_pkg",
"os_type",
"r_num_years",
"comments")
# Mandatory fields --------------------------------------------------------
# Defines mandatory fields:
fieldsMandatory <- c("name",
"favourite_pkg")
# Labeling with star for mandatory fields
labelMandatory <- function(label) {
tagList(
label,
span("*", class = "mandatory_star")
)
}
# Design ------------------------------------------------------------------
# Red star for mandatory fields
appCSS <-
".mandatory_star { color: red; }
#error { color: red; }"
# Increase the file size to be uploaded!
options(shiny.maxRequestSize=30*1024^2) # 30MB
# To save the Data -------------------------------------------------------
library(rdrop2)
# This is a folder that is going to be created on Dropbox
outputDir <- "responses"
epochTime <- function() {
as.integer(Sys.time())
}
humanTime <- function() {
format(Sys.time(), "%Y%m%d-%H%M%OS")
}
saveData <- function(data) {
data = c(data, timestamp = epochTime())
data <- t(data)
# Create a unique file name
fileName <- sprintf("evo_rates_form_%s_%s.csv",
humanTime(),
digest::digest(data))
# Write the data to a temporary file locally
filePath <- file.path(tempdir(),
fileName)
write.csv(data,
filePath,
row.names = FALSE,
quote = TRUE)
# Upload the file to Dropbox
drop_upload(filePath,
dest = outputDir)
}
loadData <- function() {
# Read all the files into a list
filesInfo <- drop_dir(outputDir)
filePaths <- filesInfo$path
data <- lapply(filePaths, drop_read_csv, stringsAsFactors = FALSE)
# Concatenate all data together into one data.frame
data <- do.call(rbind, data)
data
}
# ShinyAPP ----------------------------------------------------------------
# Shiny app with 3 fields that the user can submit data for
shinyApp(
ui = dashboardPage(skin = "green",
dashboardHeader(title = "Evolutionary Rates Form", titleWidth = 250),
dashboardSidebar(#disable = TRUE,
width = 150,
sidebarMenu(menuItem("Menu"),
menuItem("Form", tabName = "form_tab", icon = icon("file-text")),
menuItem("Help", tabName = "help_tab", icon = icon("question"))
)
),
dashboardBody(
shinyjs::useShinyjs(),
shinyjs::inlineCSS(appCSS), # you need this if you want to change the "design" of you form
# Form inputs -------------------------------------------------------------
tabItems(
# First tab content
tabItem(tabName = "form_tab",
div(
h2("Main form"),
id = "form",
## text input
textInput("name",
list(tags$span(
labelMandatory("Name (First and last name)"),
tipify(bsButton("pB2", "?",
style = "inverse",
size = "extra-small"),
"Please insert your name here") # Close tipify
) # Close span
), # Close list
""), # Close textInput
textInput("favourite_pkg",
labelMandatory("Favourite R package")),
textInput("title_reference",
"Title of the reference"),
textInput("year_publication",
"Year of publication"),
textInput("first_author",
"First author"),
textInput("journal",
"Journal"),
textInput("Species","Species"),
## Checkbox input
checkboxInput("used_shiny",
"I've built a Shiny app in R before",
FALSE),
## Slider input
sliderInput("r_num_years",
"Number of years using R",
0, 25, 2, ticks = FALSE),
## Dropdown menu input
selectInput("os_type",
"Operating system used most frequently",
c("", "Windows", "Mac", "Linux")),
## Upload data!
fileInput(inputId = 'upload',
label = 'Choose CSV File',
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv'),
multiple = FALSE),
# Add your comments here
textInput("comments", "Comments", placeholder = "Type your comments and ideas here"),
# verbatimTextOutput("value"),
## Action button
actionButton("submit",
"Submit"),
# Submission progression bar or Error
shinyjs::hidden(
span(id = "submit_msg",
"Submitting..."),
div(id = "error",
div(br(),
tags$b("Error: "), # b tags is for bold text
span(id = "error_msg"))
) # Closing div
) # Closing shinyjs::hidden
) # Closing div
), # closing tab 1
# Second tab content
tabItem(tabName = "help_tab",
h2("Need help or information?"),
h3("Contact"),
HTML('Please send an email to <a href="mailto:adress@gmail.com?subject=Question about Evolutionary Rates Archive Project Form">Evolutionary Rates Archive Project (evolutionaryrates@gmail.com)</a>.'),
h3("What's needed in the form?"),
div(span("The red star ("), span("*",style="color:red"), span(") means that it's a mandatory field")
), # Close div
br(),
p("Thank you for your feeddback. We appreciate all comments and ideas.")
) # Closing tab 2
), # Closing tabItems
# Thank you message -------------------------------------------------------
shinyjs::hidden(
div(
id = "thankyou_msg",
h2("Thanks, your response was submitted successfully!"),
actionLink("submit_another",
"Submit another response")
) # Closing div
) # Closing shinyjs::hidden
) # Closing DashboardBody
), # Closing DashboardPage
# Server ------------------------------------------------------------------
server = function(input, output, session) {
runjs('
var el2 = document.querySelector(".skin-green");
el2.className = "skin-green sidebar-mini";
')# this is createing a sidebar mini, but it wraps up the title to trim it...
# Whenever a field is filled, aggregate all from data
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
observe({
# check if all mandatory fields have a value
mandatoryFilled <-
vapply(fieldsMandatory,
function(x) {
!is.null(input[[x]]) && input[[x]] != ""
},
logical(1))
mandatoryFilled <- all(mandatoryFilled)
# enable/disable the submit button
shinyjs::toggleState(id = "submit",
condition = mandatoryFilled)
if (is.null(input$upload)) return()
file.copy(from = input$upload$datapath,
to = paste0("evol_input_",input$upload$name))
})
observeEvent(input$button, {
shinyjs::info("Please type your name")
})
# When the Submit button is clicked, save the form data (action to take when submit button is pressed)
observeEvent(input$submit, {
shinyjs::disable("submit")
shinyjs::show("submit_msg")
shinyjs::hide("error")
tryCatch({
saveData(formData())
drop_upload(paste0("evol_input_",
input$upload$name), #input$upload$datapath, it's going to retreive the files directly into the tempdi() directory
dest = "responses/dataframes")
shinyjs::reset("form")
shinyjs::hide("form")
shinyjs::show("thankyou_msg")
},
error = function(err) {
shinyjs::text("error_msg", err$message)
shinyjs::show(id = "error", anim = TRUE, animType = "fade")
},
finally = {
shinyjs::enable("submit")
shinyjs::hide("submit_msg")
})
})
# Hide the thank you message and show the form
observeEvent(input$submit_another, {
shinyjs::show("form")
shinyjs::hide("thankyou_msg")
})
}
)
同时，当侧栏坍塌时，有没有办法缩短标题？例如，“进化率表格”将崩溃为“ERF”。
0 个答案:
没有答案
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？