这是一个可能有帮助的例子。您的代码使用 modalDialog AFAIK 不存在的函数。这是一个如何滚动自己的示例
library(tcltk)
library(tcltk2)
tkinput <- function(parent, title, label, okButLabel="Ok", posx=NULL, posy=NULL) {
if(!require(tcltk2)) stop("This function requires the package tcltk2.")
if(!require(tcltk)) stop("This function requires the package tcltk.")
# param checks
if(!is.character(title)) stop("invalid title argument - character required.")
if(!is.character(label)) stop("invalid label argument - character required.")
# toplevel
tclServiceMode(FALSE) # don't display until complete
win <- tktoplevel(parent)
#win <- .Tk.subwin(parent)
tkwm.title(win, title)
tkwm.resizable(win, 0,0)
#tkconfigure(win, width=width, height=height)
# commands
okCommand <- function() if(!tclvalue(bookmVar)=="") tkdestroy(win) else tkfocus(te)
cancelCommand <- function () {
tclvalue(bookmVar) <- ""
tkdestroy(win)
}
tkwm.protocol(win, "WM_DELETE_WINDOW", cancelCommand)
# pack
f <- tk2frame(win)
w <- tk2label(f, text=label, justify="right")
tkpack(w, side="left", padx=5)
bookmVar <- tclVar("")
te <- tk2entry(f, textvariable=bookmVar, width=40)
tkpack(te, side="left", padx=5, fill="x", expand=1)
tkpack(f, pady=5)
f <- tk2frame(win)
w <- tk2button(f, text=okButLabel, command=okCommand)
tkpack(w, side="left", padx=5)
w <- tk2button(f, text="Cancel", command=cancelCommand)
tkpack(w, side="left", padx=5)
tkpack(f, pady=5)
# position
if(is.null(posx)) posx <- as.integer((as.integer(tkwinfo("screenwidth", win)) - as.integer(tkwinfo("width", win))) / 2.)
if(is.null(posy)) posy <- as.integer((as.integer(tkwinfo("screenheight", win)) - as.integer(tkwinfo("height", win))) / 2.)
geom <- sprintf("+%d+%d", posx, posy)
#print(geom)
tkwm.geometry(win, geom)
# run
tclServiceMode(TRUE)
ico <- tk2ico.load(file.path(R.home(), "bin", "R.exe"), res = "R")
tk2ico.set(win, ico)
tk2ico.destroy(ico)
tkfocus(te)
tkbind(win, "<Return>", okCommand)
tkbind(win, "<Escape>", cancelCommand)
tkwait.window(win)
tkfocus(parent)
return(tclvalue(bookmVar))
}
要绘制热图而不是消息框,您可以使用该tkrplot
函数
library(tkrplot)
heat_example <- function() {
x <- as.matrix(mtcars)
rc <- rainbow(nrow(x), start=0, end=.3)
cc <- rainbow(ncol(x), start=0, end=.3)
hv <- heatmap(x, col = cm.colors(256), scale="column",
RowSideColors = rc, ColSideColors = cc, margins=c(5,10),
xlab = "specification variables", ylab= "Car Models",
main = "heatmap(<Mtcars data>, ..., scale = \"column\")")
}
launchDialog <- function() {
ReturnVal <- tkinput(parent=ttMain, title="First Gene", label="Enter A Gene Name")
if (ReturnVal == "") return()
hmwin <- tktoplevel(ttMain)
img <- tkrplot(hmwin, heat_example)
tkpack(img, hmwin)
}
ttMain <- tktoplevel()
tktitle(ttMain) <- "ttMain"
launchDlg.button <- tkbutton(ttMain, text = "Launch Dialog", command = launchDialog)
tkpack(launchDlg.button, ttMain)
此代码生成热图,但也给出了我无法解决的错误消息。也许这里的其他人可以找到问题。