我修改了Brent Welch的书中的代码,以便entry
框可以使用listbox
填充。下面列出的代码可以改进吗?此外,我想将此代码转换为小部件,以便任何使用代码库的人都可以重用它。我需要做什么将其转换为可重用的小部件?
代码如下:
#----------------------------------------------
# Code adapted from Brent Welch's book
#----------------------------------------------
proc scrolled_listbox { f args } {
frame $f
listbox $f.list
eval {$f.list configure} $args
scrollbar $f.xscroll -orient horizontal \
-command [list $f.list xview]
scrollbar $f.yscroll -orient vertical \
-command [list $f.list yview]
grid $f.list -sticky news
grid rowconfigure $f 0 -weight 1
grid columnconfigure $f 0 -weight 1
return $f.list
}
proc listbox_transfer_select {src dst} {
set select [$src curselection]
foreach i $select {
set elements [$dst get 0 end]
set e [$src get $i]
# insert only if the new element e is not present
if {$e ni $elements} {
$dst insert end $e
}
}
}
proc listbox_delete_select {dst} {
foreach i [lsort -integer -decreasing [$dst curselection]] {
$dst delete $i
}
}
proc onOk {picked parent window} {
set elements [$picked get 0 end]
$parent.e delete 0 end
$parent.e insert insert $elements
destroy $window
}
#----------------------------------------------
# Put everything together
#----------------------------------------------
proc list_select { parent values } {
# Create two lists side by side
set choiceWindow ${parent}.choices
toplevel $choiceWindow
set main [frame $choiceWindow.f1]
set choices [scrolled_listbox $main.choices \
-selectmode extended -width 20 -height 5 ]
set picked [scrolled_listbox $main.picked \
-selectmode extended -width 20 -height 5]
set inter [frame $main.inter -width 20 -height 5]
button $inter.b1 -width 10 -text ">>"
pack $inter.b1 -side top
button $inter.b2 -width 10 -text "<<"
pack $inter.b2 -side bottom
pack $main.choices $inter $main.picked -side left -expand true -fill both
set okcancel [frame $choiceWindow.f2]
button $okcancel.ok -text "OK" -command [list onOk $picked $parent $choiceWindow]
button $okcancel.cancel -text "Cancel" -command [list destroy $choiceWindow]
grid $okcancel.ok $okcancel.cancel
pack $main $okcancel -side top -anchor e
# Selecting in choices moves items into picked
bind $inter.b1 <ButtonRelease-1> [list listbox_transfer_select $choices $picked]
# Selecting in picked deletes items
bind $inter.b2 <ButtonRelease-1> [list listbox_delete_select $picked]
# ok
bind $choiceWindow <Return> [list onOk $picked $parent $choiceWindow]
# cancel
bind $choiceWindow <Escape> [list destroy $choiceWindow]
# Insert all the choices
foreach x $values {
$choices insert end $x
}
}
proc my_entry_list { parent options } {
frame $parent
label $parent.l -text "Fruits:"
entry $parent.e -width 15 -textvariable result -relief sunken
button $parent.b -text ... -command [list list_select $parent $options]
pack $parent.l $parent.e $parent.b -side left
}
#----------------------------------------------
# main
#----------------------------------------------
set options { grapes mangos peaches pears oranges berries }
my_entry_list .mel $options
pack .mel