#268 A progress indicator using tcl/tk.

# Create a simple progress gauge set, initially set to 0%
proc gaugeCreate {win {color "gray"} } {
    frame $win
    canvas $win.display \
        -borderwidth 0 \
        -background white \
        -highlightthickness 0 \
        -width 200 \
        -height 20

   pack $win.display -expand yes
   $win.display create rectangle 0 0 0 20 \
        -outline "" \
        -fill $color  \
        -tags bar
   $win.display create text 100 10 \
        -anchor c \
        -font {-size 14} \
        -text "0%" \
        -tags value 
   return $win
}

# Given a gauge, set it to a certain percentage
proc gaugeValue {win val} {
puts "$win $val"
update
    if {$val < 0 || $val > 100} {
        error "bad value \"$val\": should be 0-100"
    }
    set msg [format "%3.0f%%" $val]
    $win.display itemconfigure value -text $msg

    set w [expr 0.01 * $val * [winfo width $win.display]]
    set h [winfo height $win.display]
    $win.display coords bar 0 0 $w $h
}

# Lets test it. 
# This routine calls itself every 100ms until 100% is reached
proc gaugeIncrement {win value} {
    if {$value <= 100} {
        gaugeValue $win $value
        after 100 "gaugeIncrement $win [incr value]"
    }
}

pack [gaugeCreate .gauge]
gaugeIncrement .gauge 1

Discover more from Tips and Hints for Aerospace Engineers

Subscribe now to keep reading and get access to the full archive.

Continue reading