[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 <<ButtonListBoxPress>> event.
I've included a demo to show how to use it.
see also [CheckedListBox Widget]
----[Jeff Smith] 2019-06-10 : Below is an online demo using [CloudTk]. Please note the online demo does not display the <<ButtonListBoxPress>> {puts "Button Press for %d" } as it appears on the TTY terminal of the [CloudTk] server. Also click on the "V" in the top left corner to display "Baseball 500 Home Run Club"
<<inlinehtml>>
<iframe height="6500" width="650" src="https://cloudtk-app.tcl-lang.org/cloudtk/VNC?session=new&Tk=Multi-column-Listbox-with-Button" allowfullscreen></iframe>
<<inlinehtml>>
----
======
##+##########################################################################
#
# button_listbox.tcl -- Multicolumn list box with column 0 a button
# image which generates <<ButtonListBoxPress>> 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 <<ButtonListBoxPress>> {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 <<TreeviewSelect>> {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 <<ButtonListBoxPress>> -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 <<ButtonListBoxPress>> {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 <<ButtonListBoxPress>> {puts "Button Press for %d" }
$w config -height 20
}
Demo
}
return
======
<<categories>> Keith Vetter | Tk | GUI | Widget