home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / tk8.3 / clrpick.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  19.2 KB  |  672 lines
  1. # clrpick.tcl --
  2. #
  3. #    Color selection dialog for platforms that do not support a
  4. #    standard color selection dialog.
  5. #
  6. # RCS: @(#) $Id: clrpick.tcl,v 1.10 2000/04/04 08:09:24 hobbs Exp $
  7. #
  8. # Copyright (c) 1996 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # ToDo:
  14. #
  15. #    (1): Find out how many free colors are left in the colormap and
  16. #         don't allocate too many colors.
  17. #    (2): Implement HSV color selection. 
  18. #
  19.  
  20. # tkColorDialog --
  21. #
  22. #    Create a color dialog and let the user choose a color. This function
  23. #    should not be called directly. It is called by the tk_chooseColor
  24. #    function when a native color selector widget does not exist
  25. #
  26. proc tkColorDialog {args} {
  27.     global tkPriv
  28.     set w .__tk__color
  29.     upvar #0 $w data
  30.  
  31.     # The lines variables track the start and end indices of the line
  32.     # elements in the colorbar canvases.
  33.     set data(lines,red,start)   0
  34.     set data(lines,red,last)   -1
  35.     set data(lines,green,start) 0
  36.     set data(lines,green,last) -1
  37.     set data(lines,blue,start)  0
  38.     set data(lines,blue,last)  -1
  39.  
  40.     # This is the actual number of lines that are drawn in each color strip.
  41.     # Note that the bars may be of any width.
  42.     # However, NUM_COLORBARS must be a number that evenly divides 256.
  43.     # Such as 256, 128, 64, etc.
  44.     set data(NUM_COLORBARS) 8
  45.  
  46.     # BARS_WIDTH is the number of pixels wide the color bar portion of the
  47.     # canvas is. This number must be a multiple of NUM_COLORBARS
  48.     set data(BARS_WIDTH) 128
  49.  
  50.     # PLGN_WIDTH is the number of pixels wide of the triangular selection
  51.     # polygon. This also results in the definition of the padding on the 
  52.     # left and right sides which is half of PLGN_WIDTH. Make this number even.
  53.     set data(PLGN_HEIGHT) 10
  54.  
  55.     # PLGN_HEIGHT is the height of the selection polygon and the height of the 
  56.     # selection rectangle at the bottom of the color bar. No restrictions.
  57.     set data(PLGN_WIDTH) 10
  58.  
  59.     tkColorDialog_Config $w $args
  60.     tkColorDialog_InitValues $w
  61.  
  62.     set sc [winfo screen $data(-parent)]
  63.     set winExists [winfo exists $w]
  64.     if {!$winExists || [string compare $sc [winfo screen $w]]} {
  65.     if {$winExists} {
  66.         destroy $w
  67.     }
  68.     toplevel $w -class tkColorDialog -screen $sc
  69.     tkColorDialog_BuildDialog $w
  70.     }
  71.  
  72.     wm transient $w $data(-parent)
  73.  
  74.     # 5. Withdraw the window, then update all the geometry information
  75.     # so we know how big it wants to be, then center the window in the
  76.     # display and de-iconify it.
  77.  
  78.     ::tk::PlaceWindow $w widget $data(-parent)
  79.     wm title $w $data(-title)
  80.  
  81.     # 6. Set a grab and claim the focus too.
  82.  
  83.     ::tk::SetFocusGrab $w $data(okBtn)
  84.  
  85.     # 7. Wait for the user to respond, then restore the focus and
  86.     # return the index of the selected button.  Restore the focus
  87.     # before deleting the window, since otherwise the window manager
  88.     # may take the focus away so we can't redirect it.  Finally,
  89.     # restore any grab that was in effect.
  90.  
  91.     vwait tkPriv(selectColor)
  92.     ::tk::RestoreFocusGrab $w $data(okBtn)
  93.     unset data
  94.  
  95.     return $tkPriv(selectColor)
  96. }
  97.  
  98. # tkColorDialog_InitValues --
  99. #
  100. #    Get called during initialization or when user resets NUM_COLORBARS
  101. #
  102. proc tkColorDialog_InitValues {w} {
  103.     upvar #0 $w data
  104.  
  105.     # IntensityIncr is the difference in color intensity between a colorbar
  106.     # and its neighbors.
  107.     set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]
  108.  
  109.     # ColorbarWidth is the width of each colorbar
  110.     set data(colorbarWidth) \
  111.         [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]
  112.  
  113.     # Indent is the width of the space at the left and right side of the
  114.     # colorbar. It is always half the selector polygon width, because the
  115.     # polygon extends into the space.
  116.     set data(indent) [expr {$data(PLGN_WIDTH) / 2}]
  117.  
  118.     set data(colorPad) 2
  119.     set data(selPad)   [expr {$data(PLGN_WIDTH) / 2}]
  120.  
  121.     #
  122.     # minX is the x coordinate of the first colorbar
  123.     #
  124.     set data(minX) $data(indent)
  125.  
  126.     #
  127.     # maxX is the x coordinate of the last colorbar
  128.     #
  129.     set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]
  130.  
  131.     #
  132.     # canvasWidth is the width of the entire canvas, including the indents
  133.     #
  134.     set data(canvasWidth) [expr {$data(BARS_WIDTH) + $data(PLGN_WIDTH)}]
  135.  
  136.     # Set the initial color, specified by -initialcolor, or the
  137.     # color chosen by the user the last time.
  138.     set data(selection) $data(-initialcolor)
  139.     set data(finalColor)  $data(-initialcolor)
  140.     set rgb [winfo rgb . $data(selection)]
  141.  
  142.     set data(red,intensity)   [expr {[lindex $rgb 0]/0x100}]
  143.     set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]
  144.     set data(blue,intensity)  [expr {[lindex $rgb 2]/0x100}]
  145. }
  146.  
  147. # tkColorDialog_Config  --
  148. #
  149. #    Parses the command line arguments to tk_chooseColor
  150. #
  151. proc tkColorDialog_Config {w argList} {
  152.     global tkPriv
  153.     upvar #0 $w data
  154.  
  155.     # 1: the configuration specs
  156.     #
  157.     if {[info exists tkPriv(selectColor)] && \
  158.         [string compare $tkPriv(selectColor) ""]} {
  159.     set defaultColor $tkPriv(selectColor)
  160.     } else {
  161.     set defaultColor [. cget -background]
  162.     }
  163.  
  164.     set specs [list \
  165.         [list -initialcolor "" "" $defaultColor] \
  166.         [list -parent "" "" "."] \
  167.         [list -title "" "" "Color"] \
  168.         ]
  169.  
  170.     # 2: parse the arguments
  171.     #
  172.     tclParseConfigSpec $w $specs "" $argList
  173.  
  174.     if {[string equal $data(-title) ""]} {
  175.     set data(-title) " "
  176.     }
  177.     if {[catch {winfo rgb . $data(-initialcolor)} err]} {
  178.     error $err
  179.     }
  180.  
  181.     if {![winfo exists $data(-parent)]} {
  182.     error "bad window path name \"$data(-parent)\""
  183.     }
  184. }
  185.  
  186. # tkColorDialog_BuildDialog --
  187. #
  188. #    Build the dialog.
  189. #
  190. proc tkColorDialog_BuildDialog {w} {
  191.     upvar #0 $w data
  192.  
  193.     # TopFrame contains the color strips and the color selection
  194.     #
  195.     set topFrame [frame $w.top -relief raised -bd 1]
  196.  
  197.     # StripsFrame contains the colorstrips and the individual RGB entries
  198.     set stripsFrame [frame $topFrame.colorStrip]
  199.  
  200.     foreach c { Red Green Blue } {
  201.     set color [string tolower $c]
  202.  
  203.     # each f frame contains an [R|G|B] entry and the equiv. color strip.
  204.     set f [frame $stripsFrame.$color]
  205.  
  206.     # The box frame contains the label and entry widget for an [R|G|B]
  207.     set box [frame $f.box]
  208.  
  209.     label $box.label -text $c: -width 6 -under 0 -anchor ne
  210.     entry $box.entry -textvariable [format %s $w]($color,intensity) \
  211.         -width 4
  212.     pack $box.label -side left -fill y -padx 2 -pady 3
  213.     pack $box.entry -side left -anchor n -pady 0
  214.     pack $box -side left -fill both
  215.  
  216.     set height [expr \
  217.         {[winfo reqheight $box.entry] - \
  218.         2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]
  219.  
  220.     canvas $f.color -height $height\
  221.         -width $data(BARS_WIDTH) -relief sunken -bd 2
  222.     canvas $f.sel -height $data(PLGN_HEIGHT) \
  223.         -width $data(canvasWidth) -highlightthickness 0
  224.     pack $f.color -expand yes -fill both
  225.     pack $f.sel -expand yes -fill both
  226.  
  227.     pack $f -side top -fill x -padx 0 -pady 2
  228.  
  229.     set data($color,entry) $box.entry
  230.     set data($color,col) $f.color
  231.     set data($color,sel) $f.sel
  232.  
  233.     bind $data($color,col) <Configure> \
  234.         [list tkColorDialog_DrawColorScale $w $color 1]
  235.     bind $data($color,col) <Enter> \
  236.         [list tkColorDialog_EnterColorBar $w $color]
  237.     bind $data($color,col) <Leave> \
  238.         [list tkColorDialog_LeaveColorBar $w $color]
  239.  
  240.     bind $data($color,sel) <Enter> \
  241.         [list tkColorDialog_EnterColorBar $w $color]
  242.     bind $data($color,sel) <Leave> \
  243.         [list tkColorDialog_LeaveColorBar $w $color]
  244.  
  245.     bind $box.entry <Return> [list tkColorDialog_HandleRGBEntry $w]
  246.     }
  247.  
  248.     pack $stripsFrame -side left -fill both -padx 4 -pady 10
  249.  
  250.     # The selFrame contains a frame that demonstrates the currently
  251.     # selected color
  252.     #
  253.     set selFrame [frame $topFrame.sel]
  254.     set lab [label $selFrame.lab -text "Selection:" -under 0 -anchor sw]
  255.     set ent [entry $selFrame.ent -textvariable [format %s $w](selection) \
  256.     -width 16]
  257.     set f1  [frame $selFrame.f1 -relief sunken -bd 2]
  258.     set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]
  259.  
  260.     pack $lab $ent -side top -fill x -padx 4 -pady 2
  261.     pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
  262.     pack $data(finalCanvas) -expand yes -fill both
  263.  
  264.     bind $ent <Return> [list tkColorDialog_HandleSelEntry $w]
  265.  
  266.     pack $selFrame -side left -fill none -anchor nw
  267.     pack $topFrame -side top -expand yes -fill both -anchor nw
  268.  
  269.     # the botFrame frame contains the buttons
  270.     #
  271.     set botFrame [frame $w.bot -relief raised -bd 1]
  272.     button $botFrame.ok     -text OK            -width 8 -under 0 \
  273.     -command [list tkColorDialog_OkCmd $w]
  274.     button $botFrame.cancel -text Cancel        -width 8 -under 0 \
  275.     -command [list tkColorDialog_CancelCmd $w]
  276.  
  277.     set data(okBtn)      $botFrame.ok
  278.     set data(cancelBtn)  $botFrame.cancel
  279.  
  280.     pack $botFrame.ok $botFrame.cancel \
  281.     -padx 10 -pady 10 -expand yes -side left
  282.     pack $botFrame -side bottom -fill x
  283.  
  284.  
  285.     # Accelerator bindings
  286.  
  287.     bind $w <Alt-r> [list focus $data(red,entry)]
  288.     bind $w <Alt-g> [list focus $data(green,entry)]
  289.     bind $w <Alt-b> [list focus $data(blue,entry)]
  290.     bind $w <Alt-s> [list focus $ent]
  291.     bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)]
  292.     bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]
  293.     bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)]
  294.  
  295.     wm protocol $w WM_DELETE_WINDOW [list tkColorDialog_CancelCmd $w]
  296. }
  297.  
  298. # tkColorDialog_SetRGBValue --
  299. #
  300. #    Sets the current selection of the dialog box
  301. #
  302. proc tkColorDialog_SetRGBValue {w color} {
  303.     upvar #0 $w data 
  304.  
  305.     set data(red,intensity)   [lindex $color 0]
  306.     set data(green,intensity) [lindex $color 1]
  307.     set data(blue,intensity)  [lindex $color 2]
  308.     
  309.     tkColorDialog_RedrawColorBars $w all
  310.  
  311.     # Now compute the new x value of each colorbars pointer polygon
  312.     foreach color { red green blue } {
  313.     set x [tkColorDialog_RgbToX $w $data($color,intensity)]
  314.     tkColorDialog_MoveSelector $w $data($color,sel) $color $x 0
  315.     }
  316. }
  317.  
  318. # tkColorDialog_XToRgb --
  319. #
  320. #    Converts a screen coordinate to intensity
  321. #
  322. proc tkColorDialog_XToRgb {w x} {
  323.     upvar #0 $w data
  324.     
  325.     return [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]
  326. }
  327.  
  328. # tkColorDialog_RgbToX
  329. #
  330. #    Converts an intensity to screen coordinate.
  331. #
  332. proc tkColorDialog_RgbToX {w color} {
  333.     upvar #0 $w data
  334.     
  335.     return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
  336. }
  337.  
  338.  
  339. # tkColorDialog_DrawColorScale --
  340. # 
  341. #    Draw color scale is called whenever the size of one of the color
  342. #    scale canvases is changed.
  343. #
  344. proc tkColorDialog_DrawColorScale {w c {create 0}} {
  345.     global lines
  346.     upvar #0 $w data
  347.  
  348.     # col: color bar canvas
  349.     # sel: selector canvas
  350.     set col $data($c,col)
  351.     set sel $data($c,sel)
  352.  
  353.     # First handle the case that we are creating everything for the first time.
  354.     if {$create} {
  355.     # First remove all the lines that already exist.
  356.     if { $data(lines,$c,last) > $data(lines,$c,start)} {
  357.         for {set i $data(lines,$c,start)} \
  358.         {$i <= $data(lines,$c,last)} { incr i} {
  359.         $sel delete $i
  360.         }
  361.     }
  362.     # Delete the selector if it exists
  363.     if {[info exists data($c,index)]} {
  364.         $sel delete $data($c,index)
  365.     }
  366.     
  367.     # Draw the selection polygons
  368.     tkColorDialog_CreateSelector $w $sel $c
  369.     $sel bind $data($c,index) <ButtonPress-1> \
  370.         [list tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1]
  371.     $sel bind $data($c,index) <B1-Motion> \
  372.         [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]
  373.     $sel bind $data($c,index) <ButtonRelease-1> \
  374.         [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]
  375.  
  376.     set height [winfo height $col]
  377.     # Create an invisible region under the colorstrip to catch mouse clicks
  378.     # that aren't on the selector.
  379.     set data($c,clickRegion) [$sel create rectangle 0 0 \
  380.         $data(canvasWidth) $height -fill {} -outline {}]
  381.  
  382.     bind $col <ButtonPress-1> \
  383.         [list tkColorDialog_StartMove $w $sel $c %x $data(colorPad)]
  384.     bind $col <B1-Motion> \
  385.         [list tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)]
  386.     bind $col <ButtonRelease-1> \
  387.         [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)]
  388.  
  389.     $sel bind $data($c,clickRegion) <ButtonPress-1> \
  390.         [list tkColorDialog_StartMove $w $sel $c %x $data(selPad)]
  391.     $sel bind $data($c,clickRegion) <B1-Motion> \
  392.         [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]
  393.     $sel bind $data($c,clickRegion) <ButtonRelease-1> \
  394.         [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]
  395.     } else {
  396.     # l is the canvas index of the first colorbar.
  397.     set l $data(lines,$c,start)
  398.     }
  399.     
  400.     # Draw the color bars.
  401.     set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]
  402.     for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
  403.     set intensity [expr {$i * $data(intensityIncr)}]
  404.     set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
  405.     if {[string equal $c "red"]} {
  406.         set color [format "#%02x%02x%02x" \
  407.                $intensity \
  408.                $data(green,intensity) \
  409.                $data(blue,intensity)]
  410.     } elseif {[string equal $c "green"]} {
  411.         set color [format "#%02x%02x%02x" \
  412.                $data(red,intensity) \
  413.                $intensity \
  414.                $data(blue,intensity)]
  415.     } else {
  416.         set color [format "#%02x%02x%02x" \
  417.                $data(red,intensity) \
  418.                $data(green,intensity) \
  419.                $intensity]
  420.     }
  421.  
  422.     if {$create} {
  423.         set index [$col create rect $startx $highlightW \
  424.             [expr {$startx +$data(colorbarWidth)}] \
  425.             [expr {[winfo height $col] + $highlightW}]\
  426.             -fill $color -outline $color]
  427.     } else {
  428.         $col itemconfigure $l -fill $color -outline $color
  429.         incr l
  430.     }
  431.     }
  432.     $sel raise $data($c,index)
  433.  
  434.     if {$create} {
  435.     set data(lines,$c,last) $index
  436.     set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
  437.     }
  438.  
  439.     tkColorDialog_RedrawFinalColor $w
  440. }
  441.  
  442. # tkColorDialog_CreateSelector --
  443. #
  444. #    Creates and draws the selector polygon at the position
  445. #    $data($c,intensity).
  446. #
  447. proc tkColorDialog_CreateSelector {w sel c } {
  448.     upvar #0 $w data
  449.     set data($c,index) [$sel create polygon \
  450.     0 $data(PLGN_HEIGHT) \
  451.     $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
  452.     $data(indent) 0]
  453.     set data($c,x) [tkColorDialog_RgbToX $w $data($c,intensity)]
  454.     $sel move $data($c,index) $data($c,x) 0
  455. }
  456.  
  457. # tkColorDialog_RedrawFinalColor
  458. #
  459. #    Combines the intensities of the three colors into the final color
  460. #
  461. proc tkColorDialog_RedrawFinalColor {w} {
  462.     upvar #0 $w data
  463.  
  464.     set color [format "#%02x%02x%02x" $data(red,intensity) \
  465.     $data(green,intensity) $data(blue,intensity)]
  466.     
  467.     $data(finalCanvas) configure -bg $color
  468.     set data(finalColor) $color
  469.     set data(selection) $color
  470.     set data(finalRGB) [list \
  471.         $data(red,intensity) \
  472.         $data(green,intensity) \
  473.         $data(blue,intensity)]
  474. }
  475.  
  476. # tkColorDialog_RedrawColorBars --
  477. #
  478. # Only redraws the colors on the color strips that were not manipulated.
  479. # Params: color of colorstrip that changed. If color is not [red|green|blue]
  480. #         Then all colorstrips will be updated
  481. #
  482. proc tkColorDialog_RedrawColorBars {w colorChanged} {
  483.     upvar #0 $w data
  484.  
  485.     switch $colorChanged {
  486.     red { 
  487.         tkColorDialog_DrawColorScale $w green
  488.         tkColorDialog_DrawColorScale $w blue
  489.     }
  490.     green {
  491.         tkColorDialog_DrawColorScale $w red
  492.         tkColorDialog_DrawColorScale $w blue
  493.     }
  494.     blue {
  495.         tkColorDialog_DrawColorScale $w red
  496.         tkColorDialog_DrawColorScale $w green
  497.     }
  498.     default {
  499.         tkColorDialog_DrawColorScale $w red
  500.         tkColorDialog_DrawColorScale $w green
  501.         tkColorDialog_DrawColorScale $w blue
  502.     }
  503.     }
  504.     tkColorDialog_RedrawFinalColor $w
  505. }
  506.  
  507. #----------------------------------------------------------------------
  508. #            Event handlers
  509. #----------------------------------------------------------------------
  510.  
  511. # tkColorDialog_StartMove --
  512. #
  513. #    Handles a mousedown button event over the selector polygon.
  514. #    Adds the bindings for moving the mouse while the button is
  515. #    pressed.  Sets the binding for the button-release event.
  516. # 
  517. # Params: sel is the selector canvas window, color is the color of the strip.
  518. #
  519. proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {
  520.     upvar #0 $w data
  521.  
  522.     if {!$dontMove} {
  523.     tkColorDialog_MoveSelector $w $sel $color $x $delta
  524.     }
  525. }
  526.  
  527. # tkColorDialog_MoveSelector --
  528. # 
  529. # Moves the polygon selector so that its middle point has the same
  530. # x value as the specified x. If x is outside the bounds [0,255],
  531. # the selector is set to the closest endpoint.
  532. #
  533. # Params: sel is the selector canvas, c is [red|green|blue]
  534. #         x is a x-coordinate.
  535. #
  536. proc tkColorDialog_MoveSelector {w sel color x delta} {
  537.     upvar #0 $w data
  538.  
  539.     incr x -$delta
  540.  
  541.     if { $x < 0 } {
  542.     set x 0
  543.     } elseif { $x >= $data(BARS_WIDTH)} {
  544.     set x [expr {$data(BARS_WIDTH) - 1}]
  545.     }
  546.     set diff [expr {$x - $data($color,x)}]
  547.     $sel move $data($color,index) $diff 0
  548.     set data($color,x) [expr {$data($color,x) + $diff}]
  549.     
  550.     # Return the x value that it was actually set at
  551.     return $x
  552. }
  553.  
  554. # tkColorDialog_ReleaseMouse
  555. #
  556. # Removes mouse tracking bindings, updates the colorbars.
  557. #
  558. # Params: sel is the selector canvas, color is the color of the strip,
  559. #         x is the x-coord of the mouse.
  560. #
  561. proc tkColorDialog_ReleaseMouse {w sel color x delta} {
  562.     upvar #0 $w data 
  563.  
  564.     set x [tkColorDialog_MoveSelector $w $sel $color $x $delta]
  565.     
  566.     # Determine exactly what color we are looking at.
  567.     set data($color,intensity) [tkColorDialog_XToRgb $w $x]
  568.  
  569.     tkColorDialog_RedrawColorBars $w $color
  570. }
  571.  
  572. # tkColorDialog_ResizeColorbars --
  573. #
  574. #    Completely redraws the colorbars, including resizing the
  575. #    colorstrips
  576. #
  577. proc tkColorDialog_ResizeColorBars {w} {
  578.     upvar #0 $w data
  579.     
  580.     if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || 
  581.      (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {
  582.     set data(BARS_WIDTH) $data(NUM_COLORBARS)
  583.     }
  584.     tkColorDialog_InitValues $w
  585.     foreach color { red green blue } {
  586.     $data($color,col) configure -width $data(canvasWidth)
  587.     tkColorDialog_DrawColorScale $w $color 1
  588.     }
  589. }
  590.  
  591. # tkColorDialog_HandleSelEntry --
  592. #
  593. #    Handles the return keypress event in the "Selection:" entry
  594. #
  595. proc tkColorDialog_HandleSelEntry {w} {
  596.     upvar #0 $w data
  597.  
  598.     set text [string trim $data(selection)]
  599.     # Check to make sure that the color is valid
  600.     if {[catch {set color [winfo rgb . $text]} ]} {
  601.     set data(selection) $data(finalColor)
  602.     return
  603.     }
  604.     
  605.     set R [expr {[lindex $color 0]/0x100}]
  606.     set G [expr {[lindex $color 1]/0x100}]
  607.     set B [expr {[lindex $color 2]/0x100}]
  608.  
  609.     tkColorDialog_SetRGBValue $w "$R $G $B"
  610.     set data(selection) $text
  611. }
  612.  
  613. # tkColorDialog_HandleRGBEntry --
  614. #
  615. #    Handles the return keypress event in the R, G or B entry
  616. #
  617. proc tkColorDialog_HandleRGBEntry {w} {
  618.     upvar #0 $w data
  619.  
  620.     foreach c {red green blue} {
  621.     if {[catch {
  622.         set data($c,intensity) [expr {int($data($c,intensity))}]
  623.     }]} {
  624.         set data($c,intensity) 0
  625.     }
  626.  
  627.     if {$data($c,intensity) < 0} {
  628.         set data($c,intensity) 0
  629.     }
  630.     if {$data($c,intensity) > 255} {
  631.         set data($c,intensity) 255
  632.     }
  633.     }
  634.  
  635.     tkColorDialog_SetRGBValue $w "$data(red,intensity) $data(green,intensity) \
  636.     $data(blue,intensity)"
  637. }    
  638.  
  639. # mouse cursor enters a color bar
  640. #
  641. proc tkColorDialog_EnterColorBar {w color} {
  642.     upvar #0 $w data
  643.  
  644.     $data($color,sel) itemconfig $data($color,index) -fill red
  645. }
  646.  
  647. # mouse leaves enters a color bar
  648. #
  649. proc tkColorDialog_LeaveColorBar {w color} {
  650.     upvar #0 $w data
  651.  
  652.     $data($color,sel) itemconfig $data($color,index) -fill black
  653. }
  654.  
  655. # user hits OK button
  656. #
  657. proc tkColorDialog_OkCmd {w} {
  658.     global tkPriv
  659.     upvar #0 $w data
  660.  
  661.     set tkPriv(selectColor) $data(finalColor)
  662. }
  663.  
  664. # user hits Cancel button
  665. #
  666. proc tkColorDialog_CancelCmd {w} {
  667.     global tkPriv
  668.  
  669.     set tkPriv(selectColor) ""
  670. }
  671.  
  672.