a(Simple)ProgressBar

 

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::progress

Script 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