clrpick.tcl 21 KB

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