Version 10 of Drawing Gradients on a Canvas

Updated 2004-07-07 10:07:27 by dkf

GPS: The code below draws the image above. It's reasonably quick, and seems to be bug free.

---

  proc + {n1 n2} {
    expr {$n1 + $n2}
  }
  proc - {n1 n2} {
    expr {$n1 - $n2}
  }
  proc * {n1 n2} {
    expr {$n1 * $n2}
  }
  proc / {n1 n2} {
    expr {$n1 / $n2}
  }
  proc toInt {n} {
    expr int($n)
  }

  proc drawGradient {win type col1Str col2Str} {
    $win delete gradient

    set width [winfo width $win]
    set height [winfo height $win]

    foreach {r1 g1 b1} [winfo rgb $win $col1Str] break
    foreach {r2 g2 b2} [winfo rgb $win $col2Str] break
    set rRange [- $r2.0 $r1]
    set gRange [- $g2.0 $g1]
    set bRange [- $b2.0 $b1]

    if {$type == "x"} {
      set rRatio [/ $rRange $width]
      set gRatio [/ $gRange $width]
      set bRatio [/ $bRange $width]

      for {set x 0} {$x < $width} {incr x} {
        set nR [toInt [+ $r1 [* $rRatio $x]]]
        set nG [toInt [+ $g1 [* $gRatio $x]]]
        set nB [toInt [+ $b1 [* $bRatio $x]]]

        set col [format {%4.4x} $nR]
        append col [format {%4.4x} $nG]
        append col [format {%4.4x} $nB]
        $win create line $x 0 $x $height -tags gradient -fill #${col}
      }
    } else {
      set rRatio [/ $rRange $height]
      set gRatio [/ $gRange $height]
      set bRatio [/ $bRange $height]

      for {set y 0} {$y < $height} {incr y} {
        set nR [toInt [+ $r1 [* $rRatio $y]]]
        set nG [toInt [+ $g1 [* $gRatio $y]]]
        set nB [toInt [+ $b1 [* $bRatio $y]]]

        set col [format {%4.4x} $nR]
        append col [format {%4.4x} $nG]
        append col [format {%4.4x} $nB]
        $win create line 0 $y $width $y -tags gradient -fill #${col}
      }
    }
    return $win
  }

  canvas .grad1
  bind .grad1 <Configure> [list drawGradient .grad1 x red royalblue]

  canvas .grad2
  bind .grad2 <Configure> [list drawGradient .grad2 y yellow red]

  pack .grad1 .grad2 -fill both -expand 1

---

Here's a slightly more portable version of that code with some error-checking thrown in for good measure. -- Damon Courtney

---

 proc DrawGradient {win axis col1Str col2Str} {
    if {[winfo class $win] != "Canvas"} {
        return -code error "$win must be a canvas widget"
    }

    $win delete gradient

    set width  [winfo width $win]
    set height [winfo height $win]
    switch -- $axis {
        "x" { set max $width; set x 1 }
        "y" { set max $height; set x 0 }
        default {
            return -code error "Invalid axis $axis: must be x or y"
        }
    }

    if {[catch {winfo rgb $win $col1Str} color1]} {
        return -code error "Invalid color $col1Str"
    }

    if {[catch {winfo rgb $win $col2Str} color2]} {
        return -code error "Invalid color $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 / $max]
    set gRatio [expr $gRange / $max]
    set bRatio [expr $bRange / $max]

    for {set i 0} {$i < $max} {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 {$x} {
            $win create line $i 0 $i $height -tags gradient -fill #${col}
        } else {
            $win create line 0 $i $width $i -tags gradient -fill #${col}
        }
    }
    bind $win <Configure> [list DrawGradient $win $axis $col1Str $col2Str]
    return $win
 }

 canvas .grad1
 DrawGradient .grad1 y darkblue royalblue

 canvas .grad2
 DrawGradient .grad2 x yellow red

 pack .grad1 .grad2 -fill both -expand 1

---

DKF: Both versions are cool!

Category Graphics