|
64
by airadier
Progress bar widget |
1 |
#From Donald K. Fellows's Megawidget and Dialog Stuff
|
2 |
#http://www.cs.man.ac.uk/~fellowsd/tcl/mwidx.html
|
|
3 |
||
|
6888
by lephilousophe
As version system is now working, I commit it to trunk... |
4 |
::Version::setSubversionId {$Id$} |
5 |
||
|
983
by kakaroto
added the boss mode |
6 |
if { $initialize_amsn == 1 } { |
7 |
||
8 |
option add *Progress.undoneForeground black widgetDefault |
|
9 |
option add *Progress.undoneBackground white widgetDefault |
|
10 |
option add *Progress.doneForeground white widgetDefault |
|
11 |
option add *Progress.doneBackground green4 widgetDefault |
|
12 |
option add *Progress.borderWidth 1 widgetDefault |
|
13 |
option add *Progress.relief sunken widgetDefault |
|
14 |
}
|
|
|
64
by airadier
Progress bar widget |
15 |
|
16 |
namespace eval dkfprogress { |
|
17 |
namespace export Progress SetProgress
|
|
18 |
||
19 |
proc Progress {w args} { |
|
20 |
uplevel 1 [list frame $w -class Progress] $args |
|
21 |
||
22 |
foreach {val} { |
|
23 |
undoneForeground doneForeground
|
|
24 |
undoneBackground doneBackground
|
|
25 |
} { |
|
26 |
set class [string toupper [string index $val 0]\ |
|
27 |
][string range $val 1 end] |
|
28 |
set $val [option get $w $val $class] |
|
29 |
}
|
|
30 |
||
31 |
set varname [namespace current]::progressPercent($w) |
|
32 |
||
33 |
frame $w.l -borderwidth 0 -background $undoneBackground |
|
34 |
label $w.l.l -textvariable $varname -borderwidth 0 \ |
|
|
5380
by kakaroto
Implemented the progress bar from red to green for FT.. test please... |
35 |
-foreground black -background $undoneBackground |
|
64
by airadier
Progress bar widget |
36 |
$w.l configure -height [expr {int([winfo reqheight $w.l.l]+2)}] |
37 |
frame $w.l.fill -background $doneBackground |
|
38 |
label $w.l.fill.l -textvariable $varname -borderwidth 0 \ |
|
|
5380
by kakaroto
Implemented the progress bar from red to green for FT.. test please... |
39 |
-foreground black -background $doneBackground |
|
64
by airadier
Progress bar widget |
40 |
|
41 |
bind $w.l <Configure> [namespace code [list ProgressConf $w "%w"]] |
|
42 |
||
43 |
pack $w.l -fill both -expand 1 |
|
44 |
place $w.l.l -relx 0.5 -rely 0.5 -anchor center |
|
45 |
place $w.l.fill -x 0 -y 0 -relheight 1 -relwidth 0 |
|
46 |
place $w.l.fill.l -x 0 -rely 0.5 -anchor center |
|
47 |
||
48 |
SetProgress $w 0 |
|
49 |
return $w |
|
50 |
}
|
|
51 |
||
52 |
proc ProgressConf {w width} { |
|
53 |
place conf $w.l.fill.l -x [expr {int($width/2)}] |
|
54 |
}
|
|
55 |
||
56 |
proc SetProgress {win value {range 100}} { |
|
|
5049
by germinator2000
Fix bug while file transfer window closing too fast |
57 |
if {[winfo exists $win]} { |
|
6321
by kakaroto
Fixed small int/double truncation issue which could lead into have more than 100% in the progressbar |
58 |
set progress [expr {int(double($value)/ (double($range)/100.0))}] |
|
5049
by germinator2000
Fix bug while file transfer window closing too fast |
59 |
set relwidth [expr {double($value)/double($range)}] |
60 |
variable progressPercent
|
|
61 |
place conf $win.l.fill -relwidth $relwidth |
|
62 |
set progressPercent($win) "${progress}%" |
|
|
5380
by kakaroto
Implemented the progress bar from red to green for FT.. test please... |
63 |
|
64 |
if {[expr $relwidth < 0.5]} { |
|
|
5411
by vivia
All work by Youness: not so bright colors on progressbar, no tk bug when checking if a dp is animated for the cl |
65 |
set R e1
|
66 |
binary scan [binary format i [expr {int(2*$relwidth*225)}]] H2 G |
|
|
5380
by kakaroto
Implemented the progress bar from red to green for FT.. test please... |
67 |
} else { |
|
5411
by vivia
All work by Youness: not so bright colors on progressbar, no tk bug when checking if a dp is animated for the cl |
68 |
set G e1
|
69 |
binary scan [binary format i [expr {int(2*(1.0 - $relwidth)*225)}]] H2 R |
|
|
5380
by kakaroto
Implemented the progress bar from red to green for FT.. test please... |
70 |
}
|
71 |
set B 00 |
|
72 |
$win.l.fill configure -background \#${R}${G}${B} |
|
73 |
$win.l.fill.l configure -background \#${R}${G}${B} |
|
|
5049
by germinator2000
Fix bug while file transfer window closing too fast |
74 |
}
|
|
64
by airadier
Progress bar widget |
75 |
}
|
76 |
}
|
|
77 |
||
|
5380
by kakaroto
Implemented the progress bar from red to green for FT.. test please... |
78 |
|
|
983
by kakaroto
added the boss mode |
79 |
if { $initialize_amsn == 1 } { |
80 |
namespace import dkfprogress::Progress dkfprogress::SetProgress
|
|
81 |
}
|