gammaButton

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 <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 -command [list puts "pressed $image"]] -side left
       gammaButton::button .$image
    }
 }
 demo

WJG (04/03/06) Very nice, very fashionable. I'm certain to use this sometime. But, tell me, have you thought about making the gamma undulate during a rollover, so as to make it 'shimmer' or 'pulse'?