home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / bwidget1.3.0 / progressbar.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  7.1 KB  |  199 lines
  1. # ------------------------------------------------------------------------------
  2. #  progressbar.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. # ------------------------------------------------------------------------------
  5. #  Index of commands:
  6. #     - ProgressBar::create
  7. #     - ProgressBar::configure
  8. #     - ProgressBar::cget
  9. #     - ProgressBar::_destroy
  10. #     - ProgressBar::_modify
  11. # ------------------------------------------------------------------------------
  12.  
  13. namespace eval ProgressBar {
  14.     Widget::declare ProgressBar {
  15.         {-type        Enum       normal     0 {normal incremental infinite}}
  16.         {-maximum     Int        100        0 "%d >= 0"}
  17.         {-background  TkResource ""         0 frame}
  18.         {-foreground  TkResource blue       0 label}
  19.         {-borderwidth TkResource 2          0 frame}
  20.         {-troughcolor TkResource ""         0 scrollbar}
  21.         {-relief      TkResource sunken     0 label}
  22.         {-orient      Enum       horizontal 1 {horizontal vertical}}
  23.         {-variable    String     ""         0}
  24.         {-idle        Boolean    0          0}
  25.         {-width       TkResource 100        0 frame}
  26.         {-height      TkResource 4m         0 frame}
  27.         {-bg          Synonym    -background}
  28.         {-fg          Synonym    -foreground}
  29.         {-bd          Synonym    -borderwidth}
  30.     }
  31.  
  32.     Widget::addmap ProgressBar "" :cmd {-background {} -width {} -height {}}
  33.     Widget::addmap ProgressBar "" .bar {
  34.     -troughcolor -background -borderwidth {} -relief {}
  35.     }
  36.  
  37.     variable _widget
  38.  
  39.     proc ::ProgressBar { path args } { return [eval ProgressBar::create $path $args] }
  40.     proc use {} {}
  41. }
  42.  
  43.  
  44. # ------------------------------------------------------------------------------
  45. #  Command ProgressBar::create
  46. # ------------------------------------------------------------------------------
  47. proc ProgressBar::create { path args } {
  48.     variable _widget
  49.  
  50.     array set maps [list ProgressBar {} :cmd {} .bar {}]
  51.     array set maps [Widget::parseArgs ProgressBar $args]
  52.     eval frame $path $maps(:cmd) -class ProgressBar -bd 0 \
  53.         -highlightthickness 0 -relief flat
  54.     Widget::initFromODB ProgressBar $path $maps(ProgressBar)
  55.  
  56.     set c  [eval canvas $path.bar $maps(.bar) -highlightthickness 0]
  57.     set fg [Widget::cget $path -foreground]
  58.     if { ![string compare [Widget::cget $path -orient] "horizontal"] } {
  59.         $path.bar create rectangle -1 0 0 0 -fill $fg -outline $fg -tags rect
  60.     } else {
  61.         $path.bar create rectangle 0 1 0 0 -fill $fg -outline $fg -tags rect
  62.     }
  63.  
  64.     set _widget($path,val) 0
  65.     set _widget($path,dir) 1
  66.     if { [set _widget($path,var) [Widget::cget $path -variable]] != "" } {
  67.         GlobalVar::tracevar variable $_widget($path,var) w "ProgressBar::_modify $path"
  68.         after idle ProgressBar::_modify $path
  69.     }
  70.  
  71.     bind $path.bar <Destroy>   "ProgressBar::_destroy $path"
  72.     bind $path.bar <Configure> "ProgressBar::_modify $path"
  73.  
  74.     rename $path ::$path:cmd
  75.     proc ::$path { cmd args } "return \[eval ProgressBar::\$cmd $path \$args\]"
  76.  
  77.     return $path
  78. }
  79.  
  80.  
  81. # ------------------------------------------------------------------------------
  82. #  Command ProgressBar::configure
  83. # ------------------------------------------------------------------------------
  84. proc ProgressBar::configure { path args } {
  85.     variable _widget
  86.  
  87.     set res [Widget::configure $path $args]
  88.  
  89.     if { [Widget::hasChangedX $path -variable] } {
  90.     set newv [Widget::cget $path -variable]
  91.         if { $_widget($path,var) != "" } {
  92.             GlobalVar::tracevar vdelete $_widget($path,var) w "ProgressBar::_modify $path"
  93.         }
  94.         if { $newv != "" } {
  95.             set _widget($path,var) $newv
  96.             GlobalVar::tracevar variable $newv w "ProgressBar::_modify $path"
  97.             after idle ProgressBar::_modify $path
  98.         } else {
  99.             set _widget($path,var) ""
  100.         }
  101.     }
  102.  
  103.     foreach {cbd cor cma} [Widget::hasChangedX $path -borderwidth \
  104.         -orient -maximum] break
  105.  
  106.     if { $cbd || $cor || $cma } {
  107.         after idle ProgressBar::_modify $path
  108.     }
  109.     if { [Widget::hasChangedX $path -foreground] } {
  110.     set fg [Widget::cget $path -foreground]
  111.         $path.bar itemconfigure rect -fill $fg -outline $fg
  112.     }
  113.     return $res
  114. }
  115.  
  116.  
  117. # ------------------------------------------------------------------------------
  118. #  Command ProgressBar::cget
  119. # ------------------------------------------------------------------------------
  120. proc ProgressBar::cget { path option } {
  121.     return [Widget::cget $path $option]
  122. }
  123.  
  124.  
  125. # ------------------------------------------------------------------------------
  126. #  Command ProgressBar::_destroy
  127. # ------------------------------------------------------------------------------
  128. proc ProgressBar::_destroy { path } {
  129.     variable _widget
  130.  
  131.     if { $_widget($path,var) != "" } {
  132.         GlobalVar::tracevar vdelete $_widget($path,var) w "ProgressBar::_modify $path"
  133.     }
  134.     unset _widget($path,var)
  135.     unset _widget($path,dir)
  136.     Widget::destroy $path
  137.     rename $path {}
  138. }
  139.  
  140.  
  141. # ------------------------------------------------------------------------------
  142. #  Command ProgressBar::_modify
  143. # ------------------------------------------------------------------------------
  144. proc ProgressBar::_modify { path args } {
  145.     variable _widget
  146.  
  147.     if { ![GlobalVar::exists $_widget($path,var)] ||
  148.          [set val [GlobalVar::getvar $_widget($path,var)]] < 0 } {
  149.         catch {place forget $path.bar}
  150.     } else {
  151.         place $path.bar -relx 0 -rely 0 -relwidth 1 -relheight 1
  152.         set type [Widget::getoption $path -type]
  153.         if { $val != 0 && [string compare $type "normal"] } {
  154.             set val [expr {$val+$_widget($path,val)}]
  155.         }
  156.         set _widget($path,val) $val
  157.         set max [Widget::getoption $path -maximum]
  158.         set bd  [expr {2*[$path.bar cget -bd]}]
  159.         set w   [winfo width  $path.bar]
  160.         set h   [winfo height $path.bar]
  161.         if { ![string compare $type "infinite"] } {
  162.             if { $val > $max } {
  163.                 set _widget($path,dir) [expr {-$_widget($path,dir)}]
  164.                 set val 0
  165.                 set _widget($path,val) 0
  166.             }
  167.             if { $val <= $max/2.0 } {
  168.                 set dx0 0.0
  169.                 set dx1 [expr {double($val)/$max}]
  170.             } else {
  171.                 set dx1 [expr {double($val)/$max}]
  172.                 set dx0 [expr {$dx1-0.5}]
  173.             }
  174.             if { $_widget($path,dir) == 1 } {
  175.                 set x0 $dx0
  176.                 set x1 $dx1
  177.             } else {
  178.                 set x0 [expr {1-$dx1}]
  179.                 set x1 [expr {1-$dx0}]
  180.             }
  181.             if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
  182.                 $path.bar coords rect [expr {$x0*$w}] 0 [expr {$x1*$w}] $h
  183.             } else {
  184.                 $path.bar coords rect 0 [expr {$h-$x0*$h}] $w [expr {$x1*$h}]
  185.             }
  186.         } else {
  187.             if { $val > $max } {set val $max}
  188.             if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
  189.                 $path.bar coords rect -1 0 [expr {$val*$w/$max}] $h
  190.             } else {
  191.                 $path.bar coords rect 0 [expr {$h+1}] $w [expr {$h*($max-$val)}]
  192.             }
  193.         }
  194.     }
  195.     if {![Widget::cget $path -idle]} {
  196.         update
  197.     }
  198. }
  199.