gammaButton
TFW - I was toying around with trying to find modernize buttons with graphics and I found a clever use for the -gamma function. The code below creates a little button bar that when the mouse is over a button, the image is brightened and when depressed darkens. Not unlike many applications. This can be easily combined with button help to create nice effects. ---
#----------------------------------------------------------------------------
# Demo to show how gamma correction can be used to highlight button images
#----------------------------------------------------------------------------
namespace eval gammaButton {
}
package require Img
console show
#----------------------------------------------------------------------------
# Select the appropriate image
#----------------------------------------------------------------------------
proc gammaButton::button {w} {
set img [$w cget -image]
if {$img ne ""} {
rewrite $img ;# This seems to allow gamma to work for png images
bind $w <Any-Enter> [list gammaButton::_buttonProcess enter %W]
bind $w <Any-Leave> [list gammaButton::_buttonProcess leave %W]
bind $w <ButtonPress-1> [list gammaButton::_buttonProcess down %W ]
bind $w <ButtonRelease-1> [list gammaButton::_buttonProcess leave %W ]
}
}
#----------------------------------------------------------------------------
# Callback to handle the highlights, ignore sunken (depressed) buttons
#----------------------------------------------------------------------------
proc gammaButton::_buttonProcess {how w} {
##
# brighten/darken image
#
set ok [expr {[$w cget -relief] != "sunken"}]
switch -- $how {
"enter" {
if {$ok} {
[$w cget -image] configure -gamma 2
}
}
"leave" {
if {$ok} {
[$w cget -image] configure -gamma 1
}
}
"down" {
[$w cget -image] configure -gamma .5
}
default {}
}
}
#----------------------------------------------------------------------------
# Rewrite the transparency bits, needed to gamma correct
# pngs with alpha channels (tk bug?). Not needed for gifs.
#----------------------------------------------------------------------------
proc gammaButton::rewrite {image} {
set width [image width $image]
set height [image height $image]
for {set y 0} {$y < $height} {incr y} {
set row [list]
for {set x 0} {$x < $width} {incr x} {
set trbit [$image transparency get $x $y]
lappend trans $x $y $trbit
}
}
foreach {x y t} $trans {
$image transparency set $x $y $t
}
}
#----------------------------------------------------------------------------
# Sample images
#----------------------------------------------------------------------------
image create photo actions-player_start -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/I
NwWK6QAAABl0RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAIe
SURBVHjaYrBN3fRfzmfpfwYGBh4GYoHxzPrgst3vGXQ7awACiEVPU4rhx+9n
DI8YGHiBUl8IaPTXUxed0JRlrmBrJMWwdssRWYAAYnn5lYHh62+CNsrz83Es
KEwyd4jzVmf484+B4c03iBRAALG8AhnwC6dGfiDZEBZoXJAaosPAxMbOcOIJ
A8M/oIcVBSFKAAIIYsBvrJrzVdSkGwrS7QSEhHkZzrxmYPj5FyHNww6hAQKI
5dNPoMQfFI32PEL8E2JjbA2UlKUYrr5nYPj2HtN8aV4IDRBALKDgB2EGmVAF
FgXfaUa2BgEuzroMt98xMFy7jTtYYAYABBALTEDILPKYua8XAzPQnzvvIhQy
4jDgLTQQAQKICSbw6dH9k9cuP2B4/oWwZmQAEEBwF/w5Uxz48C+b5fu7tyfI
GBvJCkhL4dcI1QkQQCwsQDcwwaw6n7vu03mGjdeezKyR1lEr1rAx5uUW4MVq
AD8XhAYIICZeTgYGdlYUub8MZ9Mbn165pXto4brFD0+eZeBl/ckgAjQHGXNz
QBQDBBALyICPLFisOJv+EJg84i5+nzn33qXbzXa+Frbaxgpw6V9QVwMEEAsf
pgvQDTr4mYHBbuvrKUm3Tss3uAZbyCoqi8ClAQII4gUWIoL7fM6821ef6U5r
WNW8bt4BBqa/P8HCAAHEyGA4eSvD359cDJdKwoH8V0RmZ3mG359yGT5euQUQ
YABfm6OJXIn9ywAAAABJRU5ErkJggg==
}
image create photo actions-player_play -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAB3RJTUUH1gIF
ABAECAIgiAAAAAlwSFlzAAAewgAAHsIBbtB1PgAAAARnQU1BAACxjwv8YQUA
AAH6SURBVHjaY2AAAeOZ891ztt0H0vEMZAHjmfvffvv/f8H2+/+VA1ftB/Lt
STbg5pv//28B8Z23//+n9Zz5L+S8eD5QXJ6QVmYwKeWbEBlsrHDpJQPDiy8M
DOb6Ugwu1ooG7778Sbj/y5KD4fmWgwQNsHMzVnjwgYHh7XcGhkcfGRg+/WNn
sDWT59DTknR4zuaS8JbV7gHQoJvoBrDAGM8/MzDcf48qeeMNA4MwjxRDdraU
wsEjNzds4Vx44Nf3HwUMZ9MvYhgAcjrIBegAJHb2OQODmLw6Q36lgsPG7Vcu
3GKYuQAoBTLoI9yAH78ZGL7+wu7P/0D8BSh37z07g46NMYOkplrCuZ2HAj5/
zFWHG/DzL+6QZoQaAgIPgeHz7OIthu8v7h5muDMZ4YVPQBvYWBjwgtd3HzA8
Onro5s/HR9sZ7s3aABRCeEGIh4HhDxN2jZ/ff2a4uG3/53fXj3Qx3OyeCwpz
jEAEGfCPGVXjzx8/GU7tOstw+8CuWQwvtk9meHfqOlAYxbNwAzg5GBhEWBES
x3ZfZji789CB7/d3NADj/ywoHLG5Dm4ADzcQA+lrl54xbFy499m720eqgP7c
AhR6iy9c4Ab8//aZYeHsY5+vHjkyneF6ywSg0Ct05+KKIQYGw8lBDN+fWTG8
3LWY4f1ZkD9/EdIIAwCJUNZXWEEekwAAAABJRU5ErkJggg==
}
image create photo actions-player_stop -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAB3RJTUUH1gIF
AA4xivDbdAAAAAlwSFlzAAAewgAAHsIBbtB1PgAAAARnQU1BAACxjwv8YQUA
AACTSURBVHjaY2QAArvUTf/tjKQYSAEts45vYzif68cC4uhqSTFEhxiTZsCM
w+JAihNswKsvDAyXX5KkHw4gBnxlYLjyaiAN+PiTgeHRRwoM+A/F5AAmMvUN
IgPAYcACNIadhQIDeDgZGCSFKDCAj4OBQVqQAgN4gS6QpsgFFBjACCYNJ29l
+PdHnCSd3x9vZrjV1wUAo7UkPLXyJE0AAAAASUVORK5CYII=
}
image create photo actions-player_end -data {
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAAK/I
NwWK6QAAABl0RVh0U29mdHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAJO
SURBVHjaYnDO2PJexHnhfgbjmfoMxALjmfkxdfv/MxhO3goQQExG2hICZ5aH
OxTGG18ASswHYn4ijBBwsVNjYPj3RxwggJg+/wLSLOwM2dHGDHsXRiY4WCo9
ANlAyIT7HyA0QAAxfQEacPc9A8PRxwwMX1h4GdrLXQQmNPpMUAhedx9okD1O
A95DaIAAYgEZ8PQzA8ODDwhJMXEphgmtgQrLNl4+sJl74YHvX38kMJxNf4jN
AIAAYgF54flnhACypJqJLkOTuZrDsrVnH5xnmNkAFJoANOgjSO7VV4gagAAC
u+D2W1QXwABIjJWJncHG04rByEq3YeOqQwVvGGYWgOT+Q9UABBDLn78MDK+B
pn39hd2vIIXHgOHDxszL4B3nLXD8wrMFd3ftgssDBBATsVH/C2jR2bufGV5d
ufz57/fPN2HiAAHExAQ0gpUFaAMOzA7ETH9/Mjw/e5bhxqr5mz/sq7YFumst
zACAAGLhYGVgEOJhYPiDwy0PLt5kuH3k+Nnvd3e2MTxeAXL7FwaltACQpSAA
EEAszMwQA/4xo2p8du8Zw7m9Z569unJkOsPN7lmggEeWF+GF0AABxPIbSHBy
AAVYIQJfPv9k2Lf++Ocbhw4sZ3i5ewLD22O3gMJ/0V0GMwAggFi42BkYeLiB
/v3DwLBv01mGEzuPbv56b3cvw/Mtx0FhhytQRfggNEAAgQ24eeEBw6alh26+
unm0neHerA1A8Y+EYgXmAoAAYmTQ7+tk+AFMize75wL5z4nMzvYMf771Mvz+
cBYgwADt09msilOyDgAAAABJRU5ErkJggg==
}
#------------------------------------------------------------------------------
# Demo code
#------------------------------------------------------------------------------
proc demo {args} {
foreach {image} {
actions-player_start
actions-player_play
actions-player_stop
actions-player_end
} {
pack [button .$image -image $image -relief flat] -side left
gammaButton::button .$image
if {[catch {$image write $image.gif -format gif} result] } then {
puts $result
file delete -force $image.gif
} else {
puts "Wrote $image.gif"
}
}
}
demo