home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / progressbar.tcl < prev    next >
Text File  |  2000-11-02  |  7KB  |  187 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 {>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.         {-width       TkResource 100        0 frame}
  25.         {-height      TkResource 4m         0 frame}
  26.         {-bg          Synonym    -background}
  27.         {-fg          Synonym    -foreground}
  28.         {-bd          Synonym    -borderwidth}
  29.     }
  30.  
  31.     Widget::addmap ProgressBar "" :cmd {-background {} -width {} -height {}}
  32.     Widget::addmap ProgressBar "" .bar {-troughcolor -background -borderwidth {} -relief {}}
  33.  
  34.     variable _widget
  35.  
  36.     proc ::ProgressBar { path args } { return [eval ProgressBar::create $path $args] }
  37.     proc use {} {}
  38. }
  39.  
  40.  
  41. # ------------------------------------------------------------------------------
  42. #  Command ProgressBar::create
  43. # ------------------------------------------------------------------------------
  44. proc ProgressBar::create { path args } {
  45.     variable _widget
  46.  
  47.     Widget::init ProgressBar $path $args
  48.  
  49.     eval frame $path [Widget::subcget $path :cmd]
  50.     set c  [eval canvas $path.bar [Widget::subcget $path .bar] -highlightthickness 0]
  51.     set fg [Widget::getoption $path -foreground]
  52.     if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
  53.         $path.bar create rectangle -1 0 0 0 -fill $fg -outline $fg -tags rect
  54.     } else {
  55.         $path.bar create rectangle 0 1 0 0 -fill $fg -outline $fg -tags rect
  56.     }
  57.  
  58.     set _widget($path,val) 0
  59.     set _widget($path,dir) 1
  60.     if { [set _widget($path,var) [Widget::getoption $path -variable]] != "" } {
  61.         GlobalVar::tracevar variable $_widget($path,var) w "ProgressBar::_modify $path"
  62.         after idle ProgressBar::_modify $path
  63.     }
  64.  
  65.     bind $path.bar <Destroy>   "ProgressBar::_destroy $path"
  66.     bind $path.bar <Configure> "ProgressBar::_modify $path"
  67.  
  68.     rename $path ::$path:cmd
  69.     proc ::$path { cmd args } "return \[eval ProgressBar::\$cmd $path \$args\]"
  70.  
  71.     return $path
  72. }
  73.  
  74.  
  75. # ------------------------------------------------------------------------------
  76. #  Command ProgressBar::configure
  77. # ------------------------------------------------------------------------------
  78. proc ProgressBar::configure { path args } {
  79.     variable _widget
  80.  
  81.     set res [Widget::configure $path $args]
  82.  
  83.     if { [Widget::hasChanged $path -variable newv] } {
  84.         if { $_widget($path,var) != "" } {
  85.             GlobalVar::tracevar vdelete $_widget($path,var) w "ProgressBar::_modify $path"
  86.         }
  87.         if { $newv != "" } {
  88.             set _widget($path,var) $newv
  89.             GlobalVar::tracevar variable $newv w "ProgressBar::_modify $path"
  90.             after idle ProgressBar::_modify $path
  91.         } else {
  92.             set _widget($path,var) ""
  93.         }
  94.     }
  95.  
  96.     if { [Widget::hasChanged $path -borderwidth v] ||
  97.          [Widget::hasChanged $path -orient v] } {
  98.         after idle ProgressBar::_modify $path
  99.     }
  100.     if { [Widget::hasChanged $path -foreground fg] } {
  101.         $path.bar itemconfigure rect -fill $fg -outline $fg
  102.     }
  103.     return $res
  104. }
  105.  
  106.  
  107. # ------------------------------------------------------------------------------
  108. #  Command ProgressBar::cget
  109. # ------------------------------------------------------------------------------
  110. proc ProgressBar::cget { path option } {
  111.     return [Widget::cget $path $option]
  112. }
  113.  
  114.  
  115. # ------------------------------------------------------------------------------
  116. #  Command ProgressBar::_destroy
  117. # ------------------------------------------------------------------------------
  118. proc ProgressBar::_destroy { path } {
  119.     variable _widget
  120.  
  121.     if { $_widget($path,var) != "" } {
  122.         GlobalVar::tracevar vdelete $_widget($path,var) w "ProgressBar::_modify $path"
  123.     }
  124.     unset _widget($path,var)
  125.     unset _widget($path,dir)
  126.     Widget::destroy $path
  127.     rename $path {}
  128. }
  129.  
  130.  
  131. # ------------------------------------------------------------------------------
  132. #  Command ProgressBar::_modify
  133. # ------------------------------------------------------------------------------
  134. proc ProgressBar::_modify { path args } {
  135.     variable _widget
  136.  
  137.     if { ![GlobalVar::exists $_widget($path,var)] ||
  138.          [set val [GlobalVar::getvar $_widget($path,var)]] < 0 } {
  139.         catch {place forget $path.bar}
  140.     } else {
  141.         place $path.bar -relx 0 -rely 0 -relwidth 1 -relheight 1
  142.         set type [Widget::getoption $path -type]
  143.         if { $val != 0 && [string compare $type "normal"] } {
  144.             set val [expr {$val+$_widget($path,val)}]
  145.         }
  146.         set _widget($path,val) $val
  147.         set max [Widget::getoption $path -maximum]
  148.         set bd  [expr {2*[$path.bar cget -bd]}]
  149.         set w   [winfo width  $path.bar]
  150.         set h   [winfo height $path.bar]
  151.         if { ![string compare $type "infinite"] } {
  152.             if { $val > $max } {
  153.                 set _widget($path,dir) [expr {-$_widget($path,dir)}]
  154.                 set val 0
  155.                 set _widget($path,val) 0
  156.             }
  157.             if { $val <= $max/2.0 } {
  158.                 set dx0 0.0
  159.                 set dx1 [expr {double($val)/$max}]
  160.             } else {
  161.                 set dx1 [expr {double($val)/$max}]
  162.                 set dx0 [expr {$dx1-0.5}]
  163.             }
  164.             if { $_widget($path,dir) == 1 } {
  165.                 set x0 $dx0
  166.                 set x1 $dx1
  167.             } else {
  168.                 set x0 [expr {1-$dx1}]
  169.                 set x1 [expr {1-$dx0}]
  170.             }
  171.             if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
  172.                 $path.bar coords rect [expr {$x0*$w}] 0 [expr {$x1*$w}] $h
  173.             } else {
  174.                 $path.bar coords rect 0 [expr {$h-$x0*$h}] $w [expr {$x1*$h}]
  175.             }
  176.         } else {
  177.             if { $val > $max } {set val $max}
  178.             if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
  179.                 $path.bar coords rect -1 0 [expr {$val*$w/$max}] $h
  180.             } else {
  181.                 $path.bar coords rect 0 [expr {$h+1}] $w [expr {$h*($max-$val)}]
  182.             }
  183.         }
  184.     }
  185.     update
  186. }
  187.