1

我正在用 R 中的 gwidgets 包编写一个 GUI。我正在实现一个工具，它允许用户从一个列表中选择多个变量，并将它们拖到一个空列表中进行收集。灵感来自 SPSS 的 gui，请参见链接：

spss拖拽

我打算用两个 gtable 来做这件事，即首先创建一个带有变量列表的 gtable，然后创建一个空 gtable 来收集选定的变量。下面是我的示例代码：

  portfolioBuilder <- function(h,...){
  ## globals
  widgets <- list()
  varNames <- c("var1","var2","var3","var4" )#with(.GlobalEnv, names(data))

  #window
  win <- gwindow("Test")

  #groups
  g <- ggroup(horizontal = FALSE, container = win, expand = TRUE)
  gg <- ggroup(horizontal = FALSE, container = win, expand = TRUE)

  #graphics container
  ggraphics(container = gg)

  #paned group
  pg <- gpanedgroup(container = g, expand = TRUE)
  nb <- gnotebook(container = pg)

  ## main group
  qpg <- ggroup(horizontal = FALSE, container = nb, label = "portfolio")
  parg <- ggroup(horizontal = FALSE, container = nb, label = "portfolio args")


  ## qplot group
  tbl <- glayout(container = qpg)

  #variable list
  tbl[1,1,anchor = c(1,0)] <- "Variables"
  tbl[2:10,2] <- (widgets[["table"]] <- gtable(varNames, multiple = TRUE, container = tbl, expand = TRUE))
  tbl[3,3, anchor = c(1,0)] <- "y"
  tbl[3,4] <- (widgets[["y"]] <- gedit("", container = tbl))
  tbl[4,3, anchor = c(1,0)] <- "x"
  tbl[4,4] <- (widgets[["x"]] <- gtable(c(""),container = tbl))

  ## make table visible and set tab
  visible(tbl) <- TRUE
  svalue(nb) <- 1

  ##################################end layout#################################

  }

但是，由于 gtable 小部件为空，我的示例代码会吐出一个错误。有谁知道如何用 gwidgets 完成这个？

4

1 回答 1

2

您需要处理布局，但关键是 addDropSource 和 addDropTarget：

选项（guiToolkit="RGtk2"）库（gWidgets）

w <- gwindow(visible=FALSE)
g <- gpanedgroup(cont=w)

tbl <- gtable(names(mtcars), cont=g)


fl <- gframe("variables", horizontal=FALSE, cont=g)

dep <- gedit(initial.msg="Dependent variable", label="Dependent", cont=fl)
ind <- gedit(initial.msg="Independent variable(s)", label="Independent", cont=fl)

addDropSource(tbl, handler=function(h,...) svalue(h$obj))

addDropTarget(dep, handler=function(h,...) svalue(h$obj) <- h$dropdata)
addDropTarget(ind, handler=function(h,...) {
  cur <- svalue(h$obj)

  new <- ifelse(nchar(cur) > 0, paste(cur, h$dropdata, sep=", "), h$dropdata)
  svalue(h$obj) <- new
})



visible(w) <- TRUE

gWidgets 中的拖放支持确实是可变的。在这 6 种可能的情况中：gWidgetsRGtk2、gWidgets2RGtk2、gWidgetstcltk、gWidgets2tcltk、gWidgetsQt 和 gWidgets2Qt 此代码仅在 gWidgetsRGtk2 中有效。

于 2012-09-14T21:15:02.487 回答