[WJG] (20/Mar/06) With so many comboboxes floating around you'd think that the lads in the core development team would have dropped one into the the standard Tk widget pack. Well, until today combobox widgets were ten a penny, but now, with my offering banging silently at the door the tally's now 11! #--------------- # combo.tcl #--------------- # # by William J Giddings, 2006. # # Description: # ----------- # Display a scrolled list box, pick, then perform some follow up action. # If the user types in a new value into the entry box and presses Enter, the # value will be added to the top of the list. Duplicate values are ignored. # # Usage: # ----- # See demo code below # #--------------- package require autoscroll namespace eval combo {} #--------------- # create the widget #--------------- proc combo {w args} { # Step 1) parge arguments # initialise args lists set frameargs {} set entryargs {} set buttonargs {} set droplistargs {} # divide the args up between the widget components foreach {arg val} $args { switch -- $arg { -relief { append frameargs "$arg $val " } -borderwidth { append frameargs "$arg $val " append buttonargs "$arg $val" append droplistargs "$arg $val" } -image { append buttonargs "$arg $val " } default { append entryargs "$arg $val " } } } # default droplist button image create bitmap ::combo::bimage -data { #define down_arrow_width 12 #define down_arrow_height 12 static char down_arrow_bits[] = { 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0xfc,0xf1,0xf8,0xf0,0x70,0xf0,0x20,0xf0, 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00; } } # Step 2) create the entry and button eval frame $w $frameargs eval entry $w.entry $entryargs -borderwidth 0 eval button $w.but -image ::combo::bimage $buttonargs pack $w.entry -side left pack $w.but -side right # bindings bind ${w}.entry { combo::history %W [%W get] # perform our command eval [%W cget -vcmd ] [%W get] } bind $w.but {combo::droplist %W} # Step 3)create the associated droplist toplevel ${w}Drop wm withdraw ${w}Drop wm overrideredirect ${w}Drop 1 eval listbox ${w}Drop.lb $droplistargs -borderwidth 1 pack ${w}Drop.lb -side left -fill both -expand 1 eval scrollbar ${w}Drop.scrl \ -orient v \ -borderwidth 1 \ -elementborderwidth 1 \ -highlightthickness 1 pack ${w}Drop.scrl -side left -fill y ${w}Drop.scrl configure -command "${w}Drop.lb yview" ${w}Drop.lb configure -yscrollcommand "${w}Drop.scrl set" ::autoscroll::autoscroll ${w}Drop.scrl # bindings bind ${w}Drop { focus [winfo parent %W] wm withdraw %W } bind ${w}Drop.lb { # set entry to match selection set [eval [string trimright [winfo parent %W] Drop].entry cget -textvariable] [%W get @%x,%y] wm withdraw [winfo toplevel %W] # perform our command eval [[string trimright [winfo parent %W] Drop].entry cget -vcmd ] [[string trimright [winfo parent %W] Drop].entry get] } # Step 4) completed, return path to widget return $w } #--------------- # position and display the droplist #--------------- proc combo::droplist {w} { set p [winfo parent $w] set x [winfo rootx $p] set x1 [winfo rootx $w] set y [expr [winfo rooty $p] + [winfo height $p] ] set width [winfo width $p] ;#[expr $x1 -$x] set height 100 wm geometry ${p}Drop ${width}x${height}+${x}+${y} wm deiconify ${p}Drop focus ${p}Drop } #--------------- # add selection the history #--------------- proc combo::history {w a} { set p [winfo parent $w] set b [${p}Drop.lb get 0 end ] #check to see if value already there.. if { [lsearch -exact $b $a] == -1} { ${p}Drop.lb insert 0 $a } } #--------------- # add items to the list #--------------- proc combo::list {w vals} { foreach i $vals { ${w}Drop.lb insert end $i } } #--------------- # demo block #--------------- proc show {args} { puts "Show> $args" } console show pack [combo .cb1 -textvariable cb(1) -relief sunken -borderwidth 1 -vcmd show] -side left pack [combo .cb2 -textvariable cb(2) -relief sunken -borderwidth 1 -vcmd show] -side left set cb(1) Fruits set cb(2) Vegitables combo::list .cb1 {Apple Bannana Orange Cherry Apple Bannana Orange Cherry Apple Bannana Orange Cherry} combo::list .cb2 {Asparagus Broccoli Carrot}