Artifact c94026686ae0e941c5c6424afce109b6d6d9174f:

Attachment "SelectColorDemo.tcl" to ticket [75101bf5ce] added by anonymous 2013-06-22 14:02:59. (unpublished)

---

#! /usr/bin/env wish

# Demo script for BWidget SelectColor
#
# Demonstrates these revisions to v1.9.6:
# 1. Choice of base colors for palette
# 2. Choice of background color for dialog
# 3. Use of trace to show the effect of the new color in the
#    caller. The old color can be restored by clicking "Cancel".



# This is not a general selection of colors, but is good for flags ;-)

proc SetBasePalette {} {
    set idx 0
    foreach color {
        #000000 #ffffff #AE1C28	#ED2923 #D52B1E	#1291FF
        #FF0000 #0000ff #FFFFFF	#FFFFFF #FCD116	#000000 
        #FFCC00 #ff0000 #21468B #ED2923 #007934 #FFFFFF 
    } {
        SelectColor::setbasecolor $idx $color
        incr idx
    }
    return
}

# Command to call the color selector for window $win

proc chooseColor {win} {
    set oldColor [$win cget -bg]
    destroy .color

    set traceCmd [list AdjustColor $win]

    trace add variable ::LiveColor write $traceCmd

    set color [::SelectColor::menu .color [list center $win] \
            -variable   ::LiveColor    \
            -background #e0e0c0        \
            -color      $oldColor      \
            -title      "Choose color" \
    ]

    trace remove variable ::LiveColor write $traceCmd

    if {$color ne {}} {
        $win configure -bg $color
    }
    return
}

# Command bound to a trace on $varName, to adjust the color of $win

proc AdjustColor {win varName var2 op} {
    $win configure -bg [set $varName]
    return
}



package require BWidget

wm title . "Click to open color selection dialog"

destroy .a .b .c

frame .a -height 80 -width 400 -bg red
frame .b -height 80 -width 400 -bg white
frame .c -height 80 -width 400 -bg blue


pack .a .b .c

bind .a <1> {chooseColor .a}
bind .b <1> {chooseColor .b}
bind .c <1> {chooseColor .c}

SetBasePalette