1# mclist.tcl -- 2# 3# This demonstration script creates a toplevel window containing a Ttk 4# tree widget configured as a multi-column listbox. 5# 6# RCS: @(#) $Id$ 7 8if {![info exists widgetDemo]} { 9 error "This script should be run from the \"widget\" demo." 10} 11 12package require Tk 13package require Ttk 14 15set w .mclist 16catch {destroy $w} 17toplevel $w 18wm title $w "Multi-Column List" 19wm iconname $w "mclist" 20positionWindow $w 21 22## Explanatory text 23ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -padding {10 2 10 6} -text "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which can be configured to display multiple columns of informational data without displaying the tree itself. This is a simple way to build a listbox that has multiple columns. Clicking on the heading for a column will sort the data by that column. You can also change the width of the columns by dragging the boundary between them." 24pack $w.msg -fill x 25 26## See Code / Dismiss 27pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x 28 29ttk::frame $w.container 30ttk::treeview $w.tree -columns {country capital currency} -show headings \ 31 -yscroll "$w.vsb set" -xscroll "$w.hsb set" 32if {[tk windowingsystem] ne "aqua"} { 33 ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" 34 ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" 35} else { 36 scrollbar $w.vsb -orient vertical -command "$w.tree yview" 37 scrollbar $w.hsb -orient horizontal -command "$w.tree xview" 38} 39pack $w.container -fill both -expand 1 40grid $w.tree $w.vsb -in $w.container -sticky nsew 41grid $w.hsb -in $w.container -sticky nsew 42grid column $w.container 0 -weight 1 43grid row $w.container 0 -weight 1 44 45## The data we're going to insert 46set data { 47 Argentina {Buenos Aires} ARS 48 Australia Canberra AUD 49 Brazil Brazilia BRL 50 Canada Ottawa CAD 51 China Beijing CNY 52 France Paris EUR 53 Germany Berlin EUR 54 India {New Delhi} INR 55 Italy Rome EUR 56 Japan Tokyo JPY 57 Mexico {Mexico City} MXN 58 Russia Moscow RUB 59 {South Africa} Pretoria ZAR 60 {United Kingdom} London GBP 61 {United States} {Washington, D.C.} USD 62} 63 64## Code to insert the data nicely 65set font [ttk::style lookup [$w.tree cget -style] -font] 66foreach col {country capital currency} name {Country Capital Currency} { 67 $w.tree heading $col -command [list SortBy $w.tree $col 0] -text $name 68 $w.tree column $col -width [font measure $font $name] 69} 70foreach {country capital currency} $data { 71 $w.tree insert {} end -values [list $country $capital $currency] 72 foreach col {country capital currency} { 73 set len [font measure $font "[set $col] "] 74 if {[$w.tree column $col -width] < $len} { 75 $w.tree column $col -width $len 76 } 77 } 78} 79 80## Code to do the sorting of the tree contents when clicked on 81proc SortBy {tree col direction} { 82 # Determine currently sorted column and its sort direction 83 foreach c {country capital currency} { 84 set s [$tree heading $c state] 85 if {("selected" in $s || "alternate" in $s) && $col ne $c} { 86 # Sorted column has changed 87 $tree heading $c state {!selected !alternate !user1} 88 set direction [expr {"alternate" in $s}] 89 } 90 } 91 92 # Build something we can sort 93 set data {} 94 foreach row [$tree children {}] { 95 lappend data [list [$tree set $row $col] $row] 96 } 97 98 set dir [expr {$direction ? "-decreasing" : "-increasing"}] 99 set r -1 100 101 # Now reshuffle the rows into the sorted order 102 foreach info [lsort -dictionary -index 0 $dir $data] { 103 $tree move [lindex $info 1] {} [incr r] 104 } 105 106 # Switch the heading so that it will sort in the opposite direction 107 $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]] \ 108 state [expr {$direction?"!selected alternate":"selected !alternate"}] 109 if {[tk windowingsystem] eq "aqua"} { 110 # Aqua theme displays native sort arrows when user1 state is set 111 $tree heading $col state "user1" 112 } 113} 114