[TFW] - I was toying around modernizing 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. The example below uses png images (and thus the requirement for Img) but it works with any image type. I did find one bug however, png images with partial transparency need to be clamped to binary transparency thus the need for the rewrite function. For gif images this isn't necessary. ---- #---------------------------------------------------------------------------- # 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 [list gammaButton::_buttonProcess enter %W] bind $w [list gammaButton::_buttonProcess leave %W] bind $w [list gammaButton::_buttonProcess down %W ] bind $w [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