clrpick.tcl

genesis 2000 v9.1软件下载

# tkColorDialog_RgbToX
#
#	Converts an intensity to screen coordinate.
#
proc tkColorDialog_RgbToX {w color} {
    upvar #0 $w data
    
    return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
}


# tkColorDialog_DrawColorScale --
# 
#	Draw color scale is called whenever the size of one of the color
#	scale canvases is changed.
#
proc tkColorDialog_DrawColorScale {w c {create 0}} {
    global lines
    upvar #0 $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
	tkColorDialog_CreateSelector $w $sel $c
	$sel bind $data($c,index) <ButtonPress-1> \
	    "tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1"
	$sel bind $data($c,index) <B1-Motion> \
	    "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
	$sel bind $data($c,index) <ButtonRelease-1> \
	    "tkColorDialog_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> \
	    "tkColorDialog_StartMove $w $sel $c %x $data(colorPad)"
	bind $col <B1-Motion> \
	    "tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)"
	bind $col <ButtonRelease-1> \
	    "tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)"

	$sel bind $data($c,clickRegion) <ButtonPress-1> \
	    "tkColorDialog_StartMove $w $sel $c %x $data(selPad)"
	$sel bind $data($c,clickRegion) <B1-Motion> \
	    "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
	$sel bind $data($c,clickRegion) <ButtonRelease-1> \
	    "tkColorDialog_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 == "red" } {
	    set color [format "#%02x%02x%02x" \
			   $intensity \
			   $data(green,intensity) \
			   $data(blue,intensity)]
	} elseif { $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 itemconf $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}]
    }

    tkColorDialog_RedrawFinalColor $w
}

# tkColorDialog_CreateSelector --
#
#	Creates and draws the selector polygon at the position
#	$data($c,intensity).
#
proc tkColorDialog_CreateSelector {w sel c } {
    upvar #0 $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) [tkColorDialog_RgbToX $w $data($c,intensity)]
    $sel move $data($c,index) $data($c,x) 0
}

# tkColorDialog_RedrawFinalColor
#
#	Combines the intensities of the three colors into the final color
#
proc tkColorDialog_RedrawFinalColor {w} {
    upvar #0 $w data

    set color [format "#%02x%02x%02x" $data(red,intensity) \
	$data(green,intensity) $data(blue,intensity)]
    
    $data(finalCanvas) conf -bg $color
    set data(finalColor) $color
    set data(selection) $color
    set data(finalRGB) [list \
	$data(red,intensity) \
	$data(green,intensity) \
	$data(blue,intensity)]
}

# tkColorDialog_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 tkColorDialog_RedrawColorBars {w colorChanged} {
    upvar #0 $w data

    switch $colorChanged {
	red { 
	    tkColorDialog_DrawColorScale $w green
	    tkColorDialog_DrawColorScale $w blue
	}
	green {
	    tkColorDialog_DrawColorScale $w red
	    tkColorDialog_DrawColorScale $w blue
	}
	blue {
	    tkColorDialog_DrawColorScale $w red
	    tkColorDialog_DrawColorScale $w green
	}
	default {
	    tkColorDialog_DrawColorScale $w red
	    tkColorDialog_DrawColorScale $w green
	    tkColorDialog_DrawColorScale $w blue
	}
    }
    tkColorDialog_RedrawFinalColor $w
}

#----------------------------------------------------------------------
#			Event handlers
#----------------------------------------------------------------------

# tkColorDialog_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 tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {
    upvar #0 $w data

    if {!$dontMove} {
	tkColorDialog_MoveSelector $w $sel $color $x $delta
    }
}

# tkColorDialog_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 tkColorDialog_MoveSelector {w sel color x delta} {
    upvar #0 $w data

    incr x -$delta

    if { $x < 0 } {
	set x 0
    } elseif { $x >= $data(BARS_WIDTH)} {
	set x [expr {$data(BARS_WIDTH) - 1}]
    }
    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
}

# tkColorDialog_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 tkColorDialog_ReleaseMouse {w sel color x delta} {
    upvar #0 $w data 

    set x [tkColorDialog_MoveSelector $w $sel $color $x $delta]
    
    # Determine exactly what color we are looking at.
    set data($color,intensity) [tkColorDialog_XToRgb $w $x]

    tkColorDialog_RedrawColorBars $w $color
}

# tkColorDialog_ResizeColorbars --
#
#	Completely redraws the colorbars, including resizing the
#	colorstrips
#
proc tkColorDialog_ResizeColorBars {w} {
    upvar #0 $w data
    
    if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || 
	 (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {
	set data(BARS_WIDTH) $data(NUM_COLORBARS)
    }
    tkColorDialog_InitValues $w
    foreach color { red green blue } {
	$data($color,col) conf -width $data(canvasWidth)
	tkColorDialog_DrawColorScale $w $color 1
    }
}

# tkColorDialog_HandleSelEntry --
#
#	Handles the return keypress event in the "Selection:" entry
#
proc tkColorDialog_HandleSelEntry {w} {
    upvar #0 $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}]

    tkColorDialog_SetRGBValue $w "$R $G $B"
    set data(selection) $text
}

# tkColorDialog_HandleRGBEntry --
#
#	Handles the return keypress event in the R, G or B entry
#
proc tkColorDialog_HandleRGBEntry {w} {
    upvar #0 $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
	}
    }

    tkColorDialog_SetRGBValue $w "$data(red,intensity) $data(green,intensity) \
	$data(blue,intensity)"
}    

# mouse cursor enters a color bar
#
proc tkColorDialog_EnterColorBar {w color} {
    upvar #0 $w data

    $data($color,sel) itemconfig $data($color,index) -fill red
}

# mouse leaves enters a color bar
#
proc tkColorDialog_LeaveColorBar {w color} {
    upvar #0 $w data

    $data($color,sel) itemconfig $data($color,index) -fill black
}

# user hits OK button
#
proc tkColorDialog_OkCmd {w} {
    global tkPriv
    upvar #0 $w data

    set tkPriv(selectColor) $data(finalColor)
}

# user hits Cancel button
#
proc tkColorDialog_CancelCmd {w} {
    global tkPriv

    set tkPriv(selectColor) ""
}