Return to mkIcon.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tk / library / demos

Annotation of micropolis/src/tk/library/demos/mkIcon.tcl, revision 1.1

1.1     ! root        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: 
        !             9: proc 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: 
        !            35: proc 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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.