Un potentiomètre dans un canvas

 

ulis, 2006-10-06. Comment faire un potentiomètre dans un canvas. Tout à la main.


Pourquoi

Comme on n'arrête pas de me rabâcher qu'"on peut tout faire avec un canvas", j'essaye par tout les bouts de montrer le contraire.

Eh bien... Il l'a fait.


Comment

Allons, devinez !

Trois rectangles pour la bordure et le fond de la glisssière. Autant pour le curseur. Pas de texte, mais une variable qui reçoit une valeur entre 0 et 100. Quelques binding. Un peu de Tcl. Et c'est parti !


Le script

  package require Tk

  # paramètres
  variable {}
  array set {} {}
  set w ._entry-canvas
  entry $w
  set (color:light) [$w cget -background]
  set (color:dark) [$w cget -disabledforeground]
  destroy $w
  canvas $w
  set (color:bg) [$w cget -background]
  destroy $w

  # procs gestion entry
  proc createSlide {w var x0 y0 width height} \
  {
    variable {}
    set dy [expr {($height - 3) / 2}]
    set dx [expr {$dy / 2}]
    set width [expr {$width - $dx}]
    set dx2 [expr {$dx / 2}]
    set dy2 [expr {$height / 4}]
    set x1 $x0
    set y1 [expr {$y0 + $dy}]
    set x2 [expr {$x1 + $width}]
    set y2 [expr {$y0 + $height - $dy}]
    $w create rectangle $x1 $y1 $x2 $y2 \
      -fill "" -outline $(color:dark) \
      -tags [list $var:groove $var:groove:nw]
    $w move $var:groove:nw -1 -1
    $w create rectangle $x1 $y1 $x2 $y2 \
      -fill "" -outline $(color:light) \
      -tags [list $var:groove $var:groove:se]
    $w move $var:groove:se 1 1
    $w create rectangle $x1 $y1 $x2 $y2 \
      -fill $(color:bg) -outline $(color:bg) \
      -tags [list $var:groove $var:groove:bg]
    set y1 [expr {$y2 + 2}]
    set y2 [expr {$y0 + $height}]
    for {set i 0} {$i <= 10} {incr i} \
    {
      set x [expr {$x0 + ($width * $i) / 10.0}]
      $w create line $x $y1 $x $y2 -fill $(color:dark)
      set x [expr {$x + 1}]
      $w create line $x $y1 $x $y2 -fill $(color:light)
    }
    set x1 [expr {$x0 - $dx2}]
    set y1 [expr {$y0 + $dy2 - 2}]
    set x2 [expr {$x1 + $dx}]
    set y2 [expr {$y0 + $height - $dy2 - 2}]
    $w create rectangle $x1 $y1 $x2 $y2 \
      -fill "" -outline $(color:light) \
      -tags [list $var:slider $var:slider:nw]
    $w move $var:slider:nw -1 -1
    $w create rectangle $x1 $y1 $x2 $y2 \
      -fill "" -outline $(color:dark) \
      -tags [list $var:slider $var:slider:se]
    $w move $var:slider:se 1 1
    $w create rectangle $x1 $y1 $x2 $y2 \
      -fill $(color:bg) -outline $(color:bg) \
      -tags [list $var:slider $var:slider:bg]
    set ($w:slider) [list $x0 $dx $dx2 $y1 $y2 $width]
    set ($w:var) $var
    set ($w:moving) 0
    $w bind $var:groove <ButtonPress-1>   [list clickGroove $w $var %x %y]
    $w bind $var:slider <ButtonPress-1>   [list startSlide $w $var %x %y]
    $w bind $var:slider <B1-Motion>       [list moveSlide  $w $var %x %y]
    $w bind $var:slider <ButtonRelease-1> [list stopSlide  $w $var %x %y]
    trace add variable $var write [list updateSlide $w $var]
  }
  proc startSlide {w var x y} \
  {
    variable {}
    foreach {x1 y1 x2 y2} [$w coords $var:slider:bg] break
    set ($w:start) [list $x $y $x1]
    set ($w:moving) 1
  }
  proc moveSlide {w var x y} \
  {
    variable {}
    if {!$($w:moving)} { return }
    foreach {ox oy sx} $($w:start) break
    foreach {x0 dw dw2 y1 y2 width} $($w:slider) break
    set dx [expr {$x - $ox}]
    set x1 [expr {$sx + $dx}]
    set x2 [expr {$x1 + $dw}]
    if {$x1 < $x0 - $dw2} \
    {
      set x1 [expr {$x0 - $dw2}]
      set x2 [expr {$x1 + $dw}]
    }
    if {$x2 > $x0 + $width + $dw2} \
    {
      set x2 [expr {$x0 + $width + $dw2}]
      set x1 [expr {$x2 - $dw}]
    }
    set $($w:var) [expr {($x1 + $dw2 - $x0) * 100.0 / $width}]
  }
  proc stopSlide {w var x y} \
  {
    variable {}
    set ($w:moving) 0
  }
  proc updateSlide {w var args} \
  {
    variable {}
    set value [set $($w:var)]
    if {$value < 0} { set value 0; set $($w:var) 0 }
    if {$value > 100} { set value 100; set $($w:var) 100 }
    foreach {x0 dw dw2 y1 y2 width} $($w:slider) break
    set x1 [expr {$x0 - $dw2 + ($value * $width / 100.0)}]
    set x2 [expr {$x1 + $dw}]
    foreach item {nw se bg} \
    { $w coords $var:slider:$item $x1 $y1 $x2 $y2 }
    $w move $var:slider:nw -1 -1
    $w move $var:slider:se 1 1
  }
  proc clickGroove {w var x y} \
  {
    variable {}
    set value [set $($w:var)]
    foreach {x0 dw dw2 y1 y2 width} $($w:slider) break
    foreach {x1 y1 x2 y2} [$w coords $var:slider:bg] break
    if {$x < $x1 && $x > $x0 - $dw2} { set incr -1 } \
    elseif {$x < $x0 + $width + $dw2} { set incr 1 }
    set $($w:var) [expr {$value + $incr}]
  }

Demo

  # exemple d'utilisation
  wm title . Slide-canvas
  . config -padx 10 -pady 10
  set width 200
  set height 100
  set bw 100
  set bh 19
  set w .s
  canvas $w -width $width -height $height \
    -bd 1 -relief groove -highlightt 0
  set x0 [expr {($width - $bw) / 2}]
  set y0 10
  set ::var 0
  createSlide $w ::var $x0 $y0 $bw $bh
  grid $w
  after 1500 set ::var 25

Voir Aussi


Discussion


Catégorie Exemple | Catégorie Interface utilisateur