Блог

Я адаптировал код из книги Брента Уэлча, чтобы мой 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
  

Невозможно использовать виджет ttk::combobox из Tk 8.5 или виджет ComboBox из BWidget (если вам нужно оставаться на уровне 8.4 или ниже)?