git.zerfleddert.de Git - micropolis/blob - src/tk/library/demos/mkIcon.tcl

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.

9 proc mkIcon {{w .icon}} {

10 global tk_library

     catch {destroy $w}

12 toplevel $w

13 dpos $w

14 wm title $w "Iconic Button Demonstration"

15 wm iconname $w "Icons"

     message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 300 \

             -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."

     frame $w.frame -borderwidth 10

19 pack append $w.frame \

         [button $w.frame.b1 -bitmap @$tk_library/demos/bitmaps/flagdown  \

                 -command "iconCmd $w.frame.b1"] {left expand} \

         [frame $w.frame.right] {left expand}

     radiobutton $w.frame.right.b2 -bitmap @$tk_library/demos/bitmaps/letters \

24 -variable letters

     radiobutton $w.frame.right.b3 -bitmap @$tk_library/demos/bitmaps/noletters \

26 -variable letters

     pack append $w.frame.right $w.frame.right.b2 {top expand} \

28 $w.frame.right.b3 {top expand}

     button $w.ok -text OK -command "destroy $w"

     pack append $w $w.msg {top frame c} $w.frame {top expand fill} \

32 $w.ok {bottom fill}

33 }

35 proc iconCmd {w} {

36 global tk_library

     set bitmap [lindex [$w config -bitmap] 4]

     if {$bitmap == "@$tk_library/demos/bitmaps/flagdown"} {

         $w config -bitmap @$tk_library/demos/bitmaps/flagup

40 } else {

         $w config -bitmap @$tk_library/demos/bitmaps/flagdown

42 }

43 }