mclist.tcl 4.0 KB

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