diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2009-02-11 15:17:08 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2009-02-11 15:17:08 (GMT) |
| commit | 268cab3d247deaabe130d87d6869a8e2d222cf7a (patch) | |
| tree | 31e87d9de38d80f60494b3c1f7300e75bda0ba53 /library/demos/items.tcl | |
| parent | 1aed94c9ad7ed6440eb8d1d3404b28d7368738eb (diff) | |
| download | tk-268cab3d247deaabe130d87d6869a8e2d222cf7a.zip tk-268cab3d247deaabe130d87d6869a8e2d222cf7a.tar.gz tk-268cab3d247deaabe130d87d6869a8e2d222cf7a.tar.bz2 | |
Use a color picture of JO for better GOOBE. [Bug 2588919]
Diffstat (limited to 'library/demos/items.tcl')
| -rw-r--r-- | library/demos/items.tcl | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/library/demos/items.tcl b/library/demos/items.tcl index 84d26ac..0a5d7fa 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas that displays the # canvas item types. # -# RCS: @(#) $Id: items.tcl,v 1.9 2008/11/22 22:38:52 dkf Exp $ +# RCS: @(#) $Id: items.tcl,v 1.10 2009/02/11 15:17:25 dkf Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -142,9 +142,13 @@ $c create arc 0.5c 20c 9.5c 24c -width 4m -style pieslice \ $c create arc 5.5c 20.5c 9.5c 23.5c -width 4m -style chord \ -fill $blue -outline {} -start 45 -extent 270 -tags item -$c create text 15c 16.2c -text Bitmaps -anchor n -$c create bitmap 13c 20c -tags item \ - -bitmap @[file join $tk_demoDirectory images face.xbm] +image create photo items.ousterhout \ + -file [file join $tk_demoDirectory images ouster.png] +image create photo items.ousterhout.active -format "png -alpha 0.5" \ + -file [file join $tk_demoDirectory images ouster.png] +$c create text 15c 16.2c -text "Bitmaps and Images" -anchor n +$c create image 13c 20c -tags item -image items.ousterhout \ + -activeimage items.ousterhout.active $c create bitmap 17c 18.5c -tags item \ -bitmap @[file join $tk_demoDirectory images noletter.xbm] $c create bitmap 17c 21.5c -tags item \ @@ -185,15 +189,18 @@ proc itemEnter {c} { return } set type [$c type current] - if {$type == "window"} { + if {$type == "window" || $type == "image"} { set restoreCmd {} return - } - if {$type == "bitmap"} { + } elseif {$type == "bitmap"} { set bg [lindex [$c itemconf current -background] 4] set restoreCmd [list $c itemconfig current -background $bg] $c itemconfig current -background SteelBlue2 return + } elseif {$type == "image"} { + set restoreCmd [list $c itemconfig current -state normal] + $c itemconfig current -state active + return } set fill [lindex [$c itemconfig current -fill] 4] if {(($type == "rectangle") || ($type == "oval") || ($type == "arc")) |