0

我改编了 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
4

1 回答 1

0

无法使用Tk 8.5中的ttk::combobox小部件或 BWidget 中的ComboBox小部件（如果您必须保持在 8.4 或更低版本）？

于 2011-10-17T17:32:14.470 回答