Version 3 of Gradient Header Panel

Updated 2005-08-05 19:36:29

In many modern applications you'll find a gradient header panel bearing a title, some text and an icon on a gradient.

In Swing applications this widget became popular due to the excellent work of Karsten Lentzsch (http://www.jgoodies.com ).

Below you'll find soon a snit widget providing this widget in pure tcl. It is based on the gradient work of George Peter Staplin.

 #
 # Gradient Panel
 # 
 # a clone of Karsten Lentzsch GradientPanel in Tcl
 # using the canvas and the gradient code found in 
 # tclers wiki. It is implemented using Snit as pure tcl  
 # megawidget.
 #
 #
 # Links: 
 # Karsten Lentzsch www.jgoodies.com
 # Snit: http://www.wjduquette.com/snit/
 # Gradient: http://wiki.tcl.tk/6100
 #
 # Author: Carsten Zerbst [email protected]
 #
 package require snit
 package require Tk
 package require Img

 package provide gradientpanel 0.1

 snit::widgetadaptor gradientpanel {
    option -font 
    option -text 
    option -title 
    option -bg0 -default white 
    option -bg1 
    option -fg -default black
    option -icon 

    constructor { args } {
        # Create a canvas widget
        installhull [ canvas $self]

        $self configure -height 125
        $self configurelist $args

        # if nothing set, determine gradient color
        if {[string length [$self cget -bg1]] == 0} {
            # try to determine new end color
            frame $self.dummyframe 
            $self configure -bg1 [ $self.dummyframe cget -bg]
            destroy $self.dummyframe                                         
        }        
        # same for font
        if {[string length [$self cget -font]] == 0} {
            label $self.dummylabel
            $self configure -font [ $self.dummylabel cget -font]
            destroy $self.dummylabel
        }        

        $self _drawText
        $self _drawGradient
        bind $win <Configure> [list $self _drawGradient ]
    }

    # this delegates some methods to be able to manipulate 
    # the canvas context
    delegate method * to hull 
    delegate option * to hull

    # use to draw the text
    method _drawText { } {

        set font [$self cget -font ]
        $self delete text
        $self create text 30 30 -text [$self cget -title]  -anchor w \
            -font $font -fill [$self cget -fg] -tag [list text title] 
        set y 50

        set messagefont [lreplace $font 2 2 normal]
        foreach tok [split [$self cget -text] \n] {
            $self create text 40 $y -text $tok -anchor w \
                -font $messagefont -fill [$self cget -fg] \
                -tag [list text message]
            incr y 18
        }
    }

    # used to redraw the gradient and icon after resize
    method _drawGradient { } {

        $self delete gradient

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

        if {[catch {winfo rgb $self [ $self cget -bg0 ]} color1]} {
            puts stderr $color1
            return -code error "Invalid color [ $self cget -bg0 ]"
        }

        if {[catch {winfo rgb $self [ $self cget -bg1 ]} color2]} {
            return -code error "Invalid color [ $self cget -bg1 ]"
        }

        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]

            $win create line $i 0 $i $height -tags gradient -fill #${col} 

        }
        $self lower gradient

        # draw icon
        $self delete icon
        set icon [$self cget -icon] 
        if {[string length $icon ] > 0} {
            set distance 10    
            set xmin [expr [lindex [$win bbox text] 2] + $distance]                         
            set width [ winfo width $self]
            set x [expr $width - [image width $icon ]]                         
            if { $xmin  > $x } {
                set x $xmin
            }
            set y [ winfo height $self]

            $self create image $x $y -image $icon -anchor sw -tag icon

        }
    }
 }