Une liste dans un canvas

 

ulis, 2006-10-18. Comment faire une liste dans un canvas. Tout à la main.


Pourquoi

Bin pour les ceux qui qu'en auraient besoin. C'est tellement facile avec le canvas.

Moins facile que je pensais au départ, à cause du scrolling.


Comment

Pour la boîte, 3 rectangles. Pour la liste, des textes. Une variable pour la liste.

Bien sûr, le tout saupoudré de bindings.


Le script

  package require Tk

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

  # procs gestion liste
  proc createListBox {w tag x0 y0 width height var} \
  {
    variable {}
    # variables
    set bg [$w cget -bg]
    set (listbox:$w:bg) $bg
    set (listbox:$w:fg) black
    set (listbox:$w:abg) navy
    set (listbox:$w:afg) white
    set (listbox:$w:var) $var
    set (listbox:$w:tag:$tag) [list $x0 $y0 $width $height]
    set (listbox:$w:lo) 0
    set (listbox:$w:cur) 0
    # box
    set x1 [expr {$x0 + $width}]
    set y1 [expr {$y0 + $height}]
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $tag $tag:nw] \
      -fill "" -outline $(color:light)
    $w move $tag:nw 1 1
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $tag $tag:se] \
      -fill "" -outline $(color:dark)
    $w move $tag:se -1 -1
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $tag $tag:bg] \
      -fill $(color:bg) -outline $(color:bg)
    # list
    set xc [expr {$x0 + 3}]
    set yc [expr {$y0 + 3}]
    $w create text $xc $yc -anchor nw -tags [list $tag $tag:txt $tag $tag:txt:0]
    set font [$w itemcget $tag:txt:0 -font]
    set (listbox:$w:font) $font
    set lh [font metric $font -linespace]
    incr lh 3
    set (listbox:$w:lh) $lh
    set xd [expr {$xc + $width - 6}]
    set yd [expr {$yc + $lh}]
    $w create rectangle $xc $yc $xd $yd -tags [list $tag $tag:rect $tag:rect:0] \
      -fill $bg -outline $bg
    $w raise $tag:txt:0
    set ln 0
    while {$yc + $lh + 1 < $y0 + $height} \
    {
      incr yc $lh
      incr ln
      set yd [expr {$yc + $lh}]
      $w create rectangle $xc $yc $xd $yd -tags [list $tag $tag:rect $tag:rect:$ln] \
        -fill $bg -outline $bg
      $w create text $xc $yc -anchor nw -tags [list $tag $tag:txt $tag:txt:$ln]
    }
    set (listbox:$w:ln) [incr ln]
    # update list
    modifyList $w $tag
    trace add variable $var write [list modifyList $w $tag]
    # bindings
    $w bind $tag <ButtonPress-1> [list pressList $w $tag %x %y]
    $w bind $tag <Button1-Motion> [list moveList $w $tag %x %y]
    $w bind $tag <ButtonRelease-1> [list releaseList $w $tag %x %y]
  }
  proc modifyList {w tag args} \
  {
    variable {}
    # get variables
    set list [list]
    catch { set list [set $(listbox:$w:var)] }
    set ll [llength $list]
    set (listbox:$w:ll) $ll
    foreach {- - width height} $(listbox:$w:tag:$tag) break
    set lh $(listbox:$w:lh)
    set ln $(listbox:$w:ln)
    set lo $(listbox:$w:lo)
    # list position
    if {$lo + $ln > $ll} \
    {
      set lo [expr {$ll - $ln}]
      if {$lo < 0} { set lo 0 }
      set (listbox:$w:lo) $lo
    }
    set lm [expr {$lo + $ln}]
    if {$lm > $ll} { set lm $ll }
    # show list
    for {set i $lo} {$i < $lm} {incr i} \
    {
      set ii [expr {$i - $lo}]
      $w itemconfig $tag:txt:$ii -text [lindex $list $i]
    }
  }
  proc pressList {w tag x y} \
  {
    variable {}
    set (listbox:$w:press) 1
    # move selected entry
    moveList $w $tag $x $y
  }
  proc moveList {w tag x y} \
  {
    variable {}
    if {!$(listbox:$w:press)} { return }
    # get variables
    set lh $(listbox:$w:lh)
    set ln $(listbox:$w:ln)
    set lo $(listbox:$w:lo)
    set ll $(listbox:$w:ll)
    foreach {x0 y0 width height} $(listbox:$w:tag:$tag) break
    set cur [expr {($y - $y0) / $lh}]
    set changed 0
    # limits
    if {$cur < 0} \
    {
      if {$lo == 0} { return }
      incr lo -1
      set cur 0
      set changed 1
    } \
    elseif {$cur >= $ln} \
    {
      if {$lo + $ln >= $ll} { return }
      incr lo
      set cur [expr {$ln - 1}]
      set changed 1
    }
    # move selected entry
    set (listbox:$w:cur) $cur
    set bg $(listbox:$w:bg)
    $w itemconfig $tag:rect -fill $bg -outline $bg
    set fg $(listbox:$w:fg)
    $w itemconfig $tag:txt -fill $fg
    set abg $(listbox:$w:abg)
    $w itemconfig $tag:rect:$cur -fill $abg -outline $abg
    set afg $(listbox:$w:afg)
    $w itemconfig $tag:txt:$cur -fill $afg
    # move visible items
    if {$changed} \
    {
      set (listbox:$w:press) 0
      set (listbox:$w:lo) $lo
      modifyList $w $tag
      after 150 [list set ::(listbox:$w:press) 1 ]
    }
  }
  proc releaseList {w tag x y} \
  {
    variable {}
    set (listbox:$w:press) 0
    # move selected entry
    moveList $w $tag $x $y
    # fire select event
    onList $w $tag $x $y
  }
  proc getSelected {w tag} \
  {
    variable {}
    return $(listbox:$w:cur)
  }
  proc onList {w tag x y} \
  {
    variable {}
    # check inside
    foreach {x0 y0 width height} $(listbox:$w:tag:$tag) break
    if {$x >= $x0 && $x <= $x0 + $width \
     && $y >= $y0 && $y <= $y0 + $height} \
    { event generate .c <<ListSelect>> -serial $(listbox:$w:cur) }
  }

Demo

  # exemple d'utilisation
  wm title . ListBox-canvas
  . config -padx 10 -pady 10
  set width 200
  set height 200
  set bw 100
  set bh 100
  canvas .c -width $width -height $height \
    -bd 1 -relief groove -highlightt 0
  grid .c
  set x0 [expr {($width - $bw) / 2}]
  set y0 10
  set ::liste [list banane pomme cerise fraise abricot melon]
  createListBox .c listBox $x0 $y0 $bw $bh ::liste
  bind .c <<ListSelect>> { tk_messageBox -message %# }
  after 5000 { set ::liste  [list chou carotte navet potiron tomate haricot] }

Voir aussi


Discussion


Catégorie Exemple | Catégorie Interface utilisateur