ulis, 2006-02-17. Un package rapidement hacké pour afficher une barre de progression.
ulis, 2006-03-11. Un peu rapide le hacking ! Résultat : pas mal de bugs, que je viens de retirer (pour en semer d'autres ?).
Pourquoi
Pour poussez jusqu'au bout le concept de map d'indices de luminosité. Ici la map est réduite à sa plus simple expression. Dans le temps : elle est construite dynamiquement. Dans l'espace : elle n'a qu'un pixel de largeur.
Comment
Une map minimale d'un pixel de largeur est calculée et l'image générée est répétée sur la largeur de la barre.
Utilisation
création d'une barre
progress [create] path [-option valeur]...
récupération d'une valeur par défaut
progress get -option
récupération de la liste des noms d'option
progress get
modification de la valeur d'options par défaut
progress set [-option valeur]...
récupération de la liste des options par défaut avec leur valeur
progress set
-c:bg ou -couleur1 couleur d'arrière-plan. Sa valeur par défaut est ''gray''. -c:fg ou -couleur2 couleur d'avant-plan. Sa valeur par défaut est ''gold''. -c:text ou -couleur3 première couleur du texte. Sa valeur par défaut est ''gray20''. -c:shadow ou -couleur4 deuxième couleur du texte. Sa valeur par défaut est ''white''. -font police du texte. Sa valeur par défaut est vide (celle du texte d'un canvas). -height hauteur de la barre de progression. Sa valeur par défaut est ''18''. -percent pourcentage d'avncement. Sa valeur par défaut est ''0''. -width largeur de la barre de progression. Sa valeur par défaut est ''200''.
récupération de la valeur d'une option
path cget -option
modification de la valeur d'options
path config [-option valeur]...
Installation
Installation
Package ASimpleProgressBar
if {[info exists ::progress::version]} { return }
namespace eval ::progress \
{
# beginning of ::progress namespace definition
# ####################################
#
# progress widget
#
variable version 1.0
#
# ulis, (C) 2005
# NOL Licence
#
# ------------------------------------
# ####################################
# ==========================
#
# package
#
# ==========================
package provide ASimpleProgressBar $version
package require Tk
# ====================
#
# entry point
#
# ====================
namespace export progress
# ====================
#
# global variables
#
# ====================
variable {}
array set {} \
{
:color1 gray
:color2 gold
:color3 gray20
:color4 white
:font ""
:height 18
:percent 0
:width 200
}
# ====================
#
# progress proc
#
# ====================
proc progress {args} \
{
#puts "progress $args"
set cmd [lindex $args 0]
set rc [catch \
{
switch -glob -- $cmd \
{
cre* { uplevel 1 progress::progress:create $args }
get { uplevel 1 progress::progress:get $args }
set { uplevel 1 progress::progress:set $args }
default { uplevel 1 progress::progress:create create $args }
}
} msg]
if {$rc == 1} { return -code error $msg } \
else { return $msg }
}
# ====================
#
# get proc
#
# ====================
proc progress:get {get args} \
{
#puts "progress:get $get $args"
variable {}
set count [llength $args]
if {$count == 0} \
{
set result [list]
foreach name [lsort [array names {} :*]] \
{
lappend result -[string range $name 1 end]
}
return $result
}
if {$count != 1} \
{ error "use is 'progress get ?-option?'" }
set key [lindex $args 0]
switch -glob -- $key \
{
-c*:b* -
-color1 { set (:color1) }
-c*:f* -
-color2 { set (:color2) }
-c*:t* -
-color3 { set (:color3) }
-c*:s* -
-color4 { set (:color4) }
-fon* { set (:font) }
-hei* { set (:height) }
-per* { set (:percent) }
-wid* { set (:width) }
default \
{ error "unknown progress default '$key'" }
}
}
# ====================
#
# set proc
#
# ====================
proc progress:set {set args} \
{
#puts "progress:set $set $args"
variable {}
set count [llength $args]
if {$count == 0} \
{
set result [list]
foreach name [lsort [array names {} :*]] \
{
set value $($name)
lappend result -[string range $name 1 end] $value
}
return $result
}
if {$count % 2 != 0} \
{ error "use is 'progress set ?-option value?...'" }
foreach {key value} $args \
{
switch -glob -- $key \
{
-c*:b* -
-color1 { set (:color1) $value }
-c*:f* -
-color2 { set (:color2) $value }
-c*:t* -
-color3 { set (:color3) $value }
-c*:s* -
-color4 { set (:color4) $value }
-fon* { set (:font) $value }
-hei* { set (:height) $value }
-per* { set (:percent) $value }
-wid* { set (:width) $value }
default \
{ error "unknown progress default '$key'" }
}
}
}
# ====================
#
# create proc
#
# ====================
proc progress:create {create w args} \
{
#puts "progress:create $create $w $args"
variable {}
# set default values
foreach key [array names {}] \
{ set ($w$key) $($key) }
# create canvas
set width $($w:width)
set height $($w:height)
canvas $w -bd 0 -highlightt 0 \
-width $width -height $height
$w create image 0 0 -anchor nw -tags bg \
-image [progress:bar $width $height $($w:color1)]
$w create image 1 1 -anchor nw -tags img
set width2 [expr {$width / 2}]
set height2 [expr {$height / 2}]
$w create text $width2 $height2 -fill $($w:color3) -tags {txt txt3}
incr width2 -1
incr height2 -1
$w create text $width2 $height2 -fill $($w:color4) -tags {txt txt4}
if {$($w:font) == ""} \
{ set ($w:font) [$w itemcget txt -font] } \
else \
{ $w itemconfig txt -font $($w:font) }
rename $w progress::_$w
interp alias {} ::$w {} progress::progress:dispatch $w
eval progress:config $w config $args
return $w
}
# ====================
#
# dispatch proc
#
# ====================
proc progress:dispatch {w args} \
{
#puts "progress:dispatch $w $args"
set cmd [lindex $args 0]
set rc [catch \
{
switch -glob -- $cmd \
{
cge* { uplevel 1 progress::progress:cget $w $args }
con* { uplevel 1 progress::progress:config $w $args }
default \
{ error "unknown progress operation '$cmd'" }
}
} msg]
if {$rc == 1} { return -code error $msg } \
else { return $msg }
}
# ====================
#
# cget proc
#
# ====================
proc progress:cget {w cget args} \
{
#puts "progress:cget $cget $w $args"
variable {}
set count [llength $args]
if {$count == 0} \
{
set result [list]
foreach name [lsort [array names {} $w:*]] \
{ lappend result $name }
return $result
}
if {$count != 1} \
{ error "use is 'path cget ?-option?'" }
set key [lindex $args 0]
switch -glob -- $key \
{
-c*:b* -
-color1 { set ($w:color1) }
-c*:f* -
-color2 { set ($w:color2) }
-c*:t* -
-color3 { set ($w:color3) }
-c*:s* -
-color4 { set ($w:color4) }
-fon* { set ($w:font) }
-hei* { set ($w:height) }
-per* { set ($w:percent) }
-wid* { set ($w:width) }
default \
{ error "unknown progress option '$key'" }
}
}
# ====================
#
# config proc
#
# ====================
proc progress:config {w config args} \
{
#puts "progress:config $config $w $args"
variable {}
set count [llength $args]
if {$count == 0} \
{
set result [list]
foreach name [lsort [array names {} $w:-*]] \
{ lappend result $name $($name) }
return $result
}
if {$count % 2 != 0} \
{ error "use is 'path config ?-option value?...'" }
set _w progress::_$w
set f1 0; set f2 0; set f3 0; set f4 0
set fh 0; set fp 0; set fw 0
foreach {key value} $args \
{
switch -glob -- $key \
{
-c*:b* -
-color1 { set ($w:color1) $value; set f1 1 }
-c*:f* -
-color2 { set ($w:color2) $value; set f2 1 }
-c*:t* -
-color3 { set ($w:color3) $value; set f3 1 }
-c*:t* -
-color4 { set ($w:color4) $value; set f4 1 }
-fon* \
{
set ($w:font) $value
$_w itemconfig txt -font $value
}
-hei* { set ($w:height) $value; set fh 1 }
-per* { set ($w:percent) $value; set fp 1 }
-wid* { set ($w:width) $value; set fw 1 }
default \
{ error "unknown progress option '$key'" }
}
set width $($w:width)
set height $($w:height)
set width1 [expr {$width - 2}]
set height1 [expr {$height - 2}]
set width2 [expr {$width / 2}]
set height2 [expr {$height / 2}]
if {$fh || $fw} \
{
_$w config -width $($w:width) -height $($w:height)
set old [$_w itemcget bg -image]
_$w itemconfig bg -image [progress:bar $width $height $($w:color1)]
if {$old != ""} { image delete $old }
set old [$_w itemcget img -image]
_$w itemconfig img -image [progress:bar $width1 $height1 $($w:color2)]
if {$old != ""} { image delete $old }
_$w coords txt3 $width2 $height2
incr width2 -1
incr height2 -1
_$w coords txt4 $width2 $height2
set fp 1; set f1 0
}
if {$f1} \
{
set old [$_w itemcget bg -image]
_$w itemconfig bg -image [progress:bar $width $height $($w:color1)]
if {$old != ""} { image delete $old }
}
if {$fp || $f2} \
{
set old [$_w itemcget img -image]
set width3 [expr {round($width1 * $($w:percent) / 100.0)}]
$_w itemconfig img -image [progress:bar $width3 $height1 $($w:color2) 1]
if {$old != ""} { image delete $old }
$_w itemconfig txt -text $($w:percent)%
}
if {$f3} \
{
_$w itemconfig txt -fill $($w:color3)
}
if {$f4} \
{
_$w itemconfig txt -fill $($w:color4)
}
}
}
# ====================
#
# progress:bar proc
#
# ====================
proc progress:bar {width height color {inverse 0}} \
{
#puts "progress:bar $width $height $color $inverse"
set img [image create photo -height $height -width $width]
set pi 3.141592
foreach {r g b} [winfo rgb . $color] break
foreach c {r g b} \
{
set v [set $c]
set $c [expr {$v / 256.0}]
}
set data [list]
for {set y 0} {$y < $height} {incr y} \
{
set sin [expr {sin($y * $pi / $height / 2.0)}]
set coef [expr {round(255 - 96 * $sin * $sin)}]
foreach c {r g b} C {R G B} \
{
set v [set $c]
set $C [expr {round($v * $coef / 256.0)}]
}
set color [format #%2.2x%2.2x%2.2x $R $G $B]
if {$inverse} { lappend data $color } \
else { set data [linsert $data 0 $color] }
}
$img put $data
$img copy $img -from 0 0 1 $height -to 1 0 $width $height
return $img
}
}
namespace import ::progress::progressScript de description pkgIndex.tcl
package ifneeded ASimpleProgressBar 1.0 [list source [file join $dir ASimpleProgressBar.tcl]]
Démo
package require ASimpleProgressBar
wm title . progress
wm protocol . WM_DELETE_WINDOW exit
pack [progress .p]
for {set i 0} {$i <= 100} {incr i} \
{
.p config -percent $i
after 100
update
}Voir aussi
Discussion
Catégorie Paquet | Catégorie Interface utilisateur