#!/bin/wish8.3
proc widget:colorDialog:getHexColor {win} {
upvar #0 _colorDialog$win ar
return [format "#%2.2X%2.2X%2.2X" $ar(red) $ar(green) $ar(blue)]
}
proc widget:colorDialog:updateColor {win args} {
upvar #0 _colorDialog$win ar
$ar(display) config -bg [widget:colorDialog:getHexColor $win]
}
proc widget:colorDialog:command {win} {
upvar #0 _colorDialog$win ar
eval $ar(command) [$ar(display) cget -bg]
}
proc widget:colorDialog:instanceCmd {self cmd args} {
switch -- $cmd {
command {
upvar #0 _colorDialog$self ar
set ar(command) [lindex $args 0]
}
default {
return
}
}
}
proc widget:colorDialog {win command} {
upvar #0 _colorDialog$win ar
set ar(red) 125
set ar(green) 125
set ar(blue) 125
set ar(command) $command
frame $win -bd 1 -relief raised -class ColorDialog
label $win.display
set ar(display) "$win.display"
label $win.labelRed -text "Red:"
scale $win.red -orient horizontal -from 0 -to 255 -variable _colorDialog${win}(red) \
-command "widget:colorDialog:updateColor $win"
label $win.labelGreen -text "Green:"
scale $win.green -orient horizontal -from 0 -to 255 -variable _colorDialog${win}(green) \
-command "widget:colorDialog:updateColor $win"
label $win.labelBlue -text "Blue:"
scale $win.blue -orient horizontal -from 0 -to 255 -variable _colorDialog${win}(blue) \
-command "widget:colorDialog:updateColor $win"
frame $win.spacer
button $win.ok -text OK -command "widget:colorDialog:command $win" -padx 1 -pady 0
grid $win.display -sticky we -column 1
grid $win.labelRed $win.red
grid $win.labelGreen $win.green
grid $win.labelBlue $win.blue
grid $win.spacer -pady 4
grid $win.ok -columnspan 2
rename $win _junk$win
proc $win {cmd args} "eval widget:colorDialog:instanceCmd $win \$cmd \$args"
return $win
}
#nice defaults
option add *ColorDialog.background #b0b0b0
option add *ColorDialog.activeBackground #b0a090
option add *ColorDialog*Label.background #b0b0b0
option add *ColorDialog*Scale.background #b0b0b0
pack [label .l -text TestColor]
pack [widget:colorDialog .cd ".l config -bg"]
pack [button .tf -text "Change Foreground" -command ".cd command {.l config -fg}"]
pack [button .tb -text "Change Background" -command ".cd command {.l config -bg}"][There's also an example in the M&M book [1].]
