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