Created on 2003-06-09 by [Rohan Pall] This is a simple library for [making color gradients], inspired by [GPS]'s code for [drawing gradients on a canvas]. The ''rgbs'' proc assumes that you have a good color display which uses 2 bytes for each color. It then normalizes the colors to 1 byte for each color, which saves on the number of intermediate colors used for making gradients. It returns the intermediate colors in a gradient. This proc can be used by any code that needs to find the intermediate color steps in a gradient. Run ''transx::demo1'', ''transx::demo2'', and ''transx::paint_canvas_demo''. package require Tk namespace eval transx { proc rgbs {n c1 c2} { # Color intensities are from 0 to 65535, 2 byte colors. foreach {r1 g1 b1} [winfo rgb . $c1] break foreach {r2 g2 b2} [winfo rgb . $c2] break #puts "c1: $r1 $g1 $b1" #puts "c2: $r2 $g2 $b2" # Normalize intensities to 0 to 255, 1 byte colors. foreach el {r1 g1 b1 r2 g2 b2} { set $el [expr {[set $el] * 255 / 65535}].0 } #puts "c1: $r1 $g1 $b1" #puts "c2: $r2 $g2 $b2" if {$n == 1} { set r_step 0.0 ; set g_step 0.0 ; set b_step 0.0 } else { set r_step [expr {($r2-$r1) / ($n-1)}] set g_step [expr {($g2-$g1) / ($n-1)}] set b_step [expr {($b2-$b1) / ($n-1)}] } #puts "$r_step $g_step $b_step" set steps {} for {set i 0} {$i < $n} {incr i} { set r [expr {int($r_step * $i + $r1)}] set g [expr {int($g_step * $i + $g1)}] set b [expr {int($b_step * $i + $b1)}] #puts "$r $g $b" lappend steps [format "#%.2X%.2X%.2X" $r $g $b] } return $steps } proc demo1 {} { set n 50 set steps [rgbs $n red royalblue] for {set i 0} {$i < $n} {incr i} { set fr .f$i frame $fr -bg [lindex $steps $i] -height 1 pack $fr -fill x } } proc demo2 {} { set n 50 set steps [rgbs $n yellow red] set c [canvas .c] pack $c -fill both -expand 1 update set width [winfo width $c] set height [winfo height $c] for {set i 0} {$i < $n} {incr i} { $c create line 0 $i $width $i -tags gradient -fill [lindex $steps $i] } } proc paint_canvas {c type c1 c2} { $c delete gradient set w [winfo width $c] set h [winfo height $c] if {[string equal $type "x"]} { set n $w set steps [rgbs $n $c1 $c2] for {set i 0} {$i < $n} {incr i} { $c create line $i 0 $i $h -tags gradient -fill [lindex $steps $i] } } else { set n $h set steps [rgbs $n $c1 $c2] for {set i 0} {$i < $n} {incr i} { $c create line 0 $i $w $i -tags gradient -fill [lindex $steps $i] } } return } proc paint_canvas_demo {} { canvas .c1 canvas .c2 bind .c1 [list transx::paint_canvas %W x red royalblue] bind .c2 [list transx::paint_canvas %W y yellow red] pack .c1 .c2 -fill both -expand 1 } }