widget:colorDialog

GPS - Sun Mar 10, 2002: I decided that one of my interfaces needed an embedded color selection dialog that would invoke a certain command with the color as an argument. I came up with this little solution and thought someone might find it useful.


  #!/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 [L1 ].]