> [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) \
[list tk::dialog::color::DrawColorScale $w $color 1]
bind $data($color,col) \
[list tk::dialog::color::EnterColorBar $w $color]
bind $data($color,col) \
[list tk::dialog::color::LeaveColorBar $w $color]
bind $data($color,sel) \
[list tk::dialog::color::EnterColorBar $w $color]
bind $data($color,sel) \
[list tk::dialog::color::LeaveColorBar $w $color]
bind $box.entry [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 [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]
::tk::AmpWidget button $botFrame.ok -text [mc "&OK"] \
-command [list tk::dialog::color::OkCmd $w]
::tk::AmpWidget button $botFrame.cancel -text [mc "&Cancel"] \
-command [list tk::dialog::color::CancelCmd $w]
set data(okBtn) $botFrame.ok
set data(cancelBtn) $botFrame.cancel
grid x $botFrame.ok x $botFrame.cancel x -sticky ew
grid configure $botFrame.ok $botFrame.cancel -padx 10 -pady 10
grid columnconfigure $botFrame {0 4} -weight 1 -uniform space
grid columnconfigure $botFrame {1 3} -weight 1 -uniform button
grid columnconfigure $botFrame 2 -weight 2 -uniform space
pack $botFrame -side bottom -fill x
# Accelerator bindings
bind $lab <> [list focus $ent]
bind $w [list tk::ButtonInvoke $data(cancelBtn)]
bind $w [list tk::AltKeyInDialog $w %A]
wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w]
bind $lab [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 {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) \
[list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1]
$sel bind $data($c,index) \
[list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
$sel bind $data($c,index) \
[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 \
[list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)]
bind $col \
[list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)]
bind $col \
[list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)]
$sel bind $data($c,clickRegion) \
[list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)]
$sel bind $data($c,clickRegion) \
[list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
$sel bind $data($c,clickRegion) \
[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 {$c eq "red"} {
set color [format "#%02x%02x%02x" \
$intensity $data(green,intensity) $data(blue,intensity)]
} elseif {$c eq "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)
} then {
set data(BARS_WIDTH) $data(NUM_COLORBARS)
}
InitValues [winfo name $w]
foreach color {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 {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) itemconfigure $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) itemconfigure $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 or destroys window
#
proc ::tk::dialog::color::CancelCmd {w} {
variable ::tk::Priv
set Priv(selectColor) ""
}