Nothing
R/tk2ico.R
In tcltk2: Tcl/Tk Additions
Defines functions
tk2ico.taskbar.add
Documented in
tk2ico.taskbar.add
tk2ico.taskbar.add
### tk2ico.R - Functions to interface the winico Tcl package under Windows
### Copyright (c), Philippe Grosjean (phgrosjean@sciviews.org)
### Licensed under LGPL 3 or above
###
### Changes:
### - 2012-04-28: winico.dll support is dropped; now using 'ico' package
### - 2007-01-01: first version (for tcltk2_1.0-0)
### TODO: implement ::ico::getIconByName, ::ico::getFileIcon & ::ico::writeIcon
### TODO: gif files are acceptable too for tk2ico.set(), example:
### Image <- tclVar()
### tcl("image", "create", "photo", Image, file = "myfile.gif")
### tcl("wm", "iconphoto", tt, Image) instead of tk2ico.set
.tk2ico.require <- function ()
{
if (.Platform$OS.type != "windows")
stop("This is a Windows-specific function!")
## Make sure tcl/tk dde is operational
if (!capabilities("tcltk"))
stop("This version of R cannot use Tcl/Tk!")
if (!is.tk()) stop("Tk is required")
res <- tclRequire("ico", warn = TRUE)
if (inherits(res, "tclObj")) res <- tclvalue(res)
if (res[1] == FALSE)
stop("Unable to find the 'ico' Tcl/tk package!")
return(res) # The package version number
}
tk2ico.create <- function (iconfile, res = 0, size = 16)
{
if (length(iconfile) != 1) stop("'iconfile' must be of length one!")
if (!file.exists(iconfile <- as.character(iconfile)))
stop(gettextf("File '%s' not found!", iconfile))
## Just use tk2ico.lod() with different default args)
tk2ico.load(file = iconfile, res = res, size =size)
## This is old code for winico.dll
#cmd <- paste("winico createfrom {", iconfile, "}", sep = "")
#res <- try(icon <- .Tcl(cmd), silent = TRUE)
#if (inherits(res, "try-error")) # Tcl error is unreadable, put another one!
# stop("Error creating the icon resource; probably wrong 'iconfile'")
#if (inherits(icon, "tclObj")) class(icon) <- c(class(icon), "tclIcon")
#return(icon)
}
tk2ico.destroy <- function (icon)
{
if (!is.tk()) return(NULL)
if (.Platform$OS.type != "windows") return(NULL)
if (!inherits(icon, "tclIcon"))
stop("'icon' is not a \"tclIcon\" object!")
res <- tclvalue(.Tcl(paste("catch {image delete ", icon, "}", sep = "")))
return(res == "0") # Return "0" if OK, "1" otherwise
}
tk2ico.hicon <- function (icon)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#res <- try(hicon <- tcl("winico", "hicon", icon), silent = TRUE)
#if (inherits(res, "try-error")) # Tcl error is unreadable, put another one!
# stop("Error getting the icon handle for a \"tclIcon\" object!")
#return(hicon)
}
tk2ico.info <- function (icon, convert = TRUE)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#res <- try(info <- as.character(tcl("winico", "info", icon)), silent = TRUE)
#if (inherits(res, "try-error")) # Tcl error message is unreadable!
# stop("Impossible to retrieve icon resource information!")
#if (isTRUE(convert)) { # Rework and transform into a data frame
# info <- strsplit(info, "-")
# info <- matrix(unlist(info), ncol = 8, byrow = TRUE)[, -1]
# info <- unlist(strsplit(info, " "))
# info <- info[info != ""]
# info <- info[(1:(length(info) / 2)) * 2]
# info <- matrix(info, ncol = 7)
# info <- data.frame(pos = as.integer(info[, 1]),
# width = as.integer(info[, 2]), height = as.integer(info[, 3]),
# geometry = I(info[, 4]), bpp = as.integer(info[, 5]),
# hicon = I(info[, 6]), ptr = I(info[, 7]))
#}
#return(info)
}
tk2ico.list <- function (file = "shell32.dll")
{
## Make sure that the 'ico' package is loaded
.tk2ico.require()
if (length(file) != 1)
stop("'file' must be of length one!")
## If the file is not found directly, try using Sys.which()
if (!file.exists(file)) {
File <- Sys.which(file)
if (!file.exists(File))
stop("file '", file, "' not found")
} else File <- file
cmd <- paste("::ico::icons {", File, "}", sep = "")
res <- try(iconlist <- .Tcl(cmd), silent = TRUE)
if (inherits(res, "try-error")) # Tcl error message is unreadable!
stop("Unable to list the icon resources in 'file'!")
return(as.character(iconlist))
}
tk2ico.sizes <- function (file = "shell32.dll", res = "application")
{
## Make sure that the 'ico' package is loaded
.tk2ico.require()
if (length(file) != 1)
stop("'file' must be of length one!")
if (length(res) != 1)
stop("'res' must be of length one!")
## For compatibility reasons, res can be "application", "asterisk", "error",
## "exclamation", "hand", "question", "information", "warning" or "winlogo"
## but need to be changed into corresponding ID
res <- as.character(res)[1]
res <- switch(res,
application = "154",
asterisk = "173",
error = "28",
exclamation = "154",
hand = "29",
question = "263",
information = "1001",
warning = "200",
winlogo = "47",
res)
## If the file is not found directly, try using Sys.which()
if (!file.exists(file)) {
File <- Sys.which(file)
if (!file.exists(File))
stop("file '", file, "' not found")
} else File <- file
cmd <- paste("::ico::iconMembers {", File, "} ", res, sep = "")
res <- try(iconsizes <- .Tcl(cmd), silent = TRUE)
if (inherits(res, "try-error")) # Tcl error message is unreadable!
stop("Unable to list sizes for the icon resource 'res' in 'file'!")
iconsizes <- as.character(iconsizes)
iconsizes <- unique(sub("^[^ ]+ ([0-9]+) .+$", "\\1", iconsizes))
return(as.integer(iconsizes))
}
## For future use, when bpp will be added as argument
#tk2ico.bpp <- function (file = "shell32.dll", res = "application")
#{
# ## Make sure that the 'ico' package is loaded
# .tk2ico.require()
#
# if (length(file) != 1)
# stop("'file' must be of length one!")
# if (length(res) != 1)
# stop("'res' must be of length one!")
# ## For compatibility reasons, res can be "application", "asterisk", "error",
# ## "exclamation", "hand", "question", "information", "warning" or "winlogo"
# ## but need to be changed into corresponding ID
# res <- as.character(res)[1]
# res <- switch(res,
# application = "154",
# asterisk = "173",
# error = "28",
# exclamation = "154",
# hand = "29",
# question = "263",
# information = "1001",
# warning = "200",
# winlogo = "47",
# res)
#
# ## If the file is not found directly, try using Sys.which()
# if (!file.exists(file)) {
# File <- Sys.which(file)
# if (!file.exists(File))
# stop("file '", file, "' not found")
# } else File <- file
#
# cmd <- paste("::ico::iconMembers {", File, "} ", res, sep = "")
# res <- try(iconbpp <- .Tcl(cmd), silent = TRUE)
# if (inherits(res, "try-error")) # Tcl error message is unreadable!
# stop("Unable to list sizes for the icon resource 'res' in 'file'!")
# iconbpp <- as.character(iconbpp)
# iconbpp <- unique(sub("^.+ ([0-9]+)$", "\\1", iconbpp))
# return(as.integer(iconbpp))
#}
tk2ico.load <- function (file = "shell32.dll", res = "application", size = 16)
{
## Make sure that the 'ico' package is loaded
.tk2ico.require()
if (length(file) != 1)
stop("'file' must be of length one!")
if (length(res) != 1)
stop("'res' must be of length one!")
## For compatibility reasons, res can be "application", "asterisk", "error",
## "exclamation", "hand", "question", "information", "warning" or "winlogo"
## but need to be changed into corresponding ID
res <- as.character(res)[1]
res <- switch(res,
application = "154",
asterisk = "173",
error = "28",
exclamation = "154",
hand = "29",
question = "263",
information = "1001",
warning = "200",
winlogo = "47",
res)
## If the file is not found directly, try using Sys.which()
if (!file.exists(file)) {
File <- Sys.which(file)
if (!file.exists(File))
stop("file '", file, "' not found")
} else File <- file
## The old winico code!
#cmd <- paste("winico load ", res, " {", file, "}", sep = "")
cmd <- paste("::ico::getIcon {", File, "} ", res, " -res ", size, sep = "")
res <- try(icon <- .Tcl(cmd), silent = TRUE)
if (inherits(res, "try-error")) # Tcl error message is unreadable!
stop("Unable to load the icon resource, 'file' or 'res' is wrong!")
if (inherits(icon, "tclObj")) class(icon) <- c(class(icon), "tclIcon")
return(icon)
}
`tk2ico.pos<-` <- function (icon, value)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#if (length(value) != 1 || !is.numeric(value))
# stop("'value' must be numeric and of length one!")
#value <- round(value)
#res <- tclvalue(.Tcl(paste("catch {winico pos ", icon, " ", value, "}",
# sep = "")))
#if (res != "0") stop("Error while changing default position of the icon!")
#return(icon)
}
## iconfile can be either an .ico file, or an .exe
tk2ico.setFromFile <- function (win, iconfile)
{
## This is the simplest way to set a tk window icon
tkwm.iconbitmap(win, iconfile)
}
tk2ico.set <- function (win, icon, pos = NULL, type = c("all", "small", "big"))
{
## Note that pos and typer are not supported any more (were winico.dll features)!
if (!missing(pos)) warning("'pos' argument deprecated from tcltk2 1.2-2")
if (!missing(type)) warning("'type' argument deprecated from tcltk2 1.2-2")
## Integer for win is not supported any more
if (inherits(win, "integer"))
stop("Integers for argument win are not supported any more in tcltk > 1.2-0")
## Make sure that the 'ico' package is loaded
.tk2ico.require()
if (!inherits(win, "tkwin") || length(win) < 1)
stop("'win' is not a \"tkwin\" object")
if (!inherits(icon, "tclIcon"))
stop("'icon' is not a \"tclIcon\" object!")
## Change the icon of a Tk window
tcl("wm", "iconphoto", win, icon)
## This is old code that used winico.dll
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
## win is either a tkwin object, or the HWND of a foreign window
#if (!inherits(win, c("tkwin", "integer")) || length(win) < 1)
# stop("'win' is not a \"tkwin\" object, or an integer (Window handle)!")
#if (is.integer(win)) win <- win[1]
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#if (!is.null(pos) && (length(pos) != 1 || !is.numeric(pos)))
# stop("'pos' must be numeric and of length one, or NULL!")
#type <- match.arg(type)
#if (type == "all") { # We search for highest quality icons
# ## Determine which icons are better in the resource
# info <- tk2ico.info(icon, convert = TRUE)
# if (nrow(info) == 1) { # Only one icon in the ressource
# resSmall <- tclvalue(.Tcl(paste("catch {winico setwindow ", win, " ",
# icon, " small}", sep = "")))
# resBig <- tclvalue(.Tcl(paste("catch {winico setwindow ", win, " ",
# icon, " big}", sep = "")))
# } else { # There are several icons in the resource
# ## Are there 16x16 icons?
# pos16 <- info[info$geometry == "16x16", ]$pos
# if (length(pos16) > 0) pos16 <- max(pos16) else pos16 <- 0
# resSmall <- tclvalue(.Tcl(paste("catch {winico setwindow ", win,
# " ", icon, " small ", pos16, "}", sep = "")))
# ## Are there 32x32 icons?
# pos32 <- info[info$geometry == "32x32", ]$pos
# if (length(pos32) > 0) pos32 <- max(pos32) else
# pos32 <- max(info$pos)
# resBig <- tclvalue(.Tcl(paste("catch {winico setwindow ", win, " ",
# icon, " big ", pos32, "}", sep = "")))
# }
# ## Compute res, a vector of two logical values, with "0" == success
# res <- c((resSmall == "0"), (resBig == "0"))
# names(res) <- c("small", "big")
#} else { # Other type than 'all'
# if (is.null(pos)) pos <- ""
# res <- tclvalue(.Tcl(paste("catch {winico setwindow ", win, " ", icon,
# " ", type, " ", pos, "}", sep = "")))
# res <- (res == "0") # Because "0" if OK, and "1" otherwise
#}
#return(res)
}
tk2ico.taskbar.add <- function(icon, pos = 0, text = tk2ico.text(icon),
leftmenu = NULL, rightmenu = NULL)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#if (length(pos) != 1 || !is.numeric(pos))
# stop("'pos' must be numeric and of length one, or NULL!")
#if (is.null(text)) text <- "" else
# text <- paste (" -text {", paste(text, collapse = "\n"), "}", sep = "")
#if (!inherits(leftmenu, c("tkwin", "NULL")))
# stop("'leftmenu' must be a \"tkwin\" object or NULL!")
#if (!inherits(rightmenu, c("tkwin", "NULL")))
# stop("'rightmenu' must be a \"tkwin\" object or NULL!")
#if (!is.null(leftmenu) || !is.null(rightmenu)) {
# hicon <- tclvalue(tk2ico.hicon(icon))
# if (is.null(leftmenu)) {
# leftcmd <- ""; leftset <- ""
# } else {
# ## The command to trigger the left-click menu
# leftcmd <- paste('if { $msg == "WM_LBUTTONUP" } { $::leftmenu',
# hicon, ' post $x $y }\n', sep = "")
# ## ... and the appropriate name for our left-click menu
# leftset <- paste('set leftmenu', hicon, ' ', leftmenu$ID, sep = "")
# }
# if (is.null(rightmenu)) {
# rightcmd <- ""; rightset <- ""
# } else {
# ## The command to trigger the right-click menu
# rightcmd <- paste('if { $msg == "WM_RBUTTONUP" } { $::rightmenu',
# hicon, ' post $x $y }\n', sep = "")
# ## ... and the appropriate name for our right-click menu
# rightset <- paste('set rightmenu', hicon, ' ', rightmenu$ID, sep = "")
# }
# ## Create the proc that will handle mouse clicks on our taskbar icon
# cmd <- paste('catch { ', leftset, '\n', rightset, '\n',
# 'proc taskbarcallback', hicon, ' { hicon msg ico x y } {\n',
# leftcmd, rightcmd, '}}', sep = "")
# if (tclvalue(.Tcl(cmd)) != "0")
# stop("Error while creating the callback for this icon!")
# ## Finally define the callback call
# callback <- paste(' -callback "taskbarcallback', hicon, ' ', hicon,
# ' %m %i %X %Y"', sep = "")
#} else callback <- ""
## Install the taskbar icon
#res <- tclvalue(.Tcl(paste("catch {winico taskbar add ", icon, " -pos ",
# round(pos), text, callback, "}", sep = "")))
#return(res == "0") # "0" if success, "1" if error
}
tk2ico.taskbar.delete <- function (icon)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
## First delete the Tcl procs that handle our taskbar icon events
#hicon <- tclvalue(tk2ico.hicon(icon))
#.Tcl(paste('catch {',
# 'unset -nocomplain taskbarcallback', hicon, '\n',
# 'unset -nocomplain leftmenu', hicon, '\n',
# 'unset -nocomplain rightmenu', hicon, '\n',
# '}', sep = ""))
## Then delete the taskbar icon
#res <- tclvalue(.Tcl(paste("catch {winico taskbar delete ", icon, "}",
# sep = "")))
#return(res == "0") # return "0" if OK, "1" otherwise
}
tk2ico.taskbar.modify <- function (icon, pos = NULL, text = NULL)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#if (!is.null(pos)) {
# if (length(pos) != 1 || !is.numeric(pos))
# stop("'pos' must be numeric and of length one, or NULL!")
# pos <- paste(" -pos", round(pos))
#}
#if (is.null(text)) text <- "" else
# text <- paste (" -text {", paste(text, collapse = "\n"), "}", sep = "")
#cmd <- paste("catch {winico taskbar modify ", icon, pos, text, "}", sep = "")
#return(tclvalue(.Tcl(cmd)) == "0") # "0" if OK, "1" otherwise
}
tk2ico.text <- function (icon)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#res <- try(text <- tclvalue(tcl("winico", "text", icon)), silent = TRUE)
#if (inherits(res, "try-error")) # Tcl error is unreadable, put another one!
# stop("Error getting the text associated with an icon!")
#return(res)
}
`tk2ico.text<-` <- function (icon, value)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(icon)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#if (length(value) < 1)
# stop("'value' must not be empty or NULL!")
#value <- paste(value, collapse = "\n")
#res <- tclvalue(.Tcl(paste("catch {winico text ", icon, " {", value, "}}",
# sep = "")))
#if (res != "0") stop("Error while changing text of the icon!")
#return(icon)
}
Try the tcltk2 package in your browser
Any scripts or data that you put into this service are public.
tcltk2 documentation built on May 2, 2019, 9:37 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions tk2ico.taskbar.add
Documented in tk2ico.taskbar.add tk2ico.taskbar.add
### tk2ico.R - Functions to interface the winico Tcl package under Windows
### Copyright (c), Philippe Grosjean (phgrosjean@sciviews.org)
### Licensed under LGPL 3 or above
###
### Changes:
### - 2012-04-28: winico.dll support is dropped; now using 'ico' package
### - 2007-01-01: first version (for tcltk2_1.0-0)
### TODO: implement ::ico::getIconByName, ::ico::getFileIcon & ::ico::writeIcon
### TODO: gif files are acceptable too for tk2ico.set(), example:
### Image <- tclVar()
### tcl("image", "create", "photo", Image, file = "myfile.gif")
### tcl("wm", "iconphoto", tt, Image) instead of tk2ico.set
.tk2ico.require <- function ()
{
if (.Platform$OS.type != "windows")
stop("This is a Windows-specific function!")
## Make sure tcl/tk dde is operational
if (!capabilities("tcltk"))
stop("This version of R cannot use Tcl/Tk!")
if (!is.tk()) stop("Tk is required")
res <- tclRequire("ico", warn = TRUE)
if (inherits(res, "tclObj")) res <- tclvalue(res)
if (res[1] == FALSE)
stop("Unable to find the 'ico' Tcl/tk package!")
return(res) # The package version number
}
tk2ico.create <- function (iconfile, res = 0, size = 16)
{
if (length(iconfile) != 1) stop("'iconfile' must be of length one!")
if (!file.exists(iconfile <- as.character(iconfile)))
stop(gettextf("File '%s' not found!", iconfile))
## Just use tk2ico.lod() with different default args)
tk2ico.load(file = iconfile, res = res, size =size)
## This is old code for winico.dll
#cmd <- paste("winico createfrom {", iconfile, "}", sep = "")
#res <- try(icon <- .Tcl(cmd), silent = TRUE)
#if (inherits(res, "try-error")) # Tcl error is unreadable, put another one!
# stop("Error creating the icon resource; probably wrong 'iconfile'")
#if (inherits(icon, "tclObj")) class(icon) <- c(class(icon), "tclIcon")
#return(icon)
}
tk2ico.destroy <- function (icon)
{
if (!is.tk()) return(NULL)
if (.Platform$OS.type != "windows") return(NULL)
if (!inherits(icon, "tclIcon"))
stop("'icon' is not a \"tclIcon\" object!")
res <- tclvalue(.Tcl(paste("catch {image delete ", icon, "}", sep = "")))
return(res == "0") # Return "0" if OK, "1" otherwise
}
tk2ico.hicon <- function (icon)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#res <- try(hicon <- tcl("winico", "hicon", icon), silent = TRUE)
#if (inherits(res, "try-error")) # Tcl error is unreadable, put another one!
# stop("Error getting the icon handle for a \"tclIcon\" object!")
#return(hicon)
}
tk2ico.info <- function (icon, convert = TRUE)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#res <- try(info <- as.character(tcl("winico", "info", icon)), silent = TRUE)
#if (inherits(res, "try-error")) # Tcl error message is unreadable!
# stop("Impossible to retrieve icon resource information!")
#if (isTRUE(convert)) { # Rework and transform into a data frame
# info <- strsplit(info, "-")
# info <- matrix(unlist(info), ncol = 8, byrow = TRUE)[, -1]
# info <- unlist(strsplit(info, " "))
# info <- info[info != ""]
# info <- info[(1:(length(info) / 2)) * 2]
# info <- matrix(info, ncol = 7)
# info <- data.frame(pos = as.integer(info[, 1]),
# width = as.integer(info[, 2]), height = as.integer(info[, 3]),
# geometry = I(info[, 4]), bpp = as.integer(info[, 5]),
# hicon = I(info[, 6]), ptr = I(info[, 7]))
#}
#return(info)
}
tk2ico.list <- function (file = "shell32.dll")
{
## Make sure that the 'ico' package is loaded
.tk2ico.require()
if (length(file) != 1)
stop("'file' must be of length one!")
## If the file is not found directly, try using Sys.which()
if (!file.exists(file)) {
File <- Sys.which(file)
if (!file.exists(File))
stop("file '", file, "' not found")
} else File <- file
cmd <- paste("::ico::icons {", File, "}", sep = "")
res <- try(iconlist <- .Tcl(cmd), silent = TRUE)
if (inherits(res, "try-error")) # Tcl error message is unreadable!
stop("Unable to list the icon resources in 'file'!")
return(as.character(iconlist))
}
tk2ico.sizes <- function (file = "shell32.dll", res = "application")
{
## Make sure that the 'ico' package is loaded
.tk2ico.require()
if (length(file) != 1)
stop("'file' must be of length one!")
if (length(res) != 1)
stop("'res' must be of length one!")
## For compatibility reasons, res can be "application", "asterisk", "error",
## "exclamation", "hand", "question", "information", "warning" or "winlogo"
## but need to be changed into corresponding ID
res <- as.character(res)[1]
res <- switch(res,
application = "154",
asterisk = "173",
error = "28",
exclamation = "154",
hand = "29",
question = "263",
information = "1001",
warning = "200",
winlogo = "47",
res)
## If the file is not found directly, try using Sys.which()
if (!file.exists(file)) {
File <- Sys.which(file)
if (!file.exists(File))
stop("file '", file, "' not found")
} else File <- file
cmd <- paste("::ico::iconMembers {", File, "} ", res, sep = "")
res <- try(iconsizes <- .Tcl(cmd), silent = TRUE)
if (inherits(res, "try-error")) # Tcl error message is unreadable!
stop("Unable to list sizes for the icon resource 'res' in 'file'!")
iconsizes <- as.character(iconsizes)
iconsizes <- unique(sub("^[^ ]+ ([0-9]+) .+$", "\\1", iconsizes))
return(as.integer(iconsizes))
}
## For future use, when bpp will be added as argument
#tk2ico.bpp <- function (file = "shell32.dll", res = "application")
#{
# ## Make sure that the 'ico' package is loaded
# .tk2ico.require()
#
# if (length(file) != 1)
# stop("'file' must be of length one!")
# if (length(res) != 1)
# stop("'res' must be of length one!")
# ## For compatibility reasons, res can be "application", "asterisk", "error",
# ## "exclamation", "hand", "question", "information", "warning" or "winlogo"
# ## but need to be changed into corresponding ID
# res <- as.character(res)[1]
# res <- switch(res,
# application = "154",
# asterisk = "173",
# error = "28",
# exclamation = "154",
# hand = "29",
# question = "263",
# information = "1001",
# warning = "200",
# winlogo = "47",
# res)
#
# ## If the file is not found directly, try using Sys.which()
# if (!file.exists(file)) {
# File <- Sys.which(file)
# if (!file.exists(File))
# stop("file '", file, "' not found")
# } else File <- file
#
# cmd <- paste("::ico::iconMembers {", File, "} ", res, sep = "")
# res <- try(iconbpp <- .Tcl(cmd), silent = TRUE)
# if (inherits(res, "try-error")) # Tcl error message is unreadable!
# stop("Unable to list sizes for the icon resource 'res' in 'file'!")
# iconbpp <- as.character(iconbpp)
# iconbpp <- unique(sub("^.+ ([0-9]+)$", "\\1", iconbpp))
# return(as.integer(iconbpp))
#}
tk2ico.load <- function (file = "shell32.dll", res = "application", size = 16)
{
## Make sure that the 'ico' package is loaded
.tk2ico.require()
if (length(file) != 1)
stop("'file' must be of length one!")
if (length(res) != 1)
stop("'res' must be of length one!")
## For compatibility reasons, res can be "application", "asterisk", "error",
## "exclamation", "hand", "question", "information", "warning" or "winlogo"
## but need to be changed into corresponding ID
res <- as.character(res)[1]
res <- switch(res,
application = "154",
asterisk = "173",
error = "28",
exclamation = "154",
hand = "29",
question = "263",
information = "1001",
warning = "200",
winlogo = "47",
res)
## If the file is not found directly, try using Sys.which()
if (!file.exists(file)) {
File <- Sys.which(file)
if (!file.exists(File))
stop("file '", file, "' not found")
} else File <- file
## The old winico code!
#cmd <- paste("winico load ", res, " {", file, "}", sep = "")
cmd <- paste("::ico::getIcon {", File, "} ", res, " -res ", size, sep = "")
res <- try(icon <- .Tcl(cmd), silent = TRUE)
if (inherits(res, "try-error")) # Tcl error message is unreadable!
stop("Unable to load the icon resource, 'file' or 'res' is wrong!")
if (inherits(icon, "tclObj")) class(icon) <- c(class(icon), "tclIcon")
return(icon)
}
`tk2ico.pos<-` <- function (icon, value)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#if (length(value) != 1 || !is.numeric(value))
# stop("'value' must be numeric and of length one!")
#value <- round(value)
#res <- tclvalue(.Tcl(paste("catch {winico pos ", icon, " ", value, "}",
# sep = "")))
#if (res != "0") stop("Error while changing default position of the icon!")
#return(icon)
}
## iconfile can be either an .ico file, or an .exe
tk2ico.setFromFile <- function (win, iconfile)
{
## This is the simplest way to set a tk window icon
tkwm.iconbitmap(win, iconfile)
}
tk2ico.set <- function (win, icon, pos = NULL, type = c("all", "small", "big"))
{
## Note that pos and typer are not supported any more (were winico.dll features)!
if (!missing(pos)) warning("'pos' argument deprecated from tcltk2 1.2-2")
if (!missing(type)) warning("'type' argument deprecated from tcltk2 1.2-2")
## Integer for win is not supported any more
if (inherits(win, "integer"))
stop("Integers for argument win are not supported any more in tcltk > 1.2-0")
## Make sure that the 'ico' package is loaded
.tk2ico.require()
if (!inherits(win, "tkwin") || length(win) < 1)
stop("'win' is not a \"tkwin\" object")
if (!inherits(icon, "tclIcon"))
stop("'icon' is not a \"tclIcon\" object!")
## Change the icon of a Tk window
tcl("wm", "iconphoto", win, icon)
## This is old code that used winico.dll
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
## win is either a tkwin object, or the HWND of a foreign window
#if (!inherits(win, c("tkwin", "integer")) || length(win) < 1)
# stop("'win' is not a \"tkwin\" object, or an integer (Window handle)!")
#if (is.integer(win)) win <- win[1]
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#if (!is.null(pos) && (length(pos) != 1 || !is.numeric(pos)))
# stop("'pos' must be numeric and of length one, or NULL!")
#type <- match.arg(type)
#if (type == "all") { # We search for highest quality icons
# ## Determine which icons are better in the resource
# info <- tk2ico.info(icon, convert = TRUE)
# if (nrow(info) == 1) { # Only one icon in the ressource
# resSmall <- tclvalue(.Tcl(paste("catch {winico setwindow ", win, " ",
# icon, " small}", sep = "")))
# resBig <- tclvalue(.Tcl(paste("catch {winico setwindow ", win, " ",
# icon, " big}", sep = "")))
# } else { # There are several icons in the resource
# ## Are there 16x16 icons?
# pos16 <- info[info$geometry == "16x16", ]$pos
# if (length(pos16) > 0) pos16 <- max(pos16) else pos16 <- 0
# resSmall <- tclvalue(.Tcl(paste("catch {winico setwindow ", win,
# " ", icon, " small ", pos16, "}", sep = "")))
# ## Are there 32x32 icons?
# pos32 <- info[info$geometry == "32x32", ]$pos
# if (length(pos32) > 0) pos32 <- max(pos32) else
# pos32 <- max(info$pos)
# resBig <- tclvalue(.Tcl(paste("catch {winico setwindow ", win, " ",
# icon, " big ", pos32, "}", sep = "")))
# }
# ## Compute res, a vector of two logical values, with "0" == success
# res <- c((resSmall == "0"), (resBig == "0"))
# names(res) <- c("small", "big")
#} else { # Other type than 'all'
# if (is.null(pos)) pos <- ""
# res <- tclvalue(.Tcl(paste("catch {winico setwindow ", win, " ", icon,
# " ", type, " ", pos, "}", sep = "")))
# res <- (res == "0") # Because "0" if OK, and "1" otherwise
#}
#return(res)
}
tk2ico.taskbar.add <- function(icon, pos = 0, text = tk2ico.text(icon),
leftmenu = NULL, rightmenu = NULL)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#if (length(pos) != 1 || !is.numeric(pos))
# stop("'pos' must be numeric and of length one, or NULL!")
#if (is.null(text)) text <- "" else
# text <- paste (" -text {", paste(text, collapse = "\n"), "}", sep = "")
#if (!inherits(leftmenu, c("tkwin", "NULL")))
# stop("'leftmenu' must be a \"tkwin\" object or NULL!")
#if (!inherits(rightmenu, c("tkwin", "NULL")))
# stop("'rightmenu' must be a \"tkwin\" object or NULL!")
#if (!is.null(leftmenu) || !is.null(rightmenu)) {
# hicon <- tclvalue(tk2ico.hicon(icon))
# if (is.null(leftmenu)) {
# leftcmd <- ""; leftset <- ""
# } else {
# ## The command to trigger the left-click menu
# leftcmd <- paste('if { $msg == "WM_LBUTTONUP" } { $::leftmenu',
# hicon, ' post $x $y }\n', sep = "")
# ## ... and the appropriate name for our left-click menu
# leftset <- paste('set leftmenu', hicon, ' ', leftmenu$ID, sep = "")
# }
# if (is.null(rightmenu)) {
# rightcmd <- ""; rightset <- ""
# } else {
# ## The command to trigger the right-click menu
# rightcmd <- paste('if { $msg == "WM_RBUTTONUP" } { $::rightmenu',
# hicon, ' post $x $y }\n', sep = "")
# ## ... and the appropriate name for our right-click menu
# rightset <- paste('set rightmenu', hicon, ' ', rightmenu$ID, sep = "")
# }
# ## Create the proc that will handle mouse clicks on our taskbar icon
# cmd <- paste('catch { ', leftset, '\n', rightset, '\n',
# 'proc taskbarcallback', hicon, ' { hicon msg ico x y } {\n',
# leftcmd, rightcmd, '}}', sep = "")
# if (tclvalue(.Tcl(cmd)) != "0")
# stop("Error while creating the callback for this icon!")
# ## Finally define the callback call
# callback <- paste(' -callback "taskbarcallback', hicon, ' ', hicon,
# ' %m %i %X %Y"', sep = "")
#} else callback <- ""
## Install the taskbar icon
#res <- tclvalue(.Tcl(paste("catch {winico taskbar add ", icon, " -pos ",
# round(pos), text, callback, "}", sep = "")))
#return(res == "0") # "0" if success, "1" if error
}
tk2ico.taskbar.delete <- function (icon)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
## First delete the Tcl procs that handle our taskbar icon events
#hicon <- tclvalue(tk2ico.hicon(icon))
#.Tcl(paste('catch {',
# 'unset -nocomplain taskbarcallback', hicon, '\n',
# 'unset -nocomplain leftmenu', hicon, '\n',
# 'unset -nocomplain rightmenu', hicon, '\n',
# '}', sep = ""))
## Then delete the taskbar icon
#res <- tclvalue(.Tcl(paste("catch {winico taskbar delete ", icon, "}",
# sep = "")))
#return(res == "0") # return "0" if OK, "1" otherwise
}
tk2ico.taskbar.modify <- function (icon, pos = NULL, text = NULL)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#if (!is.null(pos)) {
# if (length(pos) != 1 || !is.numeric(pos))
# stop("'pos' must be numeric and of length one, or NULL!")
# pos <- paste(" -pos", round(pos))
#}
#if (is.null(text)) text <- "" else
# text <- paste (" -text {", paste(text, collapse = "\n"), "}", sep = "")
#cmd <- paste("catch {winico taskbar modify ", icon, pos, text, "}", sep = "")
#return(tclvalue(.Tcl(cmd)) == "0") # "0" if OK, "1" otherwise
}
tk2ico.text <- function (icon)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(NULL)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#res <- try(text <- tclvalue(tcl("winico", "text", icon)), silent = TRUE)
#if (inherits(res, "try-error")) # Tcl error is unreadable, put another one!
# stop("Error getting the text associated with an icon!")
#return(res)
}
`tk2ico.text<-` <- function (icon, value)
{
## This is not supported any more, was a winico.dll-specific function!
stop("This function is not supported any more in tcltk2 >= 1.2-0")
#if (!is.tk()) return(NULL)
#if (.Platform$OS.type != "windows") return(icon)
#if (!inherits(icon, "tclIcon"))
# stop("'icon' is not a \"tclIcon\" object!")
#if (length(value) < 1)
# stop("'value' must not be empty or NULL!")
#value <- paste(value, collapse = "\n")
#res <- tclvalue(.Tcl(paste("catch {winico text ", icon, " {", value, "}}",
# sep = "")))
#if (res != "0") stop("Error while changing text of the icon!")
#return(icon)
}
Try the tcltk2 package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.