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