Tk Source Code

Check-in [228b1c83]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix [98c41cf3e7]: ::tk::Darken does not properly brighten colors
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256: 228b1c8371997b8f03bdb594a16053cbbcc779864c4dc894cbf394e48e1201b1
User & Date: fvogel 2018-05-03 20:25:46
Context
2018-05-03
20:28
Fix [75d38f8608]: touchpad two finger scroll does not work correctly with listbox on Windows check-in: 1fdcf6f5 user: fvogel tags: core-8-6-branch
20:26
Fix [98c41cf3e7]: ::tk::Darken does not properly brighten colors check-in: 4e7eee43 user: fvogel tags: trunk
20:25
Fix [98c41cf3e7]: ::tk::Darken does not properly brighten colors check-in: 228b1c83 user: fvogel tags: core-8-6-branch
2018-04-30
15:53
Fix [6d5042069f]: tk inactive does not work on macOS (tk-6.5 fails) check-in: adb7926c user: culler tags: core-8-6-branch
2018-04-28
07:38
Fix [98c41cf3e7]: ::tk::Darken does not properly brighten colors Closed-Leaf check-in: 48cc00a1 user: fvogel tags: bug-98c41cf3e7
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to library/palette.tcl.

201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
# ::tk::Darken --
# Given a color name, computes a new color value that darkens (or
# brightens) the given color by a given percent.
#
# Arguments:
# color -	Name of starting color.
# perecent -	Integer telling how much to brighten or darken as a
#		percent: 50 means darken by 50%, 110 means brighten
#		by 10%.

proc ::tk::Darken {color percent} {
    foreach {red green blue} [winfo rgb . $color] {
	set red [expr {($red/256)*$percent/100}]
	set green [expr {($green/256)*$percent/100}]
	set blue [expr {($blue/256)*$percent/100}]
	break
    }
    if {$red > 255} {
	set red 255
    }
    if {$green > 255} {
	set green 255
    }
    if {$blue > 255} {
	set blue 255
    }
    return [format "#%02x%02x%02x" $red $green $blue]
}

# ::tk_bisque --
# Reset the Tk color palette to the old "bisque" colors.
#
# Arguments:
# None.






|




|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
# ::tk::Darken --
# Given a color name, computes a new color value that darkens (or
# brightens) the given color by a given percent.
#
# Arguments:
# color -	Name of starting color.
# percent -	Integer telling how much to brighten or darken as a
#		percent: 50 means darken by 50%, 110 means brighten
#		by 10%.

proc ::tk::Darken {color percent} {
    if {$percent < 0} {
        return #000000
    } elseif {$percent > 200} {
        return #ffffff
    } elseif {$percent <= 100} {
        lassign [winfo rgb . $color] r g b
        set r [expr {($r/256)*$percent/100}]
        set g [expr {($g/256)*$percent/100}]
        set b [expr {($b/256)*$percent/100}]
    } elseif {$percent > 100} {
        lassign [winfo rgb . $color] r g b
        set r [expr {255 - ((65535-$r)/256)*(200-$percent)/100}]
        set g [expr {255 - ((65535-$g)/256)*(200-$percent)/100}]
        set b [expr {255 - ((65535-$b)/256)*(200-$percent)/100}]
    }
    return [format #%02x%02x%02x $r $g $b]
}

# ::tk_bisque --
# Reset the Tk color palette to the old "bisque" colors.
#
# Arguments:
# None.