]> git.zerfleddert.de Git - micropolis/blame_incremental - src/tk/library/demos/mkIcon.tcl
let bundled tcl compile with recent tools
[micropolis] / src / tk / library / demos / mkIcon.tcl
... / ...
CommitLineData
1# mkIcon w
2#
3# Create a top-level window that displays a bunch of iconic
4# buttons.
5#
6# Arguments:
7# w - Name to use for new top-level window.
8
9proc mkIcon {{w .icon}} {
10 global tk_library
11 catch {destroy $w}
12 toplevel $w
13 dpos $w
14 wm title $w "Iconic Button Demonstration"
15 wm iconname $w "Icons"
16 message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \
17 -text "This window shows three buttons that display bitmaps instead of text. On the left is a regular button, which changes its bitmap when you click on it. On the right are two radio buttons. Click the \"OK\" button when you're done."
18 frame $w.frame -borderwidth 10
19 pack append $w.frame \
20 [button $w.frame.b1 -bitmap @$tk_library/demos/bitmaps/flagdown \
21 -command "iconCmd $w.frame.b1"] {left expand} \
22 [frame $w.frame.right] {left expand}
23 radiobutton $w.frame.right.b2 -bitmap @$tk_library/demos/bitmaps/letters \
24 -variable letters
25 radiobutton $w.frame.right.b3 -bitmap @$tk_library/demos/bitmaps/noletters \
26 -variable letters
27 pack append $w.frame.right $w.frame.right.b2 {top expand} \
28 $w.frame.right.b3 {top expand}
29 button $w.ok -text OK -command "destroy $w"
30
31 pack append $w $w.msg {top frame c} $w.frame {top expand fill} \
32 $w.ok {bottom fill}
33}
34
35proc iconCmd {w} {
36 global tk_library
37 set bitmap [lindex [$w config -bitmap] 4]
38 if {$bitmap == "@$tk_library/demos/bitmaps/flagdown"} {
39 $w config -bitmap @$tk_library/demos/bitmaps/flagup
40 } else {
41 $w config -bitmap @$tk_library/demos/bitmaps/flagdown
42 }
43}
Impressum, Datenschutz