I adapted code from Brent Welch's book so that my entry
box can be filled using listbox
. Can the code listed below be improved upon? Also, I want to convert this code into a widget so that any one using the code base can reuse it. What do I need to do convert this into a reusable widget?
The code is listed below:
#----------------------------------------------
# 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开发者_C百科 [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
No way to use the ttk::combobox widget from Tk 8.5 or the ComboBox widget from BWidget (if you have to stay at 8.4 or below)?
精彩评论