| # clrpick.tcl -- |
| # |
| # Color selection dialog for platforms that do not support a |
| # standard color selection dialog. |
| # |
| # RCS: @(#) $Id: clrpick.tcl,v 1.19 2002/07/22 21:25:39 mdejong Exp $ |
| # |
| # Copyright (c) 1996 Sun Microsystems, Inc. |
| # |
| # See the file "license.terms" for information on usage and redistribution |
| # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
| # |
| # ToDo: |
| # |
| # (1): Find out how many free colors are left in the colormap and |
| # don't allocate too many colors. |
| # (2): Implement HSV color selection. |
| # |
| |
| # Make sure namespaces exist |
| namespace eval ::tk {} |
| namespace eval ::tk::dialog {} |
| namespace eval ::tk::dialog::color { |
| namespace import ::tk::msgcat::* |
| } |
| |
| # ::tk::dialog::color:: -- |
| # |
| # Create a color dialog and let the user choose a color. This function |
| # should not be called directly. It is called by the tk_chooseColor |
| # function when a native color selector widget does not exist |
| # |
| proc ::tk::dialog::color:: {args} { |
| variable ::tk::Priv |
| set dataName __tk__color |
| upvar ::tk::dialog::color::$dataName data |
| set w .$dataName |
| |
| # The lines variables track the start and end indices of the line |
| # elements in the colorbar canvases. |
| set data(lines,red,start) 0 |
| set data(lines,red,last) -1 |
| set data(lines,green,start) 0 |
| set data(lines,green,last) -1 |
| set data(lines,blue,start) 0 |
| set data(lines,blue,last) -1 |
| |
| # This is the actual number of lines that are drawn in each color strip. |
| # Note that the bars may be of any width. |
| # However, NUM_COLORBARS must be a number that evenly divides 256. |
| # Such as 256, 128, 64, etc. |
| set data(NUM_COLORBARS) 16 |
| |
| # BARS_WIDTH is the number of pixels wide the color bar portion of the |
| # canvas is. This number must be a multiple of NUM_COLORBARS |
| set data(BARS_WIDTH) 160 |
| |
| # PLGN_WIDTH is the number of pixels wide of the triangular selection |
| # polygon. This also results in the definition of the padding on the |
| # left and right sides which is half of PLGN_WIDTH. Make this number even. |
| set data(PLGN_HEIGHT) 10 |
| |
| # PLGN_HEIGHT is the height of the selection polygon and the height of the |
| # selection rectangle at the bottom of the color bar. No restrictions. |
| set data(PLGN_WIDTH) 10 |
| |
| Config $dataName $args |
| InitValues $dataName |
| |
| set sc [winfo screen $data(-parent)] |
| set winExists [winfo exists $w] |
| if {!$winExists || [string compare $sc [winfo screen $w]]} { |
| if {$winExists} { |
| destroy $w |
| } |
| toplevel $w -class TkColorDialog -screen $sc |
| BuildDialog $w |
| } |
| |
| # Dialog boxes should be transient with respect to their parent, |
| # so that they will always stay on top of their parent window. However, |
| # some window managers will create the window as withdrawn if the parent |
| # window is withdrawn or iconified. Combined with the grab we put on the |
| # window, this can hang the entire application. Therefore we only make |
| # the dialog transient if the parent is viewable. |
| |
| if {[winfo viewable [winfo toplevel $data(-parent)]] } { |
| wm transient $w $data(-parent) |
| } |
| |
| # 5. Withdraw the window, then update all the geometry information |
| # so we know how big it wants to be, then center the window in the |
| # display and de-iconify it. |
| |
| ::tk::PlaceWindow $w widget $data(-parent) |
| wm title $w $data(-title) |
| |
| # 6. Set a grab and claim the focus too. |
| |
| ::tk::SetFocusGrab $w $data(okBtn) |
| |
| # 7. Wait for the user to respond, then restore the focus and |
| # return the index of the selected button. Restore the focus |
| # before deleting the window, since otherwise the window manager |
| # may take the focus away so we can't redirect it. Finally, |
| # restore any grab that was in effect. |
| |
| vwait ::tk::Priv(selectColor) |
| ::tk::RestoreFocusGrab $w $data(okBtn) |
| unset data |
| |
| return $Priv(selectColor) |
| } |
| |
| # ::tk::dialog::color::InitValues -- |
| # |
| # Get called during initialization or when user resets NUM_COLORBARS |
| # |
| proc ::tk::dialog::color::InitValues {dataName} { |
| upvar ::tk::dialog::color::$dataName data |
| |
| # IntensityIncr is the difference in color intensity between a colorbar |
| # and its neighbors. |
| set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}] |
| |
| # ColorbarWidth is the width of each colorbar |
| set data(colorbarWidth) \ |
| [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}] |
| |
| # Indent is the width of the space at the left and right side of the |
| # colorbar. It is always half the selector polygon width, because the |
| # polygon extends into the space. |
| set data(indent) [expr {$data(PLGN_WIDTH) / 2}] |
| |
| set data(colorPad) 2 |
| set data(selPad) [expr {$data(PLGN_WIDTH) / 2}] |
| |
| # |
| # minX is the x coordinate of the first colorbar |
| # |
| set data(minX) $data(indent) |
| |
| # |
| # maxX is the x coordinate of the last colorbar |
| # |
| set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}] |
| |
| # |
| # canvasWidth is the width of the entire canvas, including the indents |
| # |
| set data(canvasWidth) [expr {$data(BARS_WIDTH) + $data(PLGN_WIDTH)}] |
| |
| # Set the initial color, specified by -initialcolor, or the |
| # color chosen by the user the last time. |
| set data(selection) $data(-initialcolor) |
| set data(finalColor) $data(-initialcolor) |
| set rgb [winfo rgb . $data(selection)] |
| |
| set data(red,intensity) [expr {[lindex $rgb 0]/0x100}] |
| set data(green,intensity) [expr {[lindex $rgb 1]/0x100}] |
| set data(blue,intensity) [expr {[lindex $rgb 2]/0x100}] |
| } |
| |
| # ::tk::dialog::color::Config -- |
| # |
| # Parses the command line arguments to tk_chooseColor |
| # |
| proc ::tk::dialog::color::Config {dataName argList} { |
| variable ::tk::Priv |
| upvar ::tk::dialog::color::$dataName data |
| |
| # 1: the configuration specs |
| # |
| if {[info exists Priv(selectColor)] && \ |
| [string compare $Priv(selectColor) ""]} { |
| set defaultColor $Priv(selectColor) |
| } else { |
| set defaultColor [. cget -background] |
| } |
| |
| set specs [list \ |
| [list -initialcolor "" "" $defaultColor] \ |
| [list -parent "" "" "."] \ |
| [list -title "" "" [mc "Color"]] \ |
| ] |
| |
| # 2: parse the arguments |
| # |
| tclParseConfigSpec ::tk::dialog::color::$dataName $specs "" $argList |
| |
| if {[string equal $data(-title) ""]} { |
| set data(-title) " " |
| } |
| if {[catch {winfo rgb . $data(-initialcolor)} err]} { |
| error $err |
| } |
| |
| if {![winfo exists $data(-parent)]} { |
| error "bad window path name \"$data(-parent)\"" |
| } |
| } |
| |
| # ::tk::dialog::color::BuildDialog -- |
| # |
| # Build the dialog. |
| # |
| proc ::tk::dialog::color::BuildDialog {w} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| # TopFrame contains the color strips and the color selection |
| # |
| set topFrame [frame $w.top -relief raised -bd 1] |
| |
| # StripsFrame contains the colorstrips and the individual RGB entries |
| set stripsFrame [frame $topFrame.colorStrip] |
| |
| set maxWidth [::tk::mcmaxamp &Red &Green &Blue] |
| set maxWidth [expr {$maxWidth<6?6:$maxWidth}] |
| set colorList [list \ |
| red [mc "&Red"] \ |
| green [mc "&Green"] \ |
| blue [mc "&Blue"] \ |
| ] |
| foreach {color l} $colorList { |
| # each f frame contains an [R|G|B] entry and the equiv. color strip. |
| set f [frame $stripsFrame.$color] |
| |
| # The box frame contains the label and entry widget for an [R|G|B] |
| set box [frame $f.box] |
| |
| bind [::tk::AmpWidget label $box.label -text $l: -width $maxWidth \ |
| -anchor ne] <<AltUnderlined>> [list focus $box.entry] |
| |
| entry $box.entry -textvariable \ |
| ::tk::dialog::color::[winfo name $w]($color,intensity) \ |
| -width 4 |
| pack $box.label -side left -fill y -padx 2 -pady 3 |
| pack $box.entry -side left -anchor n -pady 0 |
| pack $box -side left -fill both |
| |
| set height [expr \ |
| {[winfo reqheight $box.entry] - \ |
| 2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}] |
| |
| canvas $f.color -height $height\ |
| -width $data(BARS_WIDTH) -relief sunken -bd 2 |
| canvas $f.sel -height $data(PLGN_HEIGHT) \ |
| -width $data(canvasWidth) -highlightthickness 0 |
| pack $f.color -expand yes -fill both |
| pack $f.sel -expand yes -fill both |
| |
| pack $f -side top -fill x -padx 0 -pady 2 |
| |
| set data($color,entry) $box.entry |
| set data($color,col) $f.color |
| set data($color,sel) $f.sel |
| |
| bind $data($color,col) <Configure> \ |
| [list tk::dialog::color::DrawColorScale $w $color 1] |
| bind $data($color,col) <Enter> \ |
| [list tk::dialog::color::EnterColorBar $w $color] |
| bind $data($color,col) <Leave> \ |
| [list tk::dialog::color::LeaveColorBar $w $color] |
| |
| bind $data($color,sel) <Enter> \ |
| [list tk::dialog::color::EnterColorBar $w $color] |
| bind $data($color,sel) <Leave> \ |
| [list tk::dialog::color::LeaveColorBar $w $color] |
| |
| bind $box.entry <Return> [list tk::dialog::color::HandleRGBEntry $w] |
| } |
| |
| pack $stripsFrame -side left -fill both -padx 4 -pady 10 |
| |
| # The selFrame contains a frame that demonstrates the currently |
| # selected color |
| # |
| set selFrame [frame $topFrame.sel] |
| set lab [::tk::AmpWidget label $selFrame.lab -text [mc "&Selection:"] \ |
| -anchor sw] |
| set ent [entry $selFrame.ent \ |
| -textvariable ::tk::dialog::color::[winfo name $w](selection) \ |
| -width 16] |
| set f1 [frame $selFrame.f1 -relief sunken -bd 2] |
| set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70] |
| |
| pack $lab $ent -side top -fill x -padx 4 -pady 2 |
| pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10 |
| pack $data(finalCanvas) -expand yes -fill both |
| |
| bind $ent <Return> [list tk::dialog::color::HandleSelEntry $w] |
| |
| pack $selFrame -side left -fill none -anchor nw |
| pack $topFrame -side top -expand yes -fill both -anchor nw |
| |
| # the botFrame frame contains the buttons |
| # |
| set botFrame [frame $w.bot -relief raised -bd 1] |
| set maxWidth [::tk::mcmaxamp &OK &Cancel] |
| set maxWidth [expr {$maxWidth<8?8:$maxWidth}] |
| ::tk::AmpWidget button $botFrame.ok -text [mc "&OK"] \ |
| -width $maxWidth \ |
| -command [list tk::dialog::color::OkCmd $w] |
| ::tk::AmpWidget button $botFrame.cancel -text [mc "&Cancel"] \ |
| -width $maxWidth \ |
| -command [list tk::dialog::color::CancelCmd $w] |
| |
| set data(okBtn) $botFrame.ok |
| set data(cancelBtn) $botFrame.cancel |
| |
| pack $botFrame.ok $botFrame.cancel \ |
| -padx 10 -pady 10 -expand yes -side left |
| pack $botFrame -side bottom -fill x |
| |
| |
| # Accelerator bindings |
| bind $lab <<AltUnderlined>> [list focus $ent] |
| bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)] |
| bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A] |
| |
| wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w] |
| } |
| |
| # ::tk::dialog::color::SetRGBValue -- |
| # |
| # Sets the current selection of the dialog box |
| # |
| proc ::tk::dialog::color::SetRGBValue {w color} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| set data(red,intensity) [lindex $color 0] |
| set data(green,intensity) [lindex $color 1] |
| set data(blue,intensity) [lindex $color 2] |
| |
| RedrawColorBars $w all |
| |
| # Now compute the new x value of each colorbars pointer polygon |
| foreach color [list red green blue ] { |
| set x [RgbToX $w $data($color,intensity)] |
| MoveSelector $w $data($color,sel) $color $x 0 |
| } |
| } |
| |
| # ::tk::dialog::color::XToRgb -- |
| # |
| # Converts a screen coordinate to intensity |
| # |
| proc ::tk::dialog::color::XToRgb {w x} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| set x [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}] |
| if {$x > 255} { set x 255 } |
| return $x |
| } |
| |
| # ::tk::dialog::color::RgbToX |
| # |
| # Converts an intensity to screen coordinate. |
| # |
| proc ::tk::dialog::color::RgbToX {w color} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}] |
| } |
| |
| |
| # ::tk::dialog::color::DrawColorScale -- |
| # |
| # Draw color scale is called whenever the size of one of the color |
| # scale canvases is changed. |
| # |
| proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| # col: color bar canvas |
| # sel: selector canvas |
| set col $data($c,col) |
| set sel $data($c,sel) |
| |
| # First handle the case that we are creating everything for the first time. |
| if {$create} { |
| # First remove all the lines that already exist. |
| if { $data(lines,$c,last) > $data(lines,$c,start)} { |
| for {set i $data(lines,$c,start)} \ |
| {$i <= $data(lines,$c,last)} { incr i} { |
| $sel delete $i |
| } |
| } |
| # Delete the selector if it exists |
| if {[info exists data($c,index)]} { |
| $sel delete $data($c,index) |
| } |
| |
| # Draw the selection polygons |
| CreateSelector $w $sel $c |
| $sel bind $data($c,index) <ButtonPress-1> \ |
| [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1] |
| $sel bind $data($c,index) <B1-Motion> \ |
| [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)] |
| $sel bind $data($c,index) <ButtonRelease-1> \ |
| [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)] |
| |
| set height [winfo height $col] |
| # Create an invisible region under the colorstrip to catch mouse clicks |
| # that aren't on the selector. |
| set data($c,clickRegion) [$sel create rectangle 0 0 \ |
| $data(canvasWidth) $height -fill {} -outline {}] |
| |
| bind $col <ButtonPress-1> \ |
| [list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)] |
| bind $col <B1-Motion> \ |
| [list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)] |
| bind $col <ButtonRelease-1> \ |
| [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)] |
| |
| $sel bind $data($c,clickRegion) <ButtonPress-1> \ |
| [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)] |
| $sel bind $data($c,clickRegion) <B1-Motion> \ |
| [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)] |
| $sel bind $data($c,clickRegion) <ButtonRelease-1> \ |
| [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)] |
| } else { |
| # l is the canvas index of the first colorbar. |
| set l $data(lines,$c,start) |
| } |
| |
| # Draw the color bars. |
| set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}] |
| for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} { |
| set intensity [expr {$i * $data(intensityIncr)}] |
| set startx [expr {$i * $data(colorbarWidth) + $highlightW}] |
| if {[string equal $c "red"]} { |
| set color [format "#%02x%02x%02x" \ |
| $intensity \ |
| $data(green,intensity) \ |
| $data(blue,intensity)] |
| } elseif {[string equal $c "green"]} { |
| set color [format "#%02x%02x%02x" \ |
| $data(red,intensity) \ |
| $intensity \ |
| $data(blue,intensity)] |
| } else { |
| set color [format "#%02x%02x%02x" \ |
| $data(red,intensity) \ |
| $data(green,intensity) \ |
| $intensity] |
| } |
| |
| if {$create} { |
| set index [$col create rect $startx $highlightW \ |
| [expr {$startx +$data(colorbarWidth)}] \ |
| [expr {[winfo height $col] + $highlightW}]\ |
| -fill $color -outline $color] |
| } else { |
| $col itemconfigure $l -fill $color -outline $color |
| incr l |
| } |
| } |
| $sel raise $data($c,index) |
| |
| if {$create} { |
| set data(lines,$c,last) $index |
| set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}] |
| } |
| |
| RedrawFinalColor $w |
| } |
| |
| # ::tk::dialog::color::CreateSelector -- |
| # |
| # Creates and draws the selector polygon at the position |
| # $data($c,intensity). |
| # |
| proc ::tk::dialog::color::CreateSelector {w sel c } { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| set data($c,index) [$sel create polygon \ |
| 0 $data(PLGN_HEIGHT) \ |
| $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \ |
| $data(indent) 0] |
| set data($c,x) [RgbToX $w $data($c,intensity)] |
| $sel move $data($c,index) $data($c,x) 0 |
| } |
| |
| # ::tk::dialog::color::RedrawFinalColor |
| # |
| # Combines the intensities of the three colors into the final color |
| # |
| proc ::tk::dialog::color::RedrawFinalColor {w} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| set color [format "#%02x%02x%02x" $data(red,intensity) \ |
| $data(green,intensity) $data(blue,intensity)] |
| |
| $data(finalCanvas) configure -bg $color |
| set data(finalColor) $color |
| set data(selection) $color |
| set data(finalRGB) [list \ |
| $data(red,intensity) \ |
| $data(green,intensity) \ |
| $data(blue,intensity)] |
| } |
| |
| # ::tk::dialog::color::RedrawColorBars -- |
| # |
| # Only redraws the colors on the color strips that were not manipulated. |
| # Params: color of colorstrip that changed. If color is not [red|green|blue] |
| # Then all colorstrips will be updated |
| # |
| proc ::tk::dialog::color::RedrawColorBars {w colorChanged} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| switch $colorChanged { |
| red { |
| DrawColorScale $w green |
| DrawColorScale $w blue |
| } |
| green { |
| DrawColorScale $w red |
| DrawColorScale $w blue |
| } |
| blue { |
| DrawColorScale $w red |
| DrawColorScale $w green |
| } |
| default { |
| DrawColorScale $w red |
| DrawColorScale $w green |
| DrawColorScale $w blue |
| } |
| } |
| RedrawFinalColor $w |
| } |
| |
| #---------------------------------------------------------------------- |
| # Event handlers |
| #---------------------------------------------------------------------- |
| |
| # ::tk::dialog::color::StartMove -- |
| # |
| # Handles a mousedown button event over the selector polygon. |
| # Adds the bindings for moving the mouse while the button is |
| # pressed. Sets the binding for the button-release event. |
| # |
| # Params: sel is the selector canvas window, color is the color of the strip. |
| # |
| proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| if {!$dontMove} { |
| MoveSelector $w $sel $color $x $delta |
| } |
| } |
| |
| # ::tk::dialog::color::MoveSelector -- |
| # |
| # Moves the polygon selector so that its middle point has the same |
| # x value as the specified x. If x is outside the bounds [0,255], |
| # the selector is set to the closest endpoint. |
| # |
| # Params: sel is the selector canvas, c is [red|green|blue] |
| # x is a x-coordinate. |
| # |
| proc ::tk::dialog::color::MoveSelector {w sel color x delta} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| incr x -$delta |
| |
| if { $x < 0 } { |
| set x 0 |
| } elseif { $x > $data(BARS_WIDTH)} { |
| set x $data(BARS_WIDTH) |
| } |
| set diff [expr {$x - $data($color,x)}] |
| $sel move $data($color,index) $diff 0 |
| set data($color,x) [expr {$data($color,x) + $diff}] |
| |
| # Return the x value that it was actually set at |
| return $x |
| } |
| |
| # ::tk::dialog::color::ReleaseMouse |
| # |
| # Removes mouse tracking bindings, updates the colorbars. |
| # |
| # Params: sel is the selector canvas, color is the color of the strip, |
| # x is the x-coord of the mouse. |
| # |
| proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| set x [MoveSelector $w $sel $color $x $delta] |
| |
| # Determine exactly what color we are looking at. |
| set data($color,intensity) [XToRgb $w $x] |
| |
| RedrawColorBars $w $color |
| } |
| |
| # ::tk::dialog::color::ResizeColorbars -- |
| # |
| # Completely redraws the colorbars, including resizing the |
| # colorstrips |
| # |
| proc ::tk::dialog::color::ResizeColorBars {w} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || |
| (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} { |
| set data(BARS_WIDTH) $data(NUM_COLORBARS) |
| } |
| InitValues [winfo name $w] |
| foreach color [list red green blue ] { |
| $data($color,col) configure -width $data(canvasWidth) |
| DrawColorScale $w $color 1 |
| } |
| } |
| |
| # ::tk::dialog::color::HandleSelEntry -- |
| # |
| # Handles the return keypress event in the "Selection:" entry |
| # |
| proc ::tk::dialog::color::HandleSelEntry {w} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| set text [string trim $data(selection)] |
| # Check to make sure that the color is valid |
| if {[catch {set color [winfo rgb . $text]} ]} { |
| set data(selection) $data(finalColor) |
| return |
| } |
| |
| set R [expr {[lindex $color 0]/0x100}] |
| set G [expr {[lindex $color 1]/0x100}] |
| set B [expr {[lindex $color 2]/0x100}] |
| |
| SetRGBValue $w "$R $G $B" |
| set data(selection) $text |
| } |
| |
| # ::tk::dialog::color::HandleRGBEntry -- |
| # |
| # Handles the return keypress event in the R, G or B entry |
| # |
| proc ::tk::dialog::color::HandleRGBEntry {w} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| foreach c [list red green blue] { |
| if {[catch { |
| set data($c,intensity) [expr {int($data($c,intensity))}] |
| }]} { |
| set data($c,intensity) 0 |
| } |
| |
| if {$data($c,intensity) < 0} { |
| set data($c,intensity) 0 |
| } |
| if {$data($c,intensity) > 255} { |
| set data($c,intensity) 255 |
| } |
| } |
| |
| SetRGBValue $w "$data(red,intensity) \ |
| $data(green,intensity) $data(blue,intensity)" |
| } |
| |
| # mouse cursor enters a color bar |
| # |
| proc ::tk::dialog::color::EnterColorBar {w color} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| $data($color,sel) itemconfig $data($color,index) -fill red |
| } |
| |
| # mouse leaves enters a color bar |
| # |
| proc ::tk::dialog::color::LeaveColorBar {w color} { |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| $data($color,sel) itemconfig $data($color,index) -fill black |
| } |
| |
| # user hits OK button |
| # |
| proc ::tk::dialog::color::OkCmd {w} { |
| variable ::tk::Priv |
| upvar ::tk::dialog::color::[winfo name $w] data |
| |
| set Priv(selectColor) $data(finalColor) |
| } |
| |
| # user hits Cancel button |
| # |
| proc ::tk::dialog::color::CancelCmd {w} { |
| variable ::tk::Priv |
| set Priv(selectColor) "" |
| } |
| |