Blending/fading widget colors

21 March 2016 By: SeS for integration with tG²
# ------------------------------------------------------------------------
# Purpose       : creates bindings for any widget to fadein/out between 2 colors @ Enter/Leave events
#                 User can choose between foreground or background color, if supported by Widget class...
# Inspired by   : http://wiki.tcl.tk/6100
# usage example : gradientOnMotion $widget darkgreen green
# ------------------------------------------------------------------------
proc gradientOnMotion {w col1Str col2Str {steps 20} {domain -fg} {speed 10} {bindingOnly 1}} {
  if {!$bindingOnly} {
    set color1 [winfo rgb $w $col1Str]
    set color2 [winfo rgb $w $col2Str]
    
    foreach {r1 g1 b1} $color1 break
    foreach {r2 g2 b2} $color2 break
    set rRange [expr $r2.0 - $r1]
    set gRange [expr $g2.0 - $g1]
    set bRange [expr $b2.0 - $b1]
    
    set rRatio [expr $rRange / $steps]
    set gRatio [expr $gRange / $steps]
    set bRatio [expr $bRange / $steps]
    
    for {set i 0} {$i < $steps} {incr i} {
      set nR [expr int( $r1 + ($rRatio * $i) )]
      set nG [expr int( $g1 + ($gRatio * $i) )]
      set nB [expr int( $b1 + ($bRatio * $i) )]
      
      set col [format {%4.4x} $nR]
      append col [format {%4.4x} $nG]
      append col [format {%4.4x} $nB]
      if {[$w cget $domain]=="#${col}"} {return}
      $w configure $domain #${col}
      after $speed; update idletasks
    }
    $w configure $domain $col2Str ;# final state not included in for-loop
    return $w
  } {
    bind $w <Enter> "gradientOnMotion %W $col1Str $col2Str $steps $domain $speed 0"
    bind $w <Leave> "gradientOnMotion %W $col2Str $col1Str $steps $domain $speed 0"
  }
}

# Test with :
pack [label .l -text "Hello World" -fg darkgreen -font {Arial 20 bold}]
gradientOnMotion .l darkgreen green
Category Graphics
Category Tk