source: trunk/BWidget-1.2.1/progressbar.tcl @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago

include rest of files

File size: 6.8 KB
RevLine 
[931]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
13namespace 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# ------------------------------------------------------------------------------
44proc 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# ------------------------------------------------------------------------------
78proc 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# ------------------------------------------------------------------------------
110proc ProgressBar::cget { path option } {
111    return [Widget::cget $path $option]
112}
113
114
115# ------------------------------------------------------------------------------
116#  Command ProgressBar::_destroy
117# ------------------------------------------------------------------------------
118proc 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# ------------------------------------------------------------------------------
134proc 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}
Note: See TracBrowser for help on using the repository browser.