diff options
author | dgp <dgp@users.sourceforge.net> | 2006-01-25 18:22:04 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2006-01-25 18:22:04 (GMT) |
commit | 339966aea87195faf678c05a06895a0a2f9c65af (patch) | |
tree | 80bb0c008e169df663722d227f5f24bc18665bac /library/palette.tcl | |
parent | f59975d6eb39f7419c93e45392bab264f83ac352 (diff) | |
download | tk-339966aea87195faf678c05a06895a0a2f9c65af.zip tk-339966aea87195faf678c05a06895a0a2f9c65af.tar.gz tk-339966aea87195faf678c05a06895a0a2f9c65af.tar.bz2 |
* library/bgerror.tcl: Updates to use Tcl 8.4 features. [Patch 1237759] * library/choosedir.tcl:
* library/comdlg.tcl:
* library/console.tcl:
* library/dialog.tcl:
* library/focus.tcl:
* library/msgbox.tcl:
* library/palette.tcl:
* library/tk.tcl:
* library/tkfbox.tcl:
* library/xmfbox.tcl:
Diffstat (limited to 'library/palette.tcl')
-rw-r--r-- | library/palette.tcl | 22 |
1 files changed, 12 insertions, 10 deletions
diff --git a/library/palette.tcl b/library/palette.tcl index 0ec5b94..6e380d8 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -3,7 +3,7 @@ # This file contains procedures that change the color palette used # by Tk. # -# RCS: @(#) $Id: palette.tcl,v 1.9 2005/07/25 09:06:00 dkf Exp $ +# RCS: @(#) $Id: palette.tcl,v 1.10 2006/01/25 18:22:04 dgp Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # @@ -52,9 +52,11 @@ proc ::tk_setPalette {args} { set new(foreground) white } } - set fg [winfo rgb . $new(foreground)] - set darkerBg [format #%02x%02x%02x [expr {(9*[lindex $bg 0])/2560}] \ - [expr {(9*[lindex $bg 1])/2560}] [expr {(9*[lindex $bg 2])/2560}]] + lassign [winfo rgb . $new(foreground)] fg_r fg_g fg_b + lassign $bg bg_r bg_g bg_b + set darkerBg [format #%02x%02x%02x [expr {(9*$bg_r)/2560}] \ + [expr {(9*$bg_g)/2560}] [expr {(9*$bg_b)/2560}]] + foreach i {activeForeground insertBackground selectForeground \ highlightColor} { if {![info exists new($i)]} { @@ -63,9 +65,9 @@ proc ::tk_setPalette {args} { } if {![info exists new(disabledForeground)]} { set new(disabledForeground) [format #%02x%02x%02x \ - [expr {(3*[lindex $bg 0] + [lindex $fg 0])/1024}] \ - [expr {(3*[lindex $bg 1] + [lindex $fg 1])/1024}] \ - [expr {(3*[lindex $bg 2] + [lindex $fg 2])/1024}]] + [expr {(3*$bg_r + $fg_r)/1024}] \ + [expr {(3*$bg_g + $fg_g)/1024}] \ + [expr {(3*$bg_b + $fg_b)/1024}]] } if {![info exists new(highlightBackground)]} { set new(highlightBackground) $new(background) @@ -76,8 +78,8 @@ proc ::tk_setPalette {args} { # up by 15% or 1/3 of the way to full white, whichever is # greater. - foreach i {0 1 2} { - set light($i) [expr {[lindex $bg $i]/256}] + foreach i {0 1 2} color $bg { + set light($i) [expr {$color/256}] set inc1 [expr {($light($i)*15)/100}] set inc2 [expr {(255-$light($i))/3}] if {$inc1 > $inc2} { @@ -128,7 +130,7 @@ proc ::tk_setPalette {args} { eval [tk::RecolorTree . new] - catch {destroy .___tk_set_palette} + destroy .___tk_set_palette # Change the option database so that future windows will get the # same colors. |