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