HaO 2025-08-29: On ETCL conference 2025, John from Decent Expresso demonstrated a user interface with AndroWish and a glow effect on buttons, to give a user feedback that a button was pressed.
Here is Johns recipe:
It’s quite simple, just set up a few “after” commands to change the color when the button is clicked. Here are the colors and timings that worked well for me.
set ::dataentry_button_color "#C9C9C9"
set ::dataentry_button_color_flash1 "#888888"
set ::dataentry_button_color_flash2 "#666666"
proc flash_dataentry_button {buttontag} {
.can itemconfigure ${buttontag}-btn -fill $::dataentry_button_color_flash1
after 40 .can itemconfigure ${buttontag}-btn -fill $::dataentry_button_color_flash2
after 200 .can itemconfigure ${buttontag}-btn -fill $::dataentry_button_color_flash1
after 280 .can itemconfigure ${buttontag}-btn -fill $::dataentry_button_color
}Here is my working example:
set ::dataentry_button_color "#C9C9C9"
set ::dataentry_button_color_flash1 "#888888"
set ::dataentry_button_color_flash2 "#666666"
canvas .can -width 100 -height 100 -bg white
pack .can -fill both -expand true
set id [.can create text 50 50 -text "BUTTON" -fill $::dataentry_button_color]
.can bind $id <1> [list cmdglow .can $id "puts ."]
proc cmdglow {can id cmd} {
$can itemconfigure $id -fill $::dataentry_button_color_flash1
after 40 [list $can itemconfigure $id -fill $::dataentry_button_color_flash2]
after 200 [list $can itemconfigure $id -fill $::dataentry_button_color_flash1]
after 280 [list $can itemconfigure $id -fill $::dataentry_button_color]
eval $cmd
}Here is Johns full example of canvas painted buttons:
#!/usr/bin/env wish
# Create the main window
wm title . "Rounded Rectangle Example"
wm geometry . 400x300
# Create a canvas widget
canvas .canvas -width 400 -height 300 -bg white
pack .canvas -fill both -expand true
# Procedure to draw a rounded rectangle
proc draw_rounded_rect {canvas x1 y1 x2 y2 radius {fill ""} {outline "black"} {width 1}} {
# Calculate dimensions
set w [expr {$x2 - $x1}]
set h [expr {$y2 - $y1}]
# Ensure radius doesn't exceed half the width or height
set max_radius [expr {min($w, $h) / 2}]
if {$radius > $max_radius} {
set radius $max_radius
}
# Create the rounded rectangle using multiple elements
set items {}
# Main rectangle (without corners)
lappend items [$canvas create rectangle \
[expr {$x1 + $radius}] $y1 \
[expr {$x2 - $radius}] $y2 \
-fill $fill -outline "" -width $width -tags all]
# Left rectangle
lappend items [$canvas create rectangle \
$x1 [expr {$y1 + $radius}] \
[expr {$x1 + $radius}] [expr {$y2 - $radius}] \
-fill $fill -outline "" -width $width -tags all]
# Right rectangle
lappend items [$canvas create rectangle \
[expr {$x2 - $radius}] [expr {$y1 + $radius}] \
$x2 [expr {$y2 - $radius}] \
-fill $fill -outline "" -width $width -tags all]
# Four corner arcs
# Top-left corner
lappend items [$canvas create arc \
$x1 $y1 \
[expr {$x1 + 2*$radius}] [expr {$y1 + 2*$radius}] \
-start 90 -extent 90 -style pieslice \
-fill $fill -outline "" -width $width -tags all]
# Top-right corner
lappend items [$canvas create arc \
[expr {$x2 - 2*$radius}] $y1 \
$x2 [expr {$y1 + 2*$radius}] \
-start 0 -extent 90 -style pieslice \
-fill $fill -outline "" -width $width -tags all]
# Bottom-right corner
lappend items [$canvas create arc \
[expr {$x2 - 2*$radius}] [expr {$y2 - 2*$radius}] \
$x2 $y2 \
-start 270 -extent 90 -style pieslice \
-fill $fill -outline "" -width $width -tags all]
# Bottom-left corner
lappend items [$canvas create arc \
$x1 [expr {$y2 - 2*$radius}] \
[expr {$x1 + 2*$radius}] $y2 \
-start 180 -extent 90 -style pieslice \
-fill $fill -outline "" -width $width -tags all]
set outline ""
# Add outline if specified
if {$outline ne ""} {
# Top edge
lappend items [$canvas create line \
[expr {$x1 + $radius}] $y1 \
[expr {$x2 - $radius}] $y1 \
-fill $outline -width $width -tags all]
# Bottom edge
lappend items [$canvas create line \
[expr {$x1 + $radius}] $y2 \
[expr {$x2 - $radius}] $y2 \
-fill $outline -width $width -tags all]
# Left edge
lappend items [$canvas create line \
$x1 [expr {$y1 + $radius}] \
$x1 [expr {$y2 - $radius}] \
-fill $outline -width $width -tags all]
# Right edge
lappend items [$canvas create line \
$x2 [expr {$y1 + $radius}] \
$x2 [expr {$y2 - $radius}] \
-fill $outline -width $width -tags all]
# Corner arcs for outline
lappend items [$canvas create arc \
$x1 $y1 \
[expr {$x1 + 2*$radius}] [expr {$y1 + 2*$radius}] \
-start 90 -extent 90 -style arc \
-outline $outline -width $width -tags all]
lappend items [$canvas create arc \
[expr {$x2 - 2*$radius}] $y1 \
$x2 [expr {$y1 + 2*$radius}] \
-start 0 -extent 90 -style arc \
-outline $outline -width $width -tags all]
lappend items [$canvas create arc \
[expr {$x2 - 2*$radius}] [expr {$y2 - 2*$radius}] \
$x2 $y2 \
-start 270 -extent 90 -style arc \
-outline $outline -width $width -tags all]
lappend items [$canvas create arc \
$x1 [expr {$y2 - 2*$radius}] \
[expr {$x1 + 2*$radius}] $y2 \
-start 180 -extent 90 -style arc \
-outline $outline -width $width -tags all]
}
return $items
}
set ::plus_minus_flash_on_color "#b8b8b8"
set ::plus_minus_flash_on_color2 "#cfcfcf"
set ::plus_minus_flash_off_color "#ededed"
proc flash_button {} {
set buttontag "all"
.canvas itemconfigure ${buttontag} -fill $::plus_minus_flash_on_color2
after 40 .canvas itemconfigure ${buttontag} -fill $::plus_minus_flash_on_color
after 200 .canvas itemconfigure ${buttontag} -fill $::plus_minus_flash_on_color2
after 280 .canvas itemconfigure ${buttontag} -fill $::plus_minus_flash_off_color
}
# Draw some example rounded rectangles
draw_rounded_rect .canvas 50 50 200 120 20 "$::plus_minus_flash_off_color" "blue" 2
draw_rounded_rect .canvas 220 50 350 120 15 "$::plus_minus_flash_off_color" "darkgreen" 1
draw_rounded_rect .canvas 50 150 200 220 30 "$::plus_minus_flash_off_color" "red" 3
draw_rounded_rect .canvas 220 150 350 220 10 "$::plus_minus_flash_off_color" "orange" 2
after 1000 flash_button
after 2000 flash_button
after 3000 flash_button
# Add a label
label .label -text "Rounded Rectangle Examples in Tcl/Tk" -font {Arial 14 bold}
pack .label -pady 10My personal use-case is more a ttk::button with an image. One may give a user feedback by providing different images for different states. Unfortunately, the state "pressed" is not activated, if the button is pressed. It may only be activated by "$b state pressed":
image create photo img -width 32 -height 32
img put #ffccaa -to 0 0 32 32
image create photo img_active -width 32 -height 32
img_active put #ff6600 -to 0 0 32 32
image create photo img_pressed -width 32 -height 32
img_pressed put #ffff00 -to 0 0 32 32
pack [ttk::button .b -style Toolbutton -image {img active img_active pressed img_pressed} -command {puts .}]The active color is not of much use on Androwish, as there is no mouse enter event. Here is a glow effect by changing the image by Johns timing:
image create photo img -width 32 -height 32
img put #aa4400 -to 0 0 32 32
image create photo img_glow1 -width 32 -height 32
img_glow1 put #ff7f2a -to 0 0 32 32
image create photo img_glow2 -width 32 -height 32
img_glow2 put #ffccaa -to 0 0 32 32
pack [ttk::button .b -style Toolbutton -image img -command {cmdglow .b img_glow1 img_glow2 {puts .}}]
proc cmdglow {button imageGlow1 imageGlow2 cmd} {
set imageOri [$button cget -image]
$button configure -image $imageGlow1
after 40 [list $button configure -image $imageGlow2]
after 200 [list $button configure -image $imageGlow1]
after 280 [list $button configure -image $imageOri]
eval $cmd
}It would be great to create the glow-images "on the fly" from the original images by having a flash-light on the image.
chw BTW: Enter/leave events are possible in AndroWish, if a physical (e.g. Bluetooth) mouse is connected. The example code has a problem with timers and repeated ButtonPress events. Push the button in a frequency higher than 1000/280 Hz and you might end up with wrong colors. Therefore a coroutine might be helpful here to introduce some state handling, e.g.
image create photo img -width 32 -height 32
img put #aa4400 -to 0 0 32 32
image create photo img_glow1 -width 32 -height 32
img_glow1 put #ff7f2a -to 0 0 32 32
image create photo img_glow2 -width 32 -height 32
img_glow2 put #ffccaa -to 0 0 32 32
pack [ttk::button .b -style Toolbutton -image img \
-command {cmdglow .b img img_glow1 img_glow2 {puts .}}]
proc cmdglow {button imageOri imageGlow1 imageGlow2 cmd} {
# .CORO is illegal widget name, thus used for coroutine name
if {[info command $button.CORO] ne {}} {
$button.CORO [list $imageOri $imageGlow1 $imageGlow2 $cmd]
} else {
coroutine $button.CORO apply {
{button imageOri imageGlow1 imageGlow2 cmd} {
$button configure -image $imageOri
set timer_list {40 200 280}
set img_list {imageOri imageGlow2 imageGlow1 imageOri}
set img_llen [llength $img_list]
set step 0
$button configure -image [set [lindex $img_list $step]]
eval $cmd
after cancel $button.CORO
after [lindex $timer_list $step] $button.CORO
while {[winfo exists $button]} {
set args [yield]
if {$args ne {}} {
lassign $args imageOri imageGlow1 imageGlow2 cmd
set step 0
$button configure -image [set [lindex $img_list $step]]
eval $cmd
after cancel $button.CORO
after [lindex $timer_list $step] $button.CORO
} elseif {$step < $img_llen} {
incr step
$button configure -image [set [lindex $img_list $step]]
if {$step < $img_llen - 1} {
after cancel $button.CORO
after [lindex $timer_list $step] $button.CORO
}
}
}
}
} $button $imageOri $imageGlow1 $imageGlow2 $cmd
}
}