1# clrpick.tcl --
2#
3# This demonstration script prompts the user to select a color.
4#
5# RCS: @(#) $Id$
6
7if {![info exists widgetDemo]} {
8    error "This script should be run from the \"widget\" demo."
9}
10
11package require Tk
12
13set w .clrpick
14catch {destroy $w}
15toplevel $w
16wm title $w "Color Selection Dialog"
17wm iconname $w "colors"
18positionWindow $w
19
20label $w.msg -font $font -wraplength 4i -justify left -text "Press the buttons below to choose the foreground and background colors for the widgets in this window."
21pack $w.msg -side top
22
23## See Code / Dismiss buttons
24set btns [addSeeDismiss $w.buttons $w]
25pack $btns -side bottom -fill x
26
27button $w.back -text "Set background color ..." \
28    -command \
29    "setColor $w $w.back background {-background -highlightbackground}"
30button $w.fore -text "Set foreground color ..." \
31    -command \
32    "setColor $w $w.back foreground -foreground"
33
34pack $w.back $w.fore -side top -anchor c -pady 2m
35
36proc setColor {w button name options} {
37    grab $w
38    set initialColor [$button cget -$name]
39    set color [tk_chooseColor -title "Choose a $name color" -parent $w \
40	-initialcolor $initialColor]
41    if {[string compare $color ""]} {
42	setColor_helper $w $options $color
43    }
44    grab release $w
45}
46
47proc setColor_helper {w options color} {
48    foreach option $options {
49	catch {
50	    $w config $option $color
51	}
52    }
53    foreach child [winfo children $w] {
54	setColor_helper $child $options $color
55    }
56}
57