I was needing a little proc to give me a color a tad bit lighter or darker than a starting color. The end result is a proc that does just that. It then became pretty darn obvious it could be used to make gradients. -- Bryan Oakley
KPV There's also some code that does this that comes with tcl/tk. The routine tk_setPalette has code that creates new background color by darkening the foreground color. Also, undocumented but in the same source file as tk_setPalette (palette.tcl) is the routine ::tk::Darken which has the following header comment:
# ::tk::Darken -- # Given a color name, computes a new color value that darkens (or # brightens) the given color by a given percent. # # Arguments: # color - Name of starting color. # perecent - Integer telling how much to brighten or darken as a # percent: 50 means darken by 50%, 110 means brighten # by 10%.
This code uses the proc at the end of this page to create a gradient that goes from black to red to white:
set count 0
for {set f -1.0} {$f <= 1.0} {set f [expr {$f + 0.005}]} {
set frame .f[incr count]
frame $frame -background [gradient red $f] -height 1
pack $frame -fill x
}KPV Here's more demo code that shows color gradients for each color of the rainbow.
foreach c {red orange yellow green blue purple violet} {
frame .$c -width 100
pack .$c -side left
set count 0
for {set f -1.0} {$f <= 1.0} {set f [expr {$f + 0.005}]} {
set frame .$c.f[incr count]
frame $frame -background [gradient $c $f] -height 1 -width 100
pack $frame -fill x
}
}
# gradient
#
# adjusts a color to be "closer" to either white or black
#
# Usage:
#
# gradient color factor ?window?
#
# Arguments:
#
# color - standard tk color; either a name or rgb value
# (eg: "red", "#ff0000", etc)
# factor - a number between -1.0 and 1.0. Negative numbers
# cause the color to be adjusted towards black;
# positive numbers adjust the color towards white.
# window - a window name; used internally as an argument to
# [winfo rgb]; defaults to "."
proc gradient {rgb factor {window .}} {
foreach {r g b} [winfo rgb $window $rgb] {break}
### Figure out color depth and number of bytes to use in
### the final result.
if {($r > 255) || ($g > 255) || ($b > 255)} {
set max 65535
set len 4
} else {
set max 255
set len 2
}
### Compute new red value by incrementing the existing
### value by a value that gets it closer to either 0 (black)
### or $max (white)
set range [expr {$factor >= 0.0 ? $max - $r : $r}]
set increment [expr {int($range * $factor)}]
incr r $increment
### Compute a new green value in a similar fashion
set range [expr {$factor >= 0.0 ? $max - $g : $g}]
set increment [expr {int($range * $factor)}]
incr g $increment
### Compute a new blue value in a similar fashion
set range [expr {$factor >= 0.0 ? $max - $b : $b}]
set increment [expr {int($range * $factor)}]
incr b $increment
### Format the new rgb string
set rgb \
[format "#%.${len}X%.${len}X%.${len}X" \
[expr {($r>$max)?$max:(($r<0)?0:$r)}] \
[expr {($g>$max)?$max:(($g<0)?0:$g)}] \
[expr {($b>$max)?$max:(($b<0)?0:$b)}]]
### Return the new rgb string
return $rgb
}
[ We should probably make a point of copying in, or at least referring to, the live color wheel in M&M's book. It's another nice example of several of these ideas. ]