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 }
___
uniquename 2014jan27
For those who do not have the facilities or time to implement the code above, here is an image of the Tk canvas produced by the Oakley code snippet above, which uses Oakley's 'gradient' code (below).
When I ran this code on my system (Linux - Ubuntu 9.10 ; Tcl-Tk 8.5), the window showed up 'horizontally collapsed'. That is, it showed up as a tall, very thin window (all borders) on the left of my screen.
By 'grabbing' the right side of the thin window and 'pulling it' to the right, I was able to reveal the gradient image above. A Tcler could do like KPV did below --- add a '-width' parameter to the 'frame' statement.
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 } }
___
uniquename 2014jan27
For those who do not have the facilities or time to implement the code above, here is an image of the Tk canvas produced by the KPV (Keith Vetter) code above, which uses Oakley's 'gradient' code (below).
Note that Vetter is using the 'gradient' routine to set the background color of a series of vertically stacked (packed) Tk 'frame' widgets, each of size 100x1 pixels.
Those vertically-stacked, thin frames are stacked within seven color frames that are horizontally-packed with '-side left'.
For another method of making color-gradients in rectangles, see the wiki page Photo Gradients. The code there, by GPS, uses a single Tk 'photo' image placed on a Tk canvas. Loops of image 'put' commands are used to build several different color gradients within the 'photo' image structure.
# 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. ]