[Keith Vetter] 2019-05-17 : I wanted a multi-column listbox but with a button in the first column which I could click on to get more details. A [ttk::treeview] almost does the job but needs a few tweaks--it displays an image in the first column and when you click on it it generates a <> event. I've included a demo to show how to use it. ====== ##+########################################################################## # # button_listbox.tcl -- Multicolumn list box with column 0 a button # image which generates <> when clicking on the # button image. # by Keith Vetter 2018-11-25 # # Usage: # ::ttk::frame .f # set w [::ButtonListBox::Create .f -headers {Column1 Column2} -widths {10 20} -banding 0] # ::ButtonListBox::AddItem $w {column1_data column2_data} # bind $w <> {puts "Button Press for %d" } # Note: the columns are sortable by clicking on the headers namespace eval ::ButtonListBox { package require Tk variable CONFIG variable DEFAULT array set DEFAULT { headers {} widths {} banding 0 buttonImage ::ButtonListBox::help color,0 white color,1 \#aaffff } } ##+########################################################################## # # ::ButtonListBox::Create -- Creates and packs a new tile table widget # into a parent frame. # # proc ::ButtonListBox::Create {parent args} { variable CONFIG set w $parent.tree ::ButtonListBox::_ParseArgs $w $args ::ttk::treeview $w -columns $CONFIG($w,headers) \ -yscroll "$parent.vsb set" -xscroll "$parent.hsb set" scrollbar $parent.vsb -orient vertical -command "$w yview" scrollbar $parent.hsb -orient horizontal -command "$w xview" # Set up headings and widths set font [::ttk::style lookup [$w cget -style] -font] foreach col $CONFIG($w,headers) hSize $CONFIG($w,widths) { $w heading $col -text $col -anchor c \ -image ::ButtonListBox::arrowBlank \ -command [list ::ButtonListBox::_SortBy $w $col 0] if {[string is integer -strict $hSize]} { $w column $col -width $hSize } else { if {$hSize eq ""} { set hSize $col } set width [font measure $font [string cat $hSize $hSize]] $w column $col -width $width } } # Fix up heading #0 (over the tree section) # $w heading \#0 -command [list ::ButtonListBox::_SortBy $w \#0 1] \ # -image ::ButtonListBox::arrowBlank $w column \#0 -width 45 -stretch 0 #bind $w <> {set ::id [%W selection]} ;# Debugging bind $w <1> [list ::ButtonListBox::_ButtonPress %W %x %y] grid $w $parent.vsb -sticky nsew grid $parent.hsb -sticky nsew grid column $parent 0 -weight 1 grid row $parent 0 -weight 1 return $w } proc ::ButtonListBox::_ParseArgs {widget myargs} { variable CONFIG variable DEFAULT foreach {key value} [array get DEFAULT] { set CONFIG($widget,$key) $value } foreach {key value} $myargs { set key2 [string range $key 1 end] if {[string index $key 0] ne "-" || $key2 ni [array names DEFAULT]} { error "unknown option $key" } if {$value eq {}} { error "missing value for $key" } set CONFIG($widget,$key2) $value } } proc ::ButtonListBox::AddItem {w itemData} { variable CONFIG set id [$w insert {} end -text "" -image $CONFIG($w,buttonImage) -values $itemData] $w item $id -tags $id ;# For banding ::ButtonListBox::_BandTable $w return $id } ##+########################################################################## # # ::ButtonListBox::AddManyItems -- Fills in tree with given data # proc ::ButtonListBox::AddManyItems {w data} { variable CONFIG $w delete [$w child {}] foreach datum $data { set id [$w insert {} end -values $datum -text "" -image $CONFIG($w,buttonImage)] $w item $id -tags $id } ::ButtonListBox::_SortBy $w [$w heading #1 -text] 0 ::ButtonListBox::_BandTable $w } ##+########################################################################## # # ::ButtonListBox::Clear -- Deletes all items # proc ::ButtonListBox::Clear {w} { $w delete [$w child {}] } # # Internal routines # image create bitmap ::ButtonListBox::arrow(0) -data { #define arrowUp_width 7 #define arrowUp_height 4 static char arrowUp_bits[] = { 0x08, 0x1c, 0x3e, 0x7f }; } image create bitmap ::ButtonListBox::arrow(1) -data { #define arrowDown_width 7 #define arrowDown_height 4 static char arrowDown_bits[] = { 0x7f, 0x3e, 0x1c, 0x08 }; } image create bitmap ::ButtonListBox::arrowBlank -data { #define arrowBlank_width 7 #define arrowBlank_height 4 static char arrowBlank_bits[] = { 0x00, 0x00, 0x00, 0x00 }; } image create photo ::ButtonListBox::help -data { iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAFo9M/3AAADFklEQVQ4jZ2TW2zTdRTHP/1ba2Ln1Clk 7eJwHYQp1sVJnCgsxsRM2YiXESPIRnzxATNfyMwSw807vrhopgwFZSRcxrqmEDPBzEQaAkLCw5xkuAtz 0nvZ6Lq2//77u/hAVo3zye/jyTnfc77ne45Naw2AAXB2JKxtCxHbile6tFEwsWmt+TwwqutWlhFNmtgB ZCFL27ZeEtGbmWLNAuwd302Grv0x5r52fYb7Skqq7Q01DrfffwWVz5EUtpHbghNlIw9UlL76UmMdga5W R5Hjg4F4uN5juCzLIq/snL4Y3djz9qM+A+DUxbDuGxh0OR2K4ckoV6em+DM03v/Ypm/GDIBLw9PIXJot 2w+w4clKvuwJUP/QUqZ/Hz1cbHG3t71aSvGDEqJcK/Fpbvzb9wEW6fg37AAfB5ItdVV39Aszjd1u5+SF ZKR728NuAKPz8LRndRX9u3uGuLfUwfcXJrn/zqxrfcdgCMCIROKnD/qHSc/MEAiOs/P1Wo6eDNLatMIN YI9FIhWJ1Bx5M0X7y17WtnZTsCxudxi3nIpFY5+0NdciTZP5rEUmPYvOzzH402+3ptRa427YPf/RkV+0 57l3df2WLv1h7zntXPlmi9b6b5l3PfLWDiUK7ygholrJ583JQxP/uYfPBtPVUqnNUqg2qWW5FIKCUFEp Ra8Q6sjerQ9O/DO/SLCnL9pSkOLQs16nMxS9wdnLccavJ5BS41rqZJ23gmWV93D0zFRGFsTW47safEWC 9q+u7FxXW7ZnPp1ln+8yVjbHme6NC9cKKF7sGMAqCDY3PY5W4P/x113nvt70ngEQjsQ7nXbBvr7zZOZu kjNTrH1jP10nLjGXMQknMiyvLCWVTHDw+BAedwnJWLyzaHUsEg2lzcrl5UtKuTo7ixR5tJIc8wU55gui LAu0RKNwly9jJjNP6kYiVPyoZCzeuGOvP/zCmipea67D0AJhZlhV42ZVjRupLLTMsr5xDU3PeNnesT+c TaUaF7mw5InOFqXkF80bnnY9tdpDidMBQCpl8vP5UU75hyIo1Z4dO+Bb5ML/xV9NZK9JY/hkUAAAAABJ RU5ErkJggg== } ##+########################################################################## # # ::ButtonListBox::_SortBy -- Code to sort tree content when clicked on a header # proc ::ButtonListBox::_SortBy {tree col direction} { # Build something we can sort # if {$col eq "\#0"} { set col [lindex [$tree cget -columns] 0] } set sortData [lmap row [$tree children {}] {list [$tree set $row $col] $row}] set dir [expr {$direction ? "-decreasing" : "-increasing"}] # Now reshuffle the rows into the sorted order set r -1 foreach rinfo [lsort -dictionary -index 0 $dir $sortData] { $tree move [lindex $rinfo 1] {} [incr r] } # Switch the heading command so that it will sort in the opposite direction set cmd [list ::ButtonListBox::_SortBy $tree $col [expr {!$direction}]] $tree heading $col -command $cmd # if {$col eq [lindex [$tree cget -columns] 0]} { # set cmd [list ::ButtonListBox::_SortBy $tree #0 [expr {!$direction}]] # $tree heading #0 -command $cmd # } ::ButtonListBox::_BandTable $tree ::ButtonListBox::_ArrowHeadings $tree $col $direction } ##+########################################################################## # # ::ButtonListBox::_ArrowHeadings -- Puts in up/down arrows to show sorting # proc ::ButtonListBox::_ArrowHeadings {tree sortCol dir} { set idx -1 foreach col [$tree cget -columns] { incr idx set img ::ButtonListBox::arrowBlank if {$col == $sortCol} { set img ::ButtonListBox::arrow($dir) } $tree heading $idx -image $img } set img ::ButtonListBox::arrowBlank if {$sortCol eq "\#0"} { set img ::ButtonListBox::arrow($dir) } $tree heading "\#0" -image $img } ##+########################################################################## # # ::ButtonListBox::_BandTable -- Draws bands on our table # proc ::ButtonListBox::_BandTable {tree} { variable CONFIG if {! $CONFIG($tree,banding)} return set id 0 foreach row [$tree children {}] { set id [expr {! $id}] set tag [$tree item $row -tag] $tree tag configure $tag -background $CONFIG($tree,color,$id) } } ##+########################################################################## # # ::ButtonListBox::_ButtonPress -- handles mouse click which can # toggle checkbutton, control selection or resize headings. # proc ::ButtonListBox::_ButtonPress {w x y} { lassign [$w identify $x $y] what id detail # Disable resizing heading #0 if {$what eq "separator" && $id eq "\#0"} { return -code break } if {$what eq "item"} { set column1 [$w heading #1 -text] event generate $w <> -data [$w set $id $column1] return -code break } } ################################################################ if { [file tail [info script]] == [file tail $::argv0] } { # Demo code: opens two toplevels both with a ButtonListBox proc Demo {} { set headers {Id Surface Highway Name} set hwidths {100 70 70 150} set data { {38449949 dirt path {Loop Trail}} {38449969 dirt path {Bear Gulch Trail}} {38450161 dirt path {Bear Gulch Trail}} {38904103 dirt path {Sierra Morena Trail}} {38905166 dirt path {Tafoni Trail}} {42054541 dirt track {Bear Gulch Trail}} {42054542 dirt track {Bear Gulch Trail}} {234792351 dirt path {Alambique Trail}} {234792352 dirt path {Madrone Trail}} {234897703 dirt path {Madrone Trail}} {235211301 dirt path {Bear Gulch Trail}} {235557435 dirt track {Bear Gulch Trail}} {235557436 dirt path {Loop Trail}} {235557440 dirt path {Redwood Trail}} {235557444 dirt track {}} {235557446 dirt track {}} {249015506 dirt path {Trail11 Bypass}} {249361145 dirt path {}} {249361146 dirt path {}} {249361147 dirt path {}} {327010065 dirt path {Molder Trail}} {512377049 dirt path {El Corte de Madera Creek Trail}} } set parent .top1 destroy $parent toplevel $parent wm title $parent "Teague Hill Trails" set w [ButtonListBox::Create $parent -headers $headers -widths $hwidths -banding 1] set tree $w foreach datum $data { ::ButtonListBox::AddItem $w $datum } # ::ButtonListBox::AddManyItems $w $data bind $tree <> {puts "Button Press for %d" } $w config -height 20 set headers {Player "Home Runs" RBI BA Slug} set hwidths {200 70 70 70 70} set data { {"Barry Bonds" 762 1996 .298 .606} {"Hank Aaron" 755 2297 .305 .554} {"Babe Ruth" 714 2214 .342 .689} {"Alex Rodriguez" 696 2086 .294 .550} {"Willie Mays" 660 1903 .301 .557} {"Albert Pujols" 641 2004 .301 .552} {"Ken Griffey" 630 1836 .296 .537} {"Jim Thome" 612 1699 .276 .554} {"Sammy Sosa" 609 1667 .273 .533} {"Frank Robinson" 586 1812 .294 .537} {"Mark McGwire" 583 1414 .263 .588} {"Harmon Killebrew" 573 1584 .256 .508} {"Rafael Palmeiro" 569 1835 .288 .514} {"Reggie Jackson" 563 1702 .262 .490} {"Manny Ramirez" 555 1831 .312 .585} {"Mike Schmidt" 548 1595 .267 .527} {"David Ortiz" 541 1768 .286 .551} {"Mickey Mantle" 536 1509 .298 .556} {"Jimmie Foxx" 534 1922 .325 .609} {"Willie McCovey" 521 1555 .270 .514} {"Frank Thomas" 521 1704 .301 .554} {"Ted Williams" 521 1839 .344 .633} {"Ernie Banks" 512 1636 .274 .499} {"Eddie Mathews" 512 1453 .271 .509} {"Mel Ott" 511 1860 .304 .533} {"Gary Sheffield" 509 1676 .291 .513} {"Eddie Murray" 504 1917 .287 .476} } set parent .top2 destroy $parent toplevel $parent wm title $parent "Baseball 500 Home Run Club" set w [ButtonListBox::Create $parent -headers $headers -widths $hwidths -banding 0] set tree $w foreach datum $data { ::ButtonListBox::AddItem $w $datum } # ::ButtonListBox::AddManyItems $w $data bind $tree <> {puts "Button Press for %d" } $w config -height 20 } Demo } return ====== <> Keith Vetter | Tk | GUI | Widget