I have created a progress bar to keep tabs on the execution of some R scripts. And I want to insert a custom icon in the bar instead of the default 'Tk' one. I am able to do this on Windows using a .ico file and the following command
tcl('wm', 'iconbitmap', .win, 'Icon.ico')
But I am a loss about how to do the same in Mac OSX and Linux. Obviously, the .ico format doesn't work but neither does .png, .jpg, .bmp, .xbm or .xpm. Any suggestion on how I could proceed? Sample image and progress bar code attached below:-
Sample image http://tinypic.com/r/jt8efn/6 - http://tinypic.com/r/jt8efn/6
tkProgressBar2 <- function (title = 'Test progress bar', label = '', min = 0, max = 100, initial = 0, width = 300, userfn='helvetica', backg='white') {
useText <- FALSE
have_ttk <- as.character(tcl('info', 'tclversion')) >= '8.5'
if (!have_ttk && as.character(tclRequire('PBar')) == 'FALSE') useText <- TRUE
.win <<- tktoplevel(background=backg)
tkfocus()
tcl('wm', 'geometry', .win, '500x100+450+350')
tcl('wm', 'iconbitmap', .win, '#Icon.xbm')
.val <- initial
.killed <- FALSE
tkwm.geometry(.win, sprintf('%dx80', width + 40))
tkwm.title(.win, title)
fn <- tkfont.create(family = userfn, size = 12)
if (useText) {
.lab <- tklabel(.win, text = label, font = fn, padx = 0, background=backg)
tkpack(.lab, side = 'left')
fn2 <- tkfont.create(family = userfn, size = 16)
.vlab <- tklabel(.win, text = '0%', font = fn2, padx = 20, background=backg)
tkpack(.vlab, side = 'right')
up <- function(value) {
if (!is.finite(value) || value < min || value > max) return()
.val <<- value
tkconfigure(.vlab, text = sprintf('%d%%', round(100 * (value - min)/(max - min))))
}
} else {
.lab <- tklabel(.win, text = label, font = fn, pady = 0, background=backg)
.tkval <- tclVar(0)
tkpack(.lab, side = 'top')
tkpack(tklabel(.win, text = '', font = fn, background=backg), side = 'bottom')
pBar <- if (have_ttk)
ttkprogressbar(.win, length = width, variable = .tkval) else
tkwidget(.win, 'ProgressBar', width = width, variable = .tkval)
tkpack(pBar, side = 'bottom')
up <- function(value) {
if (!is.finite(value) || value < min || value > max) return()
.val <<- value
tclvalue(.tkval) <<- 100 * (value - min)/(max - min)
}
}
getVal <- function() .val
kill <- function() if (!.killed) {
tkdestroy(.win)
.killed <<- TRUE
}
title <- function(title) tkwm.title(.win, title)
lab <- function(label) tkconfigure(.lab, text = label)
tkbind(.win, '<Destroy>', function() stop())
up(initial)
structure(list(getVal = getVal, up = up, title = title, label = lab, kill = kill), class = 'tkProgressBar')
}
pb <- tkProgressBar2(title='Performing k-Means clustering', label='Some information in %', min=0, max=100, initial=0, width=400, userfn='verdana', backg='white')
On Linux you set the icon with wm iconphoto; wm iconbitmap does something else entirely. To do that, you'll need to create a photo image with the image data in it.
I'm guessing that you write this in R as:
tcl('wm', 'iconphoto', .win, tcl('image', 'create', 'photo', '-file', 'Icon.gif'))
I'm not quite sure which image formats are supported by the version of Tk you're using, including any image format support packages it has available. The minimal set is GIF and PPM unless you're (bravely) using 8.6, when PNG is also available by default.
(You can also create the content of a photo image programatically, but that's slow for various reasons.)
OSX doesn't have window icons in the same sense; it's normal for each minimized window to just show a snapshot of itself when it is minimized to the dock.
Related
enter image description hereI copied the exercise code but it is for cereal, how do I change it to show air quality? I will attach a picture for reference from the book rstudio for dummies. I try inputting the data set but it throws off my app.
library(shinydashboard)
library(MASS)
ui <- dashboardPage(
dashboardHeader(title = "Brushing"),
dashboardSidebar(collapsed = TRUE),
dashboardBody(
fluidRow(
plotOutput("CerealPlot",
click = "single_click",
hover = "hovering",
brush = "brushing")
),
box((verbatimTextOutput("coords")), width = 8)
)
)
head(airquality)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$CerealPlot <- renderPlot({
plot(x=UScereal$protein, y=UScereal$calories,
xlab="Protein(gm)",
ylab="Calories",
pch=as.character(UScereal$mfr))
})
output$coords <- renderPrint({
nearPoints(UScereal, input$single_click,
xvar = "protein", yvar = "calories", threshold=20)
})
}
# Run the application
shinyApp(ui=ui, server = server)
Ciao,
I have some trouble in changing font color in my flextable.
The R version is 3.5.2
I am working on this object since I have to add the table on a pptx presentation and to do this I will of course use officer package. Let me show you a dummy code and the output:
library(officer)
library(flextable)
ppt <- read_pptx()
ppt <- add_slide( ppt, layout = "Title and Content", master = "Office Theme")
ppt <- ph_with_text(ppt, "Title whatever", type = "title")
df = head(mtcars)
ft = flextable(df)
ft <- bg(ft, i = 1, bg = "#FF0000", part = "body")
ft <- bg(ft, i = 1, bg = "#FF0000", part = "header")
ft <- fontsize(ft, i = 1, size = 15, part = "body")
ft <- fontsize(ft, i = 1, size = 20, part = "header")
ft <- color(ft, i = 1, color = "#FFFFFF", part = "body")
ft <- color(ft, i = 1, color = "white", part = "header")
ft <- font(ft, i = 1, fontname = "Consolas", part = "header")
ft <- autofit(ft)
ppt <- ph_with_flextable(ppt, ft)
if(file.exists("prova.pptx"))
file.remove("prova.pptx")
print(x = ppt, target = "prova.pptx")
As you can see I apply to the table a lot of formatting functions but I've noticed that the only one that fails is the "color" function.
The header and the first line of the table should be white. Notice that I've tried to assign to the "color" parameter both values "white" and "#FFFFFF" but in both case it does not work.
It is even more wierd considering that all other settings have been successfully applied.
What I am missing about color function from flextable package? Have you noticed the same issue (bug) ?
Thanks,
Ciao
AM
I have a data table that contains some very wide columns and I want to add a scrolling-bar to make it more presentable. So far I have found examples using a scrolling-bar for the entire table - but ideally I would like to have a scrolling-bar for EACH column in the table if that is possible. Below there is an illustrating example. In this code I want a scrolling-bar for both "This_is_a_very_long_name_1", "This_is_a_very_long_name_2" etc.
library("shinydashboard")
library("shiny")
body <- dashboardBody(
fluidPage(
column(width = 4,
box(
title = "Box title", width = NULL, status = "primary",
div(style = 'overflow-x: scroll', tableOutput('table'))
)
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Column layout"),
dashboardSidebar(),
body
)
server <- function(input, output) {
test.table <- data.frame(lapply(1:8, function(x) {1:10}))
names(test.table) <- paste0('This_is_a_very_long_name_', 1:8)
output$table <- renderTable({
test.table
})
}
# Preview the UI in the console
shinyApp(ui = ui, server = server)
I thought about splitting the table into 8 tables, making a scrolling table for each of them and then putting them next to each other, but space was added betweeen them and it did not look that nice. I think it would be preferable to keeping it as one table (but suggestions are very welcome!).
Does anyone whether this is possible - and how to solve it?
Thanks in advance!
I would not recommend scrolling column header, i think it would not be very clear to read it or so. Here is the code which You can use to get the header in 2 lines so the columns are not too wide:
library("shinydashboard")
library("shiny")
library(DT)
test.table <- data.frame(lapply(1:8, function(x) {1:10}))
names(test.table) <- paste0('This_is_a_very_long_name_', 1:8)
body <- dashboardBody(
fluidPage(
column(width = 8,
box(
title = "Box title", width = NULL, status = "primary",
div(style = 'overflow-x: scroll', dataTableOutput('table'))
)
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Column layout"),
dashboardSidebar(),
body
)
server <- function(input, output) {
output$table <- renderDataTable({
names(test.table) <- gsub("_"," ",names(test.table))
datatable(test.table, options = list(columnDefs = list(list(width = '100px', targets = c(1:8)))))
})
}
# Preview the UI in the console
shinyApp(ui = ui, server = server)
[UPDATE] --> Column text rendering
Here is a one solution which can be usefull for You. There is no scrolling, however Your row text displays only first three characters (the number of characters displayed can be changed) and ..., with mouse over the row You get the pop up with whole variable name in this row:
library("shinydashboard")
library("shiny")
library(DT)
x <- c("aaaaaaaaaaaaaa", "bbbbbbbbbbbb", "ccccccccccc")
y <- c("aaaaaaaaaaaaaa", "bbbbbbbbbbbb", "ccccccccccc")
z <- c(1:3)
data <- data.frame(x,y,z)
body <- dashboardBody(
fluidPage(
column(width = 4,
box(
title = "Box title", width = NULL, status = "primary",
div(style = 'overflow-x: scroll', dataTableOutput('table'))
)
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Column layout"),
dashboardSidebar(),
body
)
server <- function(input, output) {
output$table <- renderDataTable({
datatable(data, options = list(columnDefs = list(list(
targets = c(1:3),
render = JS(
"function(data, type, row, meta) {",
"return type === 'display' && data.length > 3 ?",
"'<span title=\"' + data + '\">' + data.substr(0, 3) + '...</span>' : data;",
"}")),list(width = '100px', targets = c(1:3)))))
})
}
# Preview the UI in the console
shinyApp(ui = ui, server = server)
I have an image and rotate it with both MS Paint and GDI. I want to show that the rotated image from both methods are the same.
Here is the code I have to rotate image with GDI
#include <GDIPlus.au3>
_GDIPlus_Startup()
$hImage1 = _GDIPlus_ImageLoadFromFile(#ScriptDir & "\Picture.gif")
$hGraphic1 = _GDIPlus_ImageGetGraphicsContext($hImage1)
$hImage2 = _GDIPlus_BitmapCreateFromGraphics(_GDIPlus_ImageGetWidth($hImage1), _GDIPlus_ImageGetHeight($hImage1), $hGraphic1)
$hGraphic2 = _GDIPlus_ImageGetGraphicsContext($hImage2)
$matrix = _GDIPlus_MatrixCreate()
_GDIPlus_MatrixRotate($matrix,90)
_GDIPlus_GraphicsSetTransform($hGraphic2, $matrix)
_GDIPlus_GraphicsDrawImage($hGraphic2, $hImage1, 0, -590)
_GDIPlus_ImageSaveToFile($hImage2, #ScriptDir & "\out.gif")
_GDIPlus_MatrixDispose($matrix)
_GDIPlus_GraphicsDispose($hGraphic1)
_GDIPlus_GraphicsDispose($hGraphic2)
_GDIPlus_ImageDispose($hImage1)
_GDIPlus_ImageDispose($hImage2)
_GDIPlus_ShutDown ()
Then I used this code to compare 2 images:
$bm1 = _GDIPlus_ImageLoadFromFile(#ScriptDir & "\Picture1.gif")
$bm2 = _GDIPlus_ImageLoadFromFile(#ScriptDir & "\out.gif")
if ComparePicture($bm1, $bm2) == True Then
MsgBox(0, "Test result", "Same image!")
Else
MsgBox(0, "Test result", "Different image!")
EndIf
_GDIPlus_ImageDispose($bm1)
_GDIPlus_ImageDispose($bm2)
_GDIPlus_Shutdown()
Func ComparePicture($bm1, $bm2)
$Bm1W = _GDIPlus_ImageGetWidth($bm1)
$Bm1H = _GDIPlus_ImageGetHeight($bm1)
$BitmapData1 = _GDIPlus_BitmapLockBits($bm1, 0, 0, $Bm1W, $Bm1H, $GDIP_ILMREAD, $GDIP_PXF08INDEXED )
$Stride = DllStructGetData($BitmapData1, "Stride")
$Scan0 = DllStructGetData($BitmapData1, "Scan0")
$ptr1 = $Scan0
$size1 = ($Bm1H - 1) * $Stride + ($Bm1W - 1) * 4
$Bm2W = _GDIPlus_ImageGetWidth($bm2)
$Bm2H = _GDIPlus_ImageGetHeight($bm2)
$BitmapData2 = _GDIPlus_BitmapLockBits($bm2, 0, 0, $Bm2W, $Bm2H, $GDIP_ILMREAD, $GDIP_PXF08INDEXED)
$Stride = DllStructGetData($BitmapData2, "Stride")
$Scan0 = DllStructGetData($BitmapData2, "Scan0")
$ptr2 = $Scan0
$size2 = ($Bm2H - 1) * $Stride + ($Bm2W - 1) * 4
$smallest = $size1
If $size2 < $smallest Then $smallest = $size2
$call = DllCall("msvcrt.dll", "int:cdecl", "memcmp", "ptr", $ptr1, "ptr", $ptr2, "int", $smallest)
_GDIPlus_BitmapUnlockBits($bm1, $BitmapData1)
_GDIPlus_BitmapUnlockBits($bm2, $BitmapData2)
Return ($call[0]=0)
EndFunc
I tried changing the file type, color depth, etc. but I could not get the code to show that they are the same. When I do not rotate the picture i.e
_GDIPlus_MatrixRotate($matrix,0)
then it recognize the same image. When I rotate right 90, it doesn't. Does anyone knows what might be going on?
Thanks
For reference, this question has also been asked on the AutoIt forums here.
I think $GDIP_PXF08INDEXED is modifying the images differently. Try it without setting it and it should work.
Furthermore, you can use this code to flip the image:
$hImage1 = _GDIPlus_ImageLoadFromFile(#ScriptDir & "\Picture1.gif")
_GDIPlus_ImageRotateFlip($hImage1, 1) ;90°
_GDIPlus_ImageSaveToFile($hImage1, #ScriptDir & "\out.gif")
_GDIPlus_ImageDispose($hImage1)
Br,
UEZ
I need a bar which indicate a percentage of something, like battery engry or used space size of a hard disk. Like
This is not a progress bar. When I use progress bar, each time I send the message PBM_SETPOS, it will increase from 0 to the pos.
The bar must have the ability for me to set a value manually, and after it, it will change the color region to the specified length directly, rather than in a increasement way.
Does WinAPI has a build in function for this purpose?
Use a Panel and then set a label with in it...Then set the width of label with backcolor based on percentage...
Code as follows:
string s27 = "select percentage from CandidateReg3 where candidateid='" + candidateid + "'";
DataTable d17 = cn.viewdatatable(s27);
if (d17.Rows.Count > 0) {
for (int m = 0; m < d17.Rows.Count; m++) {
percreg3 = int.Parse(d17.Rows[m]["percentage"].ToString());
percregtotal = percreg3 + percreg;
}
} else {
percregtotal = percreg;
}
decimal percregtotals = (decimal)percregtotal / 100;
double percent = Convert.ToDouble(percregtotals);
// double percent = 1;
IndicatorLabel.Width = new Unit(percent * IndicatorPanel.Width.Value, UnitType.Pixel);
IndicatorLabel.ToolTip = percent.ToString("p0");
IndicatorLabel.Text = percent.ToString("p0");
IndicatorLabel.ForeColor=Color.White;
// IndicatorLabel.Text = "";
IndicatorLabel.BackColor = Color.Green;