1# ---------------------------------------------------------------------------- 2# progressbar.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: progressbar.tcl,v 1.14 2009/09/06 21:37:18 oberdorfer Exp $ 5# ---------------------------------------------------------------------------- 6# Index of commands: 7# - ProgressBar::create 8# - ProgressBar::configure 9# - ProgressBar::cget 10# - ProgressBar::_destroy 11# - ProgressBar::_modify 12# - ProgressBar::_themechanged 13# ---------------------------------------------------------------------------- 14# to-do: johann: -troughcolor has no effect ?! 15 16namespace eval ProgressBar { 17 Widget::define ProgressBar progressbar 18 19 Widget::declare ProgressBar { 20 {-type Enum normal 0 21 {normal incremental infinite nonincremental_infinite}} 22 {-maximum Int 100 0 "%d > 0"} 23 {-background Color "SystemWindowFrame" 0} 24 {-foreground Color "SystemHighlight" 0} 25 {-troughcolor Color "SystemScrollbar" 0} 26 {-borderwidth TkResource 2 0 frame} 27 {-relief TkResource sunken 0 label} 28 {-orient Enum horizontal 1 {horizontal vertical}} 29 {-variable String "" 0} 30 {-idle Boolean 0 0} 31 {-width TkResource 100 0 frame} 32 {-height TkResource 4m 0 frame} 33 {-bg Synonym -background} 34 {-fg Synonym -foreground} 35 {-bd Synonym -borderwidth} 36 } 37 38 Widget::addmap ProgressBar "" :cmd {-background {} -width {} -height {}} 39 Widget::addmap ProgressBar "" .bar { 40 -troughcolor -background -borderwidth {} -relief {} 41 } 42 43 if {[lsearch [bindtags .] ProgressBarThemeChanged] < 0} { 44 bindtags . [linsert [bindtags .] 1 ProgressBarThemeChanged] 45 } 46 47 variable _widget 48} 49 50 51# ---------------------------------------------------------------------------- 52# Command ProgressBar::create 53# ---------------------------------------------------------------------------- 54proc ProgressBar::create { path args } { 55 variable _widget 56 57 array set maps [list ProgressBar {} :cmd {} .bar {}] 58 array set maps [Widget::parseArgs ProgressBar $args] 59 60 eval frame $path $maps(:cmd) -class ProgressBar -bd 0 \ 61 -highlightthickness 0 -relief flat 62 Widget::initFromODB ProgressBar $path $maps(ProgressBar) 63 64 set c [eval [list canvas $path.bar] $maps(.bar) -highlightthickness 0] 65 set fg [Widget::cget $path -foreground] 66 if { [string equal [Widget::cget $path -orient] "horizontal"] } { 67 $path.bar create rectangle -1 0 0 0 -fill $fg -outline $fg -tags rect 68 } else { 69 $path.bar create rectangle 0 1 0 0 -fill $fg -outline $fg -tags rect 70 } 71 72 set _widget($path,val) 0 73 set _widget($path,dir) 1 74 set _widget($path,var) [Widget::cget $path -variable] 75 if {$_widget($path,var) != ""} { 76 GlobalVar::tracevar variable $_widget($path,var) w \ 77 [list ProgressBar::_modify $path] 78 set _widget($path,afterid) \ 79 [after idle [list ProgressBar::_modify $path]] 80 } 81 82 bind $path.bar <Destroy> [list ProgressBar::_destroy $path] 83 bind $path.bar <Configure> [list ProgressBar::_modify $path] 84 85 bind ProgressBarThemeChanged <<ThemeChanged>> \ 86 "+ [namespace current]::_themechanged $path" 87 88 return [Widget::create ProgressBar $path] 89} 90 91 92# ---------------------------------------------------------------------------- 93# Command ProgressBar::configure 94# ---------------------------------------------------------------------------- 95proc ProgressBar::configure { path args } { 96 variable _widget 97 98 set res [Widget::configure $path $args] 99 100 if { [Widget::hasChangedX $path -variable] } { 101 set newv [Widget::cget $path -variable] 102 if { $_widget($path,var) != "" } { 103 GlobalVar::tracevar vdelete $_widget($path,var) w \ 104 [list ProgressBar::_modify $path] 105 } 106 if { $newv != "" } { 107 set _widget($path,var) $newv 108 GlobalVar::tracevar variable $newv w \ 109 [list ProgressBar::_modify $path] 110 if {![info exists _widget($path,afterid)]} { 111 set _widget($path,afterid) \ 112 [after idle [list ProgressBar::_modify $path]] 113 } 114 } else { 115 set _widget($path,var) "" 116 } 117 } 118 119 foreach {cbd cor cma} [Widget::hasChangedX $path -borderwidth \ 120 -orient -maximum] break 121 122 if { $cbd || $cor || $cma } { 123 if {![info exists _widget($path,afterid)]} { 124 set _widget($path,afterid) \ 125 [after idle [list ProgressBar::_modify $path]] 126 } 127 } 128 if { [Widget::hasChangedX $path -foreground] } { 129 set fg [Widget::cget $path -foreground] 130 $path.bar itemconfigure rect -fill $fg -outline $fg 131 } 132 if { [Widget::hasChangedX $path -background] } { 133 set bg [Widget::cget $path -background] 134 $path.bar configure -background $bg 135 } 136 137 return $res 138} 139 140 141# ---------------------------------------------------------------------------- 142# Command ProgressBar::cget 143# ---------------------------------------------------------------------------- 144proc ProgressBar::cget { path option } { 145 return [Widget::cget $path $option] 146} 147 148 149# ---------------------------------------------------------------------------- 150# Command ProgressBar::_modify 151# ---------------------------------------------------------------------------- 152proc ProgressBar::_modify { path args } { 153 variable _widget 154 155 catch {unset _widget($path,afterid)} 156 if { ![GlobalVar::exists $_widget($path,var)] || 157 [set val [GlobalVar::getvar $_widget($path,var)]] < 0 } { 158 catch {place forget $path.bar} 159 } else { 160 place $path.bar -relx 0 -rely 0 -relwidth 1 -relheight 1 161 set type [Widget::getoption $path -type] 162 if { $val != 0 && $type != "normal" && \ 163 $type != "nonincremental_infinite"} { 164 set val [expr {$val+$_widget($path,val)}] 165 } 166 set _widget($path,val) $val 167 set max [Widget::getoption $path -maximum] 168 set bd [expr {2*[$path.bar cget -bd]}] 169 set w [winfo width $path.bar] 170 set h [winfo height $path.bar] 171 if {$type == "infinite" || $type == "nonincremental_infinite"} { 172 # JDC: New infinite behaviour 173 set tval [expr {$val % $max}] 174 if { $tval < ($max / 2.0) } { 175 set x0 [expr {double($tval) / double($max) * 1.5}] 176 } else { 177 set x0 [expr {(1.0-(double($tval) / double($max))) * 1.5}] 178 } 179 set x1 [expr {$x0 + 0.25}] 180 # convert coords to ints to prevent triggering canvas refresh 181 # bug related to fractional coords 182 if {[Widget::getoption $path -orient] == "horizontal"} { 183 $path.bar coords rect [expr {int($x0*$w)}] 0 \ 184 [expr {int($x1*$w)}] $h 185 } else { 186 $path.bar coords rect 0 [expr {int($h-$x0*$h)}] $w \ 187 [expr {int($x1*$h)}] 188 } 189 } else { 190 if { $val > $max } {set val $max} 191 if {[Widget::getoption $path -orient] == "horizontal"} { 192 $path.bar coords rect -1 0 [expr {int(double($val)*$w/$max)}] $h 193 } else { 194 $path.bar coords rect 0 [expr {$h+1}] $w \ 195 [expr {int($h*(1.0 - double($val)/$max))}] 196 } 197 } 198 } 199 if {![Widget::cget $path -idle]} { 200 update idletasks 201 } 202} 203 204 205# ---------------------------------------------------------------------------- 206# Command ProgressBar::_destroy 207# ---------------------------------------------------------------------------- 208proc ProgressBar::_destroy { path } { 209 variable _widget 210 211 if {[info exists _widget($path,afterid)]} { 212 after cancel $_widget($path,afterid) 213 unset _widget($path,afterid) 214 } 215 if {[info exists _widget($path,var)]} { 216 if {$_widget($path,var) != ""} { 217 GlobalVar::tracevar vdelete $_widget($path,var) w \ 218 [list ProgressBar::_modify $path] 219 } 220 unset _widget($path,var) 221 } 222 unset _widget($path,dir) 223 Widget::destroy $path 224} 225 226 227# ---------------------------------------------------------------------------- 228# Command ProgressBar::_themechanged 229# ---------------------------------------------------------------------------- 230proc ProgressBar::_themechanged { path } { 231 232 if { ![winfo exists $path] } { return } 233 BWidget::set_themedefaults 234 235 $path configure \ 236 -background $BWidget::colors(SystemWindowFrame) \ 237 -foreground $BWidget::colors(SystemHighlight) 238} 239 240