Updated 2014-08-17 22:12:38 by HE

2006-03-13 HE An alternative to the old-fashioned Unix colorchooser. Developed for the use in eTcl, you can use it together with the Alternative dialogs for pocketPC/etcl. There I also describe how to replace tk_chooseColor.

With some changes you can use it in other enviroments than etcl (Remove windowfit is the first step)
 # colorBox.tcl (wiki version)
 # Version 0.2

 # inspired by the book 'Effektiv Tcl/Tk programmieren'. Used their code to begin the project.
 #        Mark Harrison, DSC Communications Corp.
 #        Michael McLennan, Bell Labs Innovations for Lucent Technologies
 # based on informationen from http://de.wikipedia.org/wiki/HSV-Farbraum

 # Names:
 # HE = Holger Ewert
 # EH = Eric Hassold
 # RS = Richard Suchenwirth

 # Histo:
 # Version 0.0 started at 22.02.2006
 # Version 0.1 started at 14.03.2006
 #      HE: removed array ::he::dialog::colors and procedure ::he::dialog::colorname2color 
 #              RS shows me a way to avoid them.
 # Version 0.2 started at 17.03.2006
 #      HE: Bugfix (found by EH): checkAndSetInitialcolor used fixed colorname. Fixed.
 #              Put all expr expression inside of {}

 # Function:
 # A color chooser (a replacement for tk_chooseColor)
 
 namespace eval ::he::dialog {
        variable colordialog

        array set colordialog "
                c00 #000019
                c01 #000033
                c02 #00004c
                c03 #000066
                c04 #00007f
                c05 #000099
                c06 #0000b2
                c07 #0000cc
                c08 #0000e5
                c09 #0000ff
                c10 #001900
                c11 #003300
                c12 #004c00
                c13 #006600
                c14 #007f00
                c15 #009900
                c16 #00b200
                c17 #00cc00
                c18 #00e500
                c19 #00ff00
                c20 #190000
                c21 #330000
                c22 #4c0000
                c23 #660000
                c24 #7f0000
                c25 #990000
                c26 #b20000
                c27 #cc0000
                c28 #e50000
                c29 #ff0000
                c30 #191919
                c31 #333333
                c32 #4c4c4c
                c33 #666666
                c34 #7f7f7f
                c35 #999999
                c36 #b2b2b2
                c37 #cccccc
                c38 #e5e5e5
                c39 #ffffff
        "

        package require msgcat
        namespace import ::msgcat::mc
 }

 # de.msg
 namespace eval ::he::dialog {
        msgcat::mcmset de "
                {Color} {Farbe}
                {Bad option %1\$s:} {Falscher Parameter: %1\$s:}
                {Must be -initialcolor, -parent, or -title .} {Erlaubt: -initialcolor, -parent, oder -title .}
                {Bad window path name %1\$s} {Fenster %1\$s existiert nicht.}
                {Ok} {OK}
                {Cancel} {Abbrechen}
                {Add color} {Farbe hinzufügen}
                {Red} {Rot}
                {Green} {Grün}
                {Blue} {Blau}
                {Hue} {Farbt.}
                {Sat.} {Sätt.}
                {Bright.} {Hell.}
        "
 }

 # en.msg
 namespace eval ::he::dialog {
        msgcat::mcmset en "
                {Color} {Color}
                {Bad option %1\$s:} {Bad option %1\$s:}
                {Must be -initialcolor, -parent, or -title.} {Must be -initialcolor, -parent, or -title.}
                {Bad window path name %1\$s} {Bad window path name %1\$s}
                {Ok} {Ok}
                {Cancel} {Cancel}
                {Add color} {Add color}
                {Red} {Red}
                {Green} {Green}
                {Blue} {Blue}
                {Hue} {Hue}
                {Sat.} {Sat.}
                {Bright.} {Bright.}

        "
 }

 proc ::he::dialog::windowFit {top} {
        if {$::tcl_platform(os) eq {Windows CE}} {
                if {[info exists ::etcl::etcl]} {
                        bind $top  <ConfigureRequest> {::etcl::autofit %W}
                        bind $top <Expose> {::etcl::autofit %W}
                        ::etcl::autofit $top
                } else {
                        wm geometry $top 240x[expr {320 - 51}]+0+0
                }
        } else {
                wm geometry $top 240x[expr {320 - 51}]+[expr {[winfo pointerx .] - 120}]+[expr {[winfo pointery .] - 135}]
        }
        return
 }

 proc ::he::dialog::colordialog {args} {
        variable colordialog

        set colordialog(-initialcolor) #408080
        set colordialog(-parent)       {.}
        set colordialog(-title)        [mc "Color"]
        # First we check the parameter
        foreach {para value} $args {
                switch -exact -- $para {
                        -initialcolor {
                                colordialog_checkAndSetInitialcolor $value
                        }
                        -parent {
                                if {![winfo exists $value]} {
                                        error [mc "Bad window path name %1\$s" $value]
                                }
                                set colordialog(-parent) $value
                        }
                        -title {
                                set colordialog(-title) $value
                        }
                        default {
                                error "[mc "Bad option %1\$s." $value] [mc "Must be -initialcolor, -parent, or -title ."]"
                        }
                }
        }
        scan $colordialog(-initialcolor) "#%2x%2x%2x" colordialog(red) colordialog(green) colordialog(blue)
        colordialog_set_hsb

        # create the windowname for the dialogbox
        if {$colordialog(-parent)  eq {.}} {
                set colordialog(w) ._colordialog
        } else {
                set colordialog(w) [set colordialog(-parent)]._colordialog
        }

        set w $colordialog(w)
        if {[winfo exists $w]} {
                colordialog_destroy
        }
        colordialog_create
        set colordialog(selected) {}
        vwait ::he::dialog::colordialog(selected)

        return $colordialog(selected) 
 }

 proc ::he::dialog::colordialog_create {} {
        variable dir
        variable colordialog

        set w $colordialog(w)

        toplevel $w -class colordialog
        wm protocol $w WM_DELETE_WINDOW ::he::dialog::colordialog_cancel
        wm minsize $w 216 65 ;#220
        wm maxsize $w 240 [expr {320 - 52}]
        wm title $w $colordialog(-title)

        frame $w.e   ;# frame with the entries
        frame $w.c   ;# frame with HSB-chooser
        frame $w.c.s ;# frame with the user defined colors
        frame $w.b   ;# frame with buttons

        # frame with HSB-chooser
        canvas $w.c.dial
        frame $w.c.sample -width 10 -height 101

        grid $w.c.dial   -row 0 -column 0
        grid $w.c.sample -row 0 -column 1
        grid $w.c.s      -row 1 -column 0 -columnspan 2
        grid rowconfigure $w.c 0 -weight 0
        grid rowconfigure $w.c 1 -weight 1
        grid columnconfigure $w.c 0 -weight 1
        grid columnconfigure $w.c 1 -weight 0

        # frame with the entries
        label $w.e.lr -text "[mc "Red"]:"
        label $w.e.lg -text "[mc "Green"]:"
        label $w.e.lb -text "[mc "Blue"]:"
        label $w.e.lh -text "[mc "Hue"]:"
        label $w.e.ls -text "[mc "Sat."]:"
        label $w.e.lv -text "[mc "Bright."]:"
        entry $w.e.er -width 5 -validate all -vcmd {::he::dialog::colordialog_vcmdRGB %P %V red}
        entry $w.e.eg -width 5 -validate all -vcmd {::he::dialog::colordialog_vcmdRGB %P %V green}
        entry $w.e.eb -width 5 -validate all -vcmd {::he::dialog::colordialog_vcmdRGB %P %V blue}
        entry $w.e.eh -width 5 -validate all -vcmd {::he::dialog::colordialog_vcmdH %P %V}
        entry $w.e.es -width 5 -validate all -vcmd {::he::dialog::colordialog_vcmdS %P %V}
        entry $w.e.ev -width 5 -validate all -vcmd {::he::dialog::colordialog_vcmdB %P %V}
                .e.ev -width 5 -validate all -vcmd {::he::dialog::colordialog_vcmdB %P %V}
        grid configure $w.e.lr -column 0 -row 0
        grid configure $w.e.lg -column 2 -row 0
        grid configure $w.e.lb -column 4 -row 0
        grid configure $w.e.lh -column 0 -row 1
        grid configure $w.e.ls -column 2 -row 1
        grid configure $w.e.lv -column 4 -row 1
        grid configure $w.e.er -column 1 -row 0
        grid configure $w.e.eg -column 3 -row 0
        grid configure $w.e.eb -column 5 -row 0
        grid configure $w.e.eh -column 1 -row 1
        grid configure $w.e.es -column 3 -row 1
        grid configure $w.e.ev -column 5 -row 1

        $w.c.dial create image   5   5 -anchor nw -image $colordialog(img_hs) -tags hsmap
        $w.c.dial create image 190   5 -anchor nw -image $colordialog(img_v)  -tags bmap
        $w.c.dial create oval    0   0   5 5 -fill black -tags hsval -width 3 -fill {}
        $w.c.dial create line  189   5 201 5 -fill black -tags bval  -width 3
        $w.c.dial configure -width 201 -height 107

        $w.c.dial bind hsmap <1>         "::he::dialog::colordialog_set_hs %x %y"
        $w.c.dial bind hsmap <B1-Motion> "::he::dialog::colordialog_set_hs %x %y"
        $w.c.dial bind bmap  <1>         "::he::dialog::colordialog_set_b  %y"
        $w.c.dial bind bmap  <B1-Motion> "::he::dialog::colordialog_set_b  %y"

        # frame with the user defined colors
        for {set n 0} {$n <= 3} {incr n} {
                for {set m 0} {$m <= 9} {incr m} {
                        radiobutton $w.c.s.c$n$m \
                                -indicatoron 0 \
                                -bg $colordialog(c$n$m) \
                                -selectcolor $colordialog(c$n$m) \
                                -value c$n$m \
                                -variable ::he::dialog::colordialog(c) \
                                -width 2 \
                                -command "::he::dialog::colordialog_sel $w.c.s.c$n$m"
                        grid configure $w.c.s.c$n$m -row $n -column $m
                }
        }
        }
        # frame with buttons

        button $w.b.ok     -text [mc "Ok"]        -command ::he::dialog::colordialog_ok
        button $w.b.cancel -text [mc "Cancel"]    -command ::he::dialog::colordialog_cancel
        button $w.b.add    -text [mc "Add color"] -command ::he::dialog::colordialog_add

        pack $w.b.ok $w.b.cancel -side left
        pack $w.b.add -side right

        # Frames darstellen
        grid configure $w.e -row 0 -sticky nsew
        grid configure $w.c -row 1 -sticky ew
        grid configure $w.b -row 2 -sticky nsew

        grid rowconfigure $w {0 2} -weight 0
        grid rowconfigure $w 1 -weight 1

        colordialog_refresh
        windowFit $w
        grab set $w
        return
 }

  proc ::he::dialog::colordialog_checkAndSetInitialcolor {value} {
   variable colordialog

   foreach {r g b} [winfo rgb . $value] break
   set colordialog(-initialcolor) [format "#%02x%02x%02x" [expr {$r/256}] [expr {$g/256}] [expr {$b/256}]]
 
   return
 }

 proc ::he::dialog::colordialog_refresh {} {
        variable colordialog

        set w $colordialog(w)
        set h $colordialog(hue)
        set s $colordialog(saturation)

        if {$h eq {}} {
                set h 180
        }

        set x0 [expr {($h / 2) + 5}]
        set y0 [expr {(100 - $s) + 5}]

        $w.c.dial coords hsval [expr {$x0-4}] [expr {$y0-4}] [expr {$x0+4}] [expr {$y0+4}]

        set b $colordialog(brightness)
        set y1 [expr {(100 - $b) + 5}]

        $w.c.dial coords bval 189 $y1 201 $y1
        $w.c.sample configure -background [colordialog_hsb2rgb1 $colordialog(hue) $colordialog(saturation) $colordialog(brightness)]

        foreach {win index} [list $w.e.er red $w.e.eg green $w.e.eb blue $w.e.eh hue $w.e.es saturation $w.e.ev brightness] {
                $win configure -validate none
                $win delete 0 end
                $win insert end $colordialog($index)
                $win configure -validate all
        }

        return
 }

 proc ::he::dialog::colordialog_vcmdRGB {value type name2} {
        variable colordialog
        set state 0
        switch -exact -- $type {
                key {
                        if {($value >= 0 && $value <= 255) || ($value eq {})} {
                                set state 1
                        }
                }
                focusout {
                        if {($value >= 0 && $value <= 255)} {
                                set colordialog($name2) $value
                                set state 1
                        }
                        if {$value ne {}} {
                                puts "A2 $value $type $name2";update
                                colordialog_set_hsb
                        }
                        colordialog_refresh
                }
        }
        return $state
 }

 proc ::he::dialog::colordialog_vcmdH {value type} {
        variable colordialog
        set state 0
        switch -exact -- $type {
                key {
                        if {($value >= 0 && $value <= 359) || ($value eq {})} {
                                set state 1
                        }
                }
                focusout {
                        if {$value >= 0 && $value <= 359} {
                                set colordialog(hue) $value
                                set state 1
                                colordialog_set_rgb
                        } elseif {$value eq {}} {
                                set colordialog(hue) $value
                                set colordialog(saturation) 0
                                set state 1
                                colordialog_set_rgb
                        }
                        colordialog_refresh
                }
        }
        return $state
 }

 proc ::he::dialog::colordialog_vcmdS {value type} {
        variable colordialog
        set state 0
        switch -exact -- $type {
                key {
                        if {($value >= 0 && $value <= 100) || ($value eq {})} {
                                set state 1
                        }
                }
                focusout {
                        if {($value >= 0 && $value <= 100)} {
                                set colordialog(saturation) $value
                                set state 1
                        }
                        if {$value ne {}} {
                                if {$colordialog(hue) eq {}} {
                                        set colordialog(hue) 0
                                }
                                colordialog_set_rgb
                        }
                        colordialog_refresh
                }
        }
        return $state
 }

 proc ::he::dialog::colordialog_vcmdB {value type} {
        variable colordialog
        set state 0
        switch -exact -- $type {
                key {
                        if {($value >= 0 && $value <= 100) || ($value eq {})} {
                                set state 1
                        }
                }
                focusout {
                        if {($value >= 0 && $value <= 100)} {
                                set colordialog(hue) $value
                                set state 1
                        }
                        if {$value ne {}} {
                                colordialog_set_rgb
                        }
                        colordialog_refresh
                }
        }
        return $state
 }

 proc ::he::dialog::colordialog_destroy {} {
        variable colordialog

        grab release $colordialog(w)
        destroy $colordialog(w)
        return
 }

 # command of ok button
 proc ::he::dialog::colordialog_ok {} {
        variable colordialog
        set colordialog(selected) [format "#%02x%02x%02x" $colordialog(red) $colordialog(green) $colordialog(blue)]
        colordialog_destroy
        return
 }

 # command of cancel button
 proc ::he::dialog::colordialog_cancel {} {
        variable colordialog
        set colordialog(selected) {}
        colordialog_destroy
        return
 }

 # add user defined color
 proc ::he::dialog::colordialog_add {} {
        variable colordialog
        if {$colordialog(c) eq {}} {
                tk_messageBox -icon error -type ok -message "No color button selcted!"
                return
        }
        set w $colordialog(w)
        set color [$w.c.sample cget -background]
        set colordialog($colordialog(c)) $color
        $w.c.s.$colordialog(c) configure -bg $color -selectcolor $color
        return
 }

 # choose user defined color
 proc ::he::dialog::colordialog_sel {win} {
        variable colordialog
        set color [$win cget -background]
        scan $color "#%2x%2x%2x"  colordialog(red) colordialog(green) colordialog(blue)

        colordialog_set_hsb
        colordialog_refresh
        return
 }

 # calculate Brightness from y-coordinate
 proc ::he::dialog::colordialog_set_b {y} {
        variable colordialog

        if {$y < 5} {
                set y 5
        } elseif {$y > 105} {
                set y 105
        }
        set colordialog(brightness) [expr {100 - ($y - 5)}]

        colordialog_set_rgb
        colordialog_refresh
        return
 }

 # calculate hue and saturation from x- and y-coordinate
 proc ::he::dialog::colordialog_set_hs {x y} {
        variable colordialog

        if {$y < 5} {
                set y 5
        } elseif {$y > 105} {
                set y 105
        }
        if {$x < 5} {
                set x 5
        } elseif {$x > 184} {
                set x 184
        }
        set colordialog(hue)        [expr {($x - 5) * 2}]
        set colordialog(saturation) [expr {100 - ($y - 5)}]

        colordialog_set_rgb
        colordialog_refresh
        return
 }

 proc ::he::dialog::colordialog_set_rgb {} {
        variable colordialog
        set rgb [colordialog_hsb2rgb $colordialog(hue) $colordialog(saturation) $colordialog(brightness)]
        set colordialog(red)   [lindex $rgb 0]
        set colordialog(green) [lindex $rgb 1]
        set colordialog(blue)  [lindex $rgb 2]
        return
 }

 proc ::he::dialog::colordialog_set_hsb {} {
        variable colordialog
        set hsb [colordialog_rgb2hsb  $colordialog(red) $colordialog(green) $colordialog(blue)]
        set colordialog(hue)        [lindex $hsb 0]
        set colordialog(saturation) [lindex $hsb 1]
        set colordialog(brightness) [lindex $hsb 2]
        return
 }

 proc ::he::dialog::colordialog_hsb2rgb {h s v} {
        set s [expr {$s / 100.0}]
        set v [expr {$v / 100.0}]

        if {$s == 0} {
                set v [expr {round(255*$v)}]
                set r $v
                set g $v
                set b $v
        } else {
                set hi [expr {fmod(floor($h / 60.0), 6)}]
                set f  [expr {$h / 60.0 - $hi}]

                set p [expr {round(255 * $v * (1.0 - $s))}]
                set q [expr {round(255 * $v * (1.0 - $s * $f))}]
                set t [expr {round(255 * $v * (1.0 - $s * (1.0 - $f)))}]
                set v [expr {round(255 * $v)}]
                switch [expr {int($hi)}] {
                        0 {set r $v; set g $t; set b $p}
                        1 {set r $q; set g $v; set b $p}
                        2 {set r $p; set g $v; set b $t}
                        3 {set r $p; set g $q; set b $v}
                        4 {set r $t; set g $p; set b $v}
                        5 {set r $v; set g $p; set b $q}
                }
        }
        return [list $r $g $b]
 }

 proc ::he::dialog::colordialog_hsb2rgb1 {h s v} {
        variable colordialog
        set rgb [colordialog_hsb2rgb $h $s $v]
        return [format "#%02x%02x%02x" [lindex $rgb 0] [lindex $rgb 1] [lindex $rgb 2]]
 }

 proc ::he::dialog::colordialog_rgb2hsb {r g b} {
        variable colordialog
        if {$r == 0 && $g == 0 && $b == 0} {
                set h 0
                set s 0
                set v 0
        } else {
                set r [expr {$r / 255.0}]
                set g [expr {$g / 255.0}]
                set b [expr {$b / 255.0}]

                set l [list $r $g $b]
                set max [lindex [lsort -real $l] end]
                set min [lindex [lsort -real $l] 0]
                set maxColor [lindex [lindex [lsort -index 0 -real [list [list $r r] [list $g g] [list $b b]]] end] 1]

                set maxColor [lindex [lindex [lsort -index 0 -real [list [list $r r] [list $g g] [list $b b]]] end] 1]
                set s [expr {int(($max - $min) / $max * 100)}]
                set v [expr {int($max * 100)}]

                if {$s == 0} {
                        set h {}
                } else {
                        switch -exact -- $maxColor {
                                r {
                                        set h [expr {int((0.0 + ($g - $b) / ($max - $min)) * 60)}]
                                }
                                g {
                                        set h [expr {int((2.0 + ($b - $r) / ($max - $min)) * 60)}]
                                }
                                b {
                                        set h [expr {int((4.0 + ($r - $g) / ($max - $min)) * 60)}]
                                }
                        }
                        if {$h < 0} {
                                set h [expr {$h + 360}]
                        }
                }
        }
        return [list $h $s $v]
 }

 set ::he::dialog::colordialog(img_hs) [image create photo -data {
        R0lGODlhtQBlAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgICAgMDAwP8AAAD/
        AP//AAAA//8A/wD//////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAMwAAZgAAmQAAzAAA/wAzAAAzMwAzZgAzmQAzzAAz/wBmAABmMwBmZgBm
        mQBmzABm/wCZAACZMwCZZgCZmQCZzACZ/wDMAADMMwDMZgDMmQDMzADM/wD/
        AAD/MwD/ZgD/mQD/zAD//zMAADMAMzMAZjMAmTMAzDMA/zMzADMzMzMzZjMz
        mTMzzDMz/zNmADNmMzNmZjNmmTNmzDNm/zOZADOZMzOZZjOZmTOZzDOZ/zPM
        ADPMMzPMZjPMmTPMzDPM/zP/ADP/MzP/ZjP/mTP/zDP//2YAAGYAM2YAZmYA
        mWYAzGYA/2YzAGYzM2YzZmYzmWYzzGYz/2ZmAGZmM2ZmZmZmmWZmzGZm/2aZ
        AGaZM2aZZmaZmWaZzGaZ/2bMAGbMM2bMZmbMmWbMzGbM/2b/AGb/M2b/Zmb/
        mWb/zGb//5kAAJkAM5kAZpkAmZkAzJkA/5kzAJkzM5kzZpkzmZkzzJkz/5lm
        AJlmM5lmZplmmZlmzJlm/5mZAJmZM5mZZpmZmZmZzJmZ/5nMAJnMM5nMZpnM
        mZnMzJnM/5n/AJn/M5n/Zpn/mZn/zJn//8wAAMwAM8wAZswAmcwAzMwA/8wz
        AMwzM8wzZswzmcwzzMwz/8xmAMxmM8xmZsxmmcxmzMxm/8yZAMyZM8yZZsyZ
        mcyZzMyZ/8zMAMzMM8zMZszMmczMzMzM/8z/AMz/M8z/Zsz/mcz/zMz///8A
        AP8AM/8AZv8Amf8AzP8A//8zAP8zM/8zZv8zmf8zzP8z//9mAP9mM/9mZv9m
        mf9mzP9m//+ZAP+ZM/+ZZv+Zmf+ZzP+Z///MAP/MM//MZv/Mmf/MzP/M////
        AP//M///Zv//mf//zP///yH5BAEAABAALAAAAAC1AGUAAAj/ALlxEzdQnEF0
        4tApROeOobuH9NzRm0hPX0V9GPVZ02itoyxrskLKcjTSkUk1jtSoVGOEpREj
        R2AemYnkCJKbSJLkTMJTSRIlQJUsEbqk6JIiR4so/VHkh9MfOaDmmDojx4yr
        M1pkbdEiStcoYOtEqUO2TiazmdL2ytSrba9wb8PJDQeOLri738B92/vNW19v
        gLt560a4GzfDAgUSNHgw4cKGDyFKpGgx48aOHkGKJGnyZMqVLV+KjjmTpk2c
        Onn2/Bl0qFGkSpc2fRp1KlWrWLVy3e0VbNixZc+mVcvWLdy5de/i1cvXL+DA
        gwsfTixwHOPG6R47fCdx8sR9Fy3v/8MMEuSskJxNPkK5kuWa0TLZ2Dx9s83O
        1W5aE31TFLbSNEw9BdUYtlllVRdX6cbVFb79tkdwaH3CVnFtnRMXcucop5de
        5ezlHGDkCFaYYeNQN1BBjS3EkEOSUVRReJdh9pFII5XkWXuhiQaTTKbhlNN9
        P7EGlGv9JSWbgLXZVhVWWW3F21e/lWUWWsS59daFySmXF199/QXdiNNVx02J
        1qUjTnbZvYOOmtxxVw89b74J3j760DnendZcI4ue5/XpyCyOrCeoGmsQasR7
        axyRaKJsINGofZAm0UYS+eX3hhKX8qdpEW8UkYanPwA4xg+jEkggggheMYOq
        V7TQ6qtR7P8Rax0PflKHrRJKOEwvu+5q4TnhAJvhsOCY842xHSbrTTnehOhs
        N+NAO+aJ16W4ImSRReRiZRjFmBmN6HXG3mcqwVdaaTXdlJpqqwUlFFFHGdnU
        bE4leduSuWXVW4NjAScclRNaeZxcWS7HpYfPiRgdYYmRKU6ZZ56JTprutOlO
        PRfDSc+cddZpzXjX5LmnLH4C+kiggaqxXqGIHqroEfLF7CgSk07qBqWUKmEp
        pkts2umnAAZNag6n5tCF0TOkuqqrrkbBoKxQ03prJrlmMozVvPbya7DBgpOh
        OcUe+42yzJLTbLPdhBgtmdQWZKaKCqkZWXdvTsTteBx5pOdmIwH/Kq5K77HE
        Ukzv9TizujtN6pO7l7521KfzPkWgVLYhmC/TvX0lq5Rk2TrchLu2NXCGduFl
        bHN9MZswYSUaRuLDsJuJ5pprVnxxxnJuvHHHdn4ssp58kvwnyoOu7DKjMMM8
        c6Q157xzpj1H3+nPoZJqvalGI600rAw+PWutU+uKta9aa821sF6HbSyyYy97
        9rNqT+swxLOzabubuOveO8i/j1wy8SojlKFatqjkNepRNJOUAm9WKUzxbHqe
        ApXQSkW07KFqVUt7VdO89yDwVU18vSof+r6mPrGR7X1pg5a02GYd+k2MdhbD
        mAw1xrH95emGwCOZ8EyWspUJEFEvkxkC/5vHQOc5UFM941QEgVY9ChbtgqzK
        oNNi9b1bhc9qWAzh1kZYrC6ub2ztKxva1KbC+cVOYvWrnQzzV0PfhSyH/+Ph
        oFg2wOMZcHk0S2ARGwg9CDJRVEPD3tGgmMENTjFqHbQiCMcnwq6R8IsnFOOz
        1rbCcZRpHLJLR5rS0aZ3yLAecqrHnPZhJ1J+7BpvnAWfZgGoWTziZK8U1BpY
        NkuYrSFmbHgUG2rWBga6wVJuyNQbNDVMTqUhaGMQ1RhM1YVBNjNpV2BVNGN1
        BajtoVZ7yNUnrjaMbmptGL86h7DE6TVzgM0c5UBWOZhVDnKYzZ3OsuQKzyi7
        F9ovhmzcHZ7eOP+y4LWSeCmjIxCRd0A8EhFnfHygEv/YxEBaMGkYZJUhoVZF
        XFHtotzM2hbTd06xsY+d70MbJeeHyTNpck2cXNM73OTJi4FyY6Kskyn3gco8
        oXJPrCTZI1r5SpWtYWW1nCUudQmpNtisl5T6JaaC2bNivuGYnjpmqJZJqi4w
        E1VXSNU0o2lNbOLqE7raptW8eQ5wBouc5zBnscx5rHWOjRzsdGfaxqE2S44J
        di5MU+3wFyca6tONONTh/2AZQB8ONIjKG+ICEaqzIybxZxK8nkMHCdHtGZKD
        UrMoCLNGPi6eM2zJCiMKJ1lJS6YDk5rkJCdX6snWghKU+xClKElJW5r/0hSV
        11AlK1m5097G8qezDK5Qb5nLXe7SqMh1Qy9/GczmDvO5w0zDU4+ZhmRadwxW
        zW4zu5DVaHqXq9W8ZjazCdZtmreb3SyresXJ3rSm1ZzoROc620lfeJKDrpbM
        bwtLmtqJpZS1F2spbGFqp2uA7Ka5XSVPTdbTR/yUUEG9Jcxy6ahd0syolOql
        zoK5VE1JN6pASyaplkk0qxrtmdyVZveqGatr0iqbtwKr1cSa3m8KyxxfY2t8
        x7bOZcG1WXK9b11Ni0nUavIdqmWta18L29qS0sC4xa1ud8tbV/7WwQ4eLhuI
        m8s2GBe5vVwuc50LXelSl7rXXeYytbtd7qa4/5pwFu94P0FesA5jm+hNb3vF
        iWP4wjed850vXO2L3/uSib+Y9C+bOFkxAb90wLQ95YGBl1NXMhiWDw7uoWq5
        5QNaGLmSQipzNyzM6UGVulMtFYm3a7SsriqarmLxHqr5Ylxlk2o09maN2VvO
        HK/PrfQF8jvpCi27Ejm1qUWykuuxZNjK1slPvi0qdZvb3fbWyq8ErpaL6+Vu
        JzfMY34DmaH71Oke07rVVTOb3dxd8Mr5mnQu73nxnF5wgnPP7vUzoOW7zkG3
        E5741e9pB57sJLOW2UyOrcKjHeVpV7vKvs02loV7y4oX98vHVa7GmSvujkfX
        3GhO95qxi93tdvfN7v8OL7znXN4751m99863n+MbaH8TWsj6LbIm1VHwlcLj
        4J6shz1eu3B+MByV2HD4bmkB8VdCQuLBhYTFixuJ44JZEmJm7iTI/dRJnPnc
        jVCzug/R5mZeIRDenfU1AyHeeH+iFC3HczLQu9528Pm95mCHOQG9znX0+9/k
        UIc7A55fgiNb2UpuNtFna9uGJ5jKTY/lxIXb6Yt/GczgHvO4zQzyNKu75G1u
        d9pV3vY6xz3P9WZvn2fO95oDHuCGHoc6ZC/7dPAcHunA/c9/bo939H7oQ+dH
        PYRv9OLvgx/XQH7Slz8LbMyC6dB/BC0e8fTqr0Hq2GcDJNhQ9e63IRJtwLr/
        +N0gCTdMwvzmf8PW158GrzciDe8Pe9gPMQb6k53sgehC/tHO/7Pvge2lsAcB
        CHdwlwyfYIBzN3ftMAwLaHcOeA7tYA4RqHcUWA7sUA5+l4HksA6B14GzN3sD
        Z2RJtlorhXBB52wL13gNN2VUFnFXFlydxmUYB2Yal3UdF0wf93XVJXKfV3bs
        lnJyFm+m53L0Zm/rJXP6xm+C9nqDF3sfaHtQqHvvsHu+53tCd4XEd3xaiHxc
        eA3M53zOF33TN33Wh33Xp31o6H3gB37jV37ld37rp37q1350GH9jIH/1V39d
        cH/6p39n94dsF4gCKIBvV4gIOAwJyIAMCIGMGIGO/5h3eWeBkqiBHMiBgveB
        tHdaIIhsuUeCrNV7TAZKwkdbUIZ8UpZbzmdtrjR9Lyh127Z9XXZc4GdUG1d+
        v+RxXldu1BV2O6hmZEdy24V27DZraPdugyhvYGWAqKeIqpdWEfhn6HSBS7iB
        N0d7T8hzt5d7U7iNv2eFwTd8w7eFx5d8XliOYPh86DiG1LeOZrh97sh93Pd9
        8tiG5Id+cCiH7Od+8Ad/d5iH9reHfbh/gPh/BDmAhViAB3iAiKiIDdiIECiB
        kFiBF5iBGEiNlxh41lh72NiJVMh73oiF4Fh85Lh85th86fh80seO1Hd9LPmO
        26eG8xh+9fiG9jiHXqePdv84f/4IkPvnh/0niABIiASYkImogAz5kBMYkZE4
        kRhYkZbogRm5kbqnjR75e1f4jcYnkl34hSYZhiipjmV4hi8Jj2sYfmbphvV4
        j3F4k3W4j3iok3yIfwHpf0FpkAh5iInYkA/4iEl5gX45iU5pkRiJiVLJkVRZ
        hVYJfCE5jlvphV2ZjilJhuzYkmKZhmQZk/RIk/nYlm+5k3zYkz9Jl4M4gEJJ
        lAqZl4vIlxEpiUxZiYJ5idaoDrenDroHD7sHD79nD8Cnm8NnD8XHD7/Jhdiw
        fMPZfLQQhrQwhpCgnNUHCS8JCd0XCWsYCeJHneQnCW8oCXA4CevHne3XCPEH
        nnf/eAjzdwj3FwjnuX+BAICBMIClQIClgIDJkIDzyYDJ4IDtgJ+OyA4UyJ8W
        uA4TuQ6VqA4DCpvXaJgdiZhXGZLhqJXm6JjnKIYpGZbZN5YwyYYyiZZqaZOc
        yY94+I+f6ZMDWZeleZcLaZR6iZRK+ZetSY1PSZiyKZu5R5u0aZu+h5u4yZv8
        4Ju+CZzHB5zYwA9BmnzDOZzHaZzJmaTS55xM6o5MGgnQyX3SSZ3UGX7YqZ3a
        aX7cuaU32QiT4KXgCX/kOab2Z57ouZ76t55qyp6l0J7veYDxGZ/12Q73eZ/5
        CYH5yQ7toKcSyJ/8CaD/KaCCuoExGqMaGYUcyY2I+ZFY/8mYIwmhJgl9Xzmh
        k+mSZBmPGCp+GZqW6ceWONmPcKmHISqQQDmapYmARHmiR6maEgmYlPiagxmj
        8ECjtmmb9oCjupmrubqjvAqcviqkQlqkRooNx1msSZqcy9mkTwqd0DmlkkCl
        VxqtWMql1Aqm4HmtY9oIZGqmh3Cma7qebRqu7xmnySCn83mudUqn+bmuebqn
        fvqn7ACg8iqoAkqghSqjsql7tJl7NnqrubmbxOejwEqkxAmGR6qktLCc1Oec
        C+uk3RelU/p9VXql1wmH2ql+3vml4Sl/5Fl/5rmH6Jmm6hmI7SmAJTuucCqf
        9NmAd7qn+9mffgmog7oOBBp4sv9ps4U6q7W6s7iao7rJqz36q8AapEQrrMRK
        rMeasEqrrFDatFP6tM8atVc6CdNKrV96tdZ6rdqqrebZtWfard26puI6ruNa
        rmZ7rupqp+zqsnratu8ar/FKrzQ7t4Uqe/i6r7U6hbh5o7sJsMMHnESqfMV5
        tEj6fMm5pGTonNfnnNoHsdIpsdUpfthpflm6pd/pfmG6tR5bpueJf+t5duv5
        fyf7pu+JgPGJiPU5nyy7nxPon3AbqBgooIRqibJptzpbozvrrz67qzwqtL9K
        tMEqrMWKtMearAnrnE3brFALrdJKtc5rtdwJphqrtdnatV4Ltmoarm5KtmZr
        rmibrmv/u65t667vKq9xS6/2SrP3Sqs8q7v+qqu967vAK7xHm7RJarzKirzK
        66zQSp3Nq51WK73Uu7XWa71f+63gur1lS67eq7pqy67jW75wK7eCmr73Gg/s
        a5vx0LO6eQ+8u6P94Lv80A/zO5zZMKzFWgvFm7C1sKxQWgtPS6W24L/RegtV
        y523EL1YewtaC56HEAvbap6rwK1qugrtqcCrwMDz+QzfS6fzEL7tMA8RzJ/y
        AK/yGg/oS7MYnLO0iru1+r7w27tBW8JGW7/Eu7THy7TM6rTLK63TesMC3MM+
        TMDX663fqr1ju8Doiq5pK75s+7ZWfL50q74xisGGDA8bnMjw/3APi7zI9uDB
        /WAPkTzJI1zJIUzCmIwNJ7zJmkwL2UALKhzKoAwJLVzKpBwJMJzKkTDDrCwJ
        tuDKkmDDsjwJOVzLtNwIPJzLjRALu7zLP3wIQxzMgWDExDzMw1wKSZzMpfAM
        y7zMycDE85AM0TzNUVzNTyzF2MwOVbzN2rwO8rAOWBzO4KwOhtzFOtu+HAy/
        vSq0ZGzGxrrCyaq/yRvD/Su10fq81Yq12ErAXGvA2JvAeEy2StzA4Lu2UxzI
        85rF9iqb5azIG8zIEP3IEg3JkizJljzC2JDJJMzJn9zRngzKIG3KIn3KMMzK
        qwzLr/zKshzLtNzStYzLMM3LMv3LQP8MxMEMzMZczMqcxMzc08/809AszdJs
        zVHMDtksxdz8zUrtzeDc1A0tqzW6wbnbyGEcyUALnCQ8tCZMvx9tvy28tM7Z
        wvQMw9Ipta98z7EMwDssx75Mx8Dsz8YM0Mgs0OXKzHss1H1c1H+szRLM1BSM
        wXR7yIoM0Y3swYZd0ZR8yRet0RmtyY7t0R4tyiOtyiad0iid1rNsy5oN07os
        075c07980zo91zzdzD7NxEFNzddM1Edt1Hy9zUy91OL81IKNyIXtyId92Ilt
        yY290Y/dyZEd0qMs0qhc3JR90pat0pjt0rfc2b0806At2jk93Ttt2s6M2kAt
        1Kt9za6N1K//3c2y7dTj3NC2PdiFPdESPckWrdjs3dgcDdwfLdkhTdLGvcr2
        ndywvNKa7dKc/dz+Hd1vLczETNpz3dPXnd3TPNTbbc2undTgzdSz7dTkPOEO
        fdsRrduIvd69/dub/NGfLN+TTcr0XdL3jdz5jdksrcs87NnQHdoBjtM6ndME
        buCn/dMJrtrd/d2wHd6zTeHkHA+JDOSLHA8QfQ+GbeSSfA+T3A+XzOQjzOQZ
        nQ2YnA2bTOWeXAsdXQuhrOWkrOWo7OW2UAusbAspTeaxbAuyfAu1rOa0rOa4
        HAu5HAsyLec/vAo1vQrBjOfAjOfIzOfPsAo9/QyoLejS/AzTPA/X/4zoUYzo
        Ri0P2CwP2wzp3hwPSg3k4AzkPl7hhH3h6Z3h7I3RmfzekC3coSzipVzflW3i
        lq3fzK3i//3ZLi7do63MNH7gqa3drJ3jDr7U3xzh5A3kD03kQ17kRz7JSi7J
        Ts7klyzlUV7lzn7lWb7lqQzmYr7K1U7mZa7SaB7LbK7max7nKy7nu0znsWDn
        dZ7nyezngL7M6y7ogz7Nhi7Nio7o1+zojR7p+D7plR7OmF7h5r3p6K3eib3h
        vt3ho/7hpD7iqF7i+K3fKd7fLA7roG3TLz7g1V3aNI7g2q3gOe7dOx7bEC7e
        hgzs90DkJl/yRp7yKd8PSq7kyv7yyi7lMv/fD1Re8zafDVie8ziv5Twv5j4f
        5kCP7UJ/C2iO5t5+9N4O50p/C3Le9E5f7lBv53g+9Xj+51YP6IDu7lo/D4Zu
        6PT+9fTu6GI/D5Be9mYvD5Se9mgP7EIO7Igs7Ci/yEhu5Ma+5E0+5RtN5Zps
        5Tif5R+u5aDs5Tz/5ax87WZO5rK87d7e5uA+7nN+55C/5+je5+ne0+1O6IIO
        74ee6I+O1JCuzZKO9pXe65bO9myP8kSu8ivf8izf+jAP8zMv8zev8znf87b/
        82Iu9NhO9Lxf9Ej/+0uv9E8v9VFP9caP9Vav9e7O9czf9WD//GMv9mev9mlv
        +j8e5BAN93O//XX/j+x4H+V5/+x9H/jS3uXTXvhjnu2urPiK7+ZM3/hN7/h1
        btN6PvXDzOdVz+6BPujvXuib3+gAMY/dPHkC5R1kd1DeOnnxFsaDuA5iPHUT
        4927ePHeRo4c+937GLLfSJIls/U7mRIlymwtW9bKBlNmLZo1bdW6aUvnTp23
        bPkE+vPWUKJFh8a6hVRpLKZNY616GnXVVKqrnlm1+kzr1q3znnkFO0/sWLIF
        zRJEq1ChQ7YNLVrEGFdjx44hQYIsOVJlSpd9X8aMWVOwTZyFeR7+mRio0aSN
        myZ12hTq5KqVsV7FzFUz2K9fyYo9a1bt6LZv4WbEl7EjPo93/d0t6S8v/0p/
        e1tq8xtTm8zAtXbnLKwNsa1tihNvY3wLueOk2yIzrcZ08tNqVDGvqp5Za7Wu
        nfN1JpvvM8F8oQ/iG90wdUO3plWrplsXNt6Ve1nm5p1/8GDgOYf3NI4opZh7
        TjqppLKsquu000wrzsJKK8L0DiqNvbdSwzAeDO9hrcN7XgPxww/7ka1EEk8s
        MZvaVswGNxdbbNE3GXejcUZbhMOROB2L41E5H5ED8sdYnCMyluiONNJI7Jas
        rkkmn+Euyme+o3LKKecRL0sst8xSnvK+lAc9McMMU0MzU5Mrzbnim0+kvOzj
        Cz/A9DOsTv/+C2oxowbks8Dp/pxqwcuyatBB8P88+yy0tCaskC2IMtzQQw9D
        pBRFS1NksbYXN52x0xpzzLE44XgkTrlSg0R1SFWLdA5JV5mEVUpZraySSi5v
        7RLM8sbk9UxfH31vI9bie82uj4rVizbbYMxttzl1I+ym3w4TDkCfistTOT6b
        KzA6yagDdMkFoSz0uwetHMus8hYlM731SoNUQw7nZe21ekWs1ER9UVSxX01h
        3BRgT28kGNQdD0b1R4VZVTW6VpNsUkknZ+Xuu4pppRVXjXX1kkxePS4z3kjp
        nddefPG91F+VA+b0U099KzhmUmc+VUiGH3YV4lh3pphcizG2VUuOwfy4V5Hl
        lZRkSlEG8VJ+M10ZYIH/P70RZoNp7jFhrVflGmeIJX6y54trvTLojTseGmSj
        fRWZ5ElPzldlFlme+mWXaYw5VIR31PZmrnOemOdYyZ2V7FqxRDvxoj1m+0x8
        Onycw8j9wQfEyj/0B8TMSdw88xIzV1GbFUUP3UVtTEf9xtNVH1UbHl0nbhsg
        ZVeOdtlnJ7Ka3HM/sprem/QdyuB9r7gaKo2fMh8qlceSeeWzVN5LfL6cXnox
        Hw8Te0g5RNptuOFOGWqoWfYtRqoNvnrvrG3uOkmvAR+8ScLnNzxjoRNPu2gN
        Q9bw8cj9r9zkAkg5zXmucwYEnT9Et8DRKVCBqDvd6iI4QeK4zoKv24brbHe7
        /9vVjoO7053vhkQ84hmJhMMjXj6Cp0IWIu95L2zeC6mXj+lVj4Y31B4AH4e0
        7iXNZEsr0YhWRCK59YtuLirf3fJGMFGpj29+YxjgdDYxKGFnflL6meGwVDYv
        IS5/amOcmPqnwwGWkYCVQ2Aa1Si6zDHQjQ+cYBwnmEE6XvCCH8RjHnUnuxBu
        o48hPGEgU2g8QraQhTJEZCKnp7wa4hCHZPTfGCUHOctV8kOX8xznGhi6TUaw
        Raf7JI0kOEocwe50GKwgjza4uxGysoSvFCHxsIPCKLnQlsdbHvRmKL1d+i97
        18MQJCn3uDMWc4BqRKbn3ujG08FRjnKsYzTvmEc87v/Rj9f8ox8FKUgV+s6Q
        hSxkIsX5vEaWk4aPOycAJem/SUrOkgS8ZAE5OU8HztOT9zydb0jJOtWhko6x
        UyWRZNdKgvquVbFEKPBquVDh4XJKt0zeLm/IS4r60qI7BKAxNZo5NCbTo210
        4DJDCk07SvN2GqRmSjmYTZZq84TfhKnyjDdOmpLTkeasISR1qFEzdrSjBmRj
        SIXKzGcW9ZQRNOk0UbrS27X0jwbdJjfBCdOZHlKGi7xpVnWqw3/474xdNeY/
        OGpAsaaxrEAtqxv/scy1HjWDa5UmXJf6jzzSFY92/eM/WKpXqPqOr+DU6zf/
        IdMXDhaRhn0hPgxbzq7etKv/W/VqTzdKQJCCVKTLNGocM+jWkpZUdii1plOx
        2deobpOqMbUqVnGq1XSSsauvVWxsX+uP2YrVtrTF7W11m1vaasO2vgXuWoUb
        XOIO17i+3QZdlZtc5i7Xuc1NbjWUK13q6tW61cXuda2bj+0O1rvcBe93xRte
        7iq2vLBFr2x3Kln2eu6nyoTvZYfazGdutrNJPakem4pN/rKUtCQ87VTDadXE
        2nS1OEWn/9K7YMXStsG7hTBvfzvh3h7XwsUtbnKR+1wOQ5fD2QWxdkNcXe5K
        l7zjRXF4zfva86o3vcRUcE/BWkawjrW38V3rUHOs1me21Y5yrSOQNQhXPspO
        r/09/3Jen0pdbxIvsIAVcGAJW14DN5axOH1sjBfs4Ah3WcJf1q1vK1xhDBtX
        wx1Gs4fVjGbpRlfEby5xiuV8YjqLd8V3ZnCeXfzgB4M5t2K+cKDLPGgzC/fM
        Hm6zdd084jczmtFxrvOJ8bxnPVeay372cqb/PGFCb3jDawZ1mtk8XVI72rsm
        nnOqI+3dSVea0pS+dG03TWZB17rTFj60cxO960b32tSmhnR3VcxqV+f5H689
        Nm2TfWzbLtvZzYa2sqPNbGlXm9m+PTa2hXvs5HKb2d1WrrfFHW5yg9vczJbu
        sdNt3WNzt93Mdrd33z1vedc73veGd76P/Wr0xprPmqawcPBpfWuCK9fTom4u
        r928aF/3OtioRvWqzzvxYrv42da+OLU1nnGOTzvb1wb5uM8t8m+XnOQnLze6
        9W3vleOb3i5n+cuZrdh9F9vftu1zwAG9c07b2ucHz/WnSb3whv8azt2FOIrx
        TPFW85vZT4d61KU+dapX3epXx3rWtb51rnc96zRHNrTBjnGPl13a2j57yLe9
        dm2PPOUodzu41z13lat75euGed5bPvOVgx3sXgd84AU/eMIX3vB+33jYpT32
        xKf92WhXu+PJ3Xa1g5vyKF+33E3Obs7jve719rzMa05vsMe79Hw3fOpVv3rW
        t57qAQEAOw==
 }]
 set ::he::dialog::colordialog(img_v) [image create photo -data {
        R0lGODlhCgBlAPcAAP////z8/Pr6+vf39/X19fLy8vDw8O3t7evr6+jo6Obm
        5uPj4+Dg4N7e3tvb29nZ2dbW1tTU1NHR0c/Pz8zMzMnJycfHx8TExMLCwr+/
        v729vbq6uri4uLW1tbOzs7CwsK2traurq6ioqKampqOjo6GhoZ6enpycnJmZ
        mZaWlpSUlJGRkY+Pj4yMjIqKioeHh4WFhYKCgoCAgH19fXp6enh4eHV1dXNz
        c3BwcG5ubmtra2lpaWZmZmNjY2FhYV5eXlxcXFlZWVdXV1RUVFJSUk9PT01N
        TUpKSkdHR0VFRUJCQkBAQD09PTs7Ozg4ODY2NjMzMzAwMC4uLisrKykpKSYm
        JiQkJCEhIR8fHxwcHBoaGhcXFxQUFBISEg8PDw0NDQoKCggICAUFBQMDAwAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAACwAAAAACgBlAAAI/wABCBxIMIDBgwgFKFzIcIDD
        hxAJSJxIsYDFixgNaNzI8YDHjyARiBxJMoHJkygVqFzJcoHLlzAZyJxJs4HN
        mzgd6NzJ84HPn0AhCB1KNILRo0glKF3KdILTp1ApSJ1KtYLVq1gtaN3K9YLX
        r2AxiB1LNoPZs2g1qF3LdoPbt3A5yJ1Lt4Pdu3g96N3L94Pfv4BBCB5MOITh
        w4hFKF7MeITjx5BJSJ5MuYTly5hNaN7M+YTnz6BRiB5NOoXp06hVqF7NeoXr
        17BZyJ5Nu4Xt27hd6N7N+4Xv38BhCB9OPIbx48hlKF/OfIbz59BpSJ9OvYb1
        69htaN/O/Yb37+BxiN0fTz6H+fPodahfz36H+/fwecifT7+H/fv4fejfz/+H
        //8AAiHggAQGYeCBCAqh4IIMDuHggxASIeGEFBZh4YUYGqHhhhwe4eGHICIh
        4ogkJmHiiSgqoeKKLC7h4oswMiHjjDQ2YeONODqh4448PuHjj0BCIeSQREZh
        5JFISqHkkkxO4eSTUFIh5ZRUVmHllVhaoeWWXF7h5ZdgYiHmmGRmYeaZaGqh
        5ppsbuHmm3ByIeecdHZh5514eqHnnnx+4eefgIIh6KCEhmHooYiKoeiijI7h
        6KOQkiHppJQGBAA7
 }]

RS: "There is no way"? Look at this:-)
 % winfo rgb . yellowgreen
 39578 52685 12850
 % foreach {r g b} [winfo rgb . yellowgreen] break
 % format #%02x%02x%02x [expr {$r/256}] [expr {$g/256}] [expr {$b/256}]
 #9acd32

HE Thank you! Have this command completely forget. Changed it above. Know the file size is more pocketPC like :-)

EH Let's make the file size even smaller, but also display a truecolor Hue-Saturation palette instead of the dithered GIF one, and last but not least, allow the dialog to be resizable. This code replace the inlined images by dynamic ones, generated on the fly. Let's add a binding to <Configure> to have the dialog regenerate the images, and now this dialog will also display fine on true-VGA (640x480) PDA. HE Very good idea. I have tried an own solution in the very beginning. I tested your solution but got the same result. Calculating an truecolor palette creates two problems (at least on my pocketPCs):

  • I test it on two packetPC. The first try on an pda with windows mobile 2003 se: the truecolor Hue-Saturation palette looks ugly. The second try on windows mobile 5.0 looks great. I think it depends on the quality of the display. To use the code on both pocketPCs I need to use the gifs :-(
  • The startup time grows unacceptable for me on both pocketPC (+15 - +20 seconds). This is also a reason to use the gifs :-(

2006-03-18 I agree GIF is not so bad, but I can't help getting into the challenge when a Tcl code is supposed to be too slow ;-) So below is an updated version of hsmap generator, which now take less than 0.2s (vs. 15-20s you mentionned) to generate a 180x100 Hue -Saturation palette. HEThis is really fast. I use this for my PDAs. Even with the ugly truecolor.HE-end I don't understand how a truecolor image can look more ugly than an indexed one, even when displayed on "older" 4096 colors screen HEIt looks like a shaded 255 color image.HE-end. Also, not related, but: I believe that adding a binding to <1> and not only <B1-Motion> to change color and brightness make the dialog more usable. HE To change the bindings is a good idea. But the tags hsmap and bmap doesn't exist. I add them to the images and I removed the binding to hsval and bval. all changes in the code above. HE-end
 $w.c.dial bind hsmap <1> "::he::dialog::colordialog_set_hs %x %y"
 $w.c.dial bind hsmap <B1-Motion> "::he::dialog::colordialog_set_hs %x %y"

 $w.c.dial bind bmap  <1> "::he::dialog::colordialog_set_b  %y"
 $w.c.dial bind bmap  <B1-Motion> "::he::dialog::colordialog_set_b  %y"

By the way. We need not only a binding to <Configure> to make the dialog resizable. colordialog_set_hs and colordialog_set_b are based on the geometry of the pictures. Changing this geometry needs changing this procs.

EH Some other comments:

  • I suggest to add {} around your expr, especially in hsb2rgb/rgb2hsb procedures. This make a huge difference in performance (and since the dynamic image generator use them for each pixel...). HE I changed it in the code above. Testing the procedures shows great performance. But on my acer n50 it doesn't look faster :-(
  • In checkAndSetInitialColor, you left the "yellowgreen" value given by Richard as an example. It should be $value instead. Actually, the whole procedure is useless, since winfo rgb parse all valid color formats, so it should be: HE Fixed it in the code above and deleted it below.
  • Not specific to this dialog, but more generally to eTcl on PocketPC: ::etcl::autofit should be bind to <Expose> event too (together with <ConfigureRequest>). This is because if SIP state change when eTcl doesn't have the focus, it won't notice it. Not that important, but better. (I really have to release some documentation soon. Shame on me!). HEThanks for the hint. Added it (Added it in Alternative dialogs for pocketPC/etcl too).

I didn't want to edit/delete/break your code, so I let you apply the changes to it if you like this approach.
 # Generate a vertical gradient
 proc ::he::dialog::vgradient {width height} {
   set c0 0xff
   set c1 0x00
 
   set img [image create photo -width $width -height $height]
   if {$width<=0 || $height<=0} {
     return $img
   }
 
   for {set y 0} {$y<$height} {incr y} {
     if {$height<=1} {
       set gs $c0
     } else {
       set gs [expr {$c0+(($c1-$c0)*$y)/($height-1)}]
     }
 
     set color [format "#%02x%02x%02x" $gs $gs $gs]
     $img put [list [list $color]] -to 0 $y $width [expr {$y+1}]
   }
 
   return $img
 }
 
 # Generate Hue-Saturation map
 proc ::he::dialog::hsmap {reqwidth reqheight {img ""}} {
   if {![string compare "" $img]} {
     set img [image create photo -width $reqwidth -height $reqheight]
   } else {
     $img configure -width $reqwidth -height $reqheight
     $img blank
   }
 
   if {$reqwidth<=0 || $reqheight<=0} {
     return $img
   }
   
   # Max brightness
   # set v 100.0
   set v 255
  
   # make code run $rx*$ry times faster. rx=ry=3 still produces a nice
   # map with no visible artefact, while taking lest than 0.2s on 
   # an ipaq 4150 to generate a 180x100 image
   if {$::tcl_platform(os) eq {Windows CE}} {
     set rx 3
     set ry 3
   } else {
     set rx 1
     set ry 1
   }
 
   set width [expr {$reqwidth/$rx}]
   set height [expr {$reqheight/$ry}]

   set fmax [expr {$width/6}]
   set pixels [list]

   for {set y 0} {$y<$height} {incr y} {
     if {$height<=1} {
       set s 255
     } else {
       set s [expr {(255*($height-1-$y))/($height-1)}]
       if {$s<=0} {
         set s 0
       }
     }
    
     if {$s<=0} {
       # White
       for {set x 0} {$x<$width} {incr x} {
        lappend pixels 0xff 0xff 0xff
       }
     } else {
       set x 0
       set p [expr {255-$s}]

       foreach h {0 1 2 3 4 5} {
         set f 0
         set xmax [expr {(($h+1)*$width)/6}]
         while {$x<$xmax} {
           set q [expr {255-($s*$f)/$fmax}]
           set t [expr {255-($s*($fmax-$f))/$fmax}]
          
          if {$h==0} {
            lappend pixels $v $t $p
          } elseif {$h==1} {
            lappend pixels $q $v $p
          } elseif {$h==2} {
            lappend pixels $p $v $t
          } elseif {$h==3} {
            lappend pixels $p $q $v
          } elseif {$h==4} {
            lappend pixels $t $p $v
          } else {
            lappend pixels $v $p $q
          }

          incr x
          incr f
        }
       }
     }
   }

   set header "P6\n\# PPM data\n${width} ${height}\n255\n"
   append tkdata [binary format {a*c*} $header $pixels]

   if {$rx!=1 || $ry!=1} {
     set tmp [image create photo]
     $tmp put $tkdata -to 0 0 $width $height -format PPM    
     $img copy $tmp -zoom $rx $ry -compositingrule set    
     image delete $tmp
   } else {
     $img put $tkdata -to 0 0 $width $height -format PPM    
   }

   return $img
 }

 set ::he::dialog::colordialog(img_hs) [::he::dialog::hsmap 181 100]
 set ::he::dialog::colordialog(img_v) [::he::dialog::vgradient 10 101]

2006-05-12 HE Some startup and file size improvements: Changing multiple 'set colordialog() ...' to one 'array set' and the multiple 'msgcat::mcset' to one 'msgcat::mcmset' for every locale.