util/X86LINUX64/lib/tk8.6/demos/mclist.tcl

   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 if {![info exists widgetDemo]} {
   7     error "This script should be run from the \"widget\" demo."
   8 }
   9
  10 package require Tk
  11
  12 set w .mclist
  13 catch {destroy $w}
  14 toplevel $w
  15 wm title $w "Multi-Column List"
  16 wm iconname $w "mclist"
  17 positionWindow $w
  18
  19 ## Explanatory text
  20 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."
  21 pack $w.msg -fill x
  22
  23 ## See Code / Dismiss
  24 pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
  25
  26 ttk::frame $w.container
  27 ttk::treeview $w.tree -columns {country capital currency} -show headings \
  28     -yscroll "$w.vsb set" -xscroll "$w.hsb set"
  29 ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview"
  30 ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
  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
  37 image create photo upArrow -data {
  38     R0lGODlhDgAOAJEAANnZ2YCAgPz8/P///yH5BAEAAAAALAAAAAAOAA4AAAImhI+
  39     py+1LIsJHiBAh+BgmiEAJQITgW6DgUQIAECH4JN8IPqYuNxUAOw==}
  40 image create photo downArrow -data {
  41     R0lGODlhDgAOAJEAANnZ2YCAgPz8/P///yH5BAEAAAAALAAAAAAOAA4AAAInhI+
  42     py+1I4ocQ/IgDEYIPgYJICUCE4F+YIBolEoKPEJKZmVJK6ZACADs=}
  43 image create photo noArrow -height 14 -width 14
  44
  45 ## The data we're going to insert
  46 set 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
  65 set font [ttk::style lookup Heading -font]
  66 foreach col {country capital currency} name {Country Capital Currency} {
  67     $w.tree heading $col -text $name -image noArrow -anchor w \
  68         -command [list SortBy $w.tree $col 0]
  69     $w.tree column $col -width [expr {
  70         [font measure $font $name] + [image width noArrow] + 5
  71     }]
  72 }
  73 set font [ttk::style lookup Treeview -font]
  74 foreach {country capital currency} $data {
  75     $w.tree insert {} end -values [list $country $capital $currency]
  76     foreach col {country capital currency} {
  77         set len [font measure $font "[set $col]  "]
  78         if {[$w.tree column $col -width] < $len} {
  79             $w.tree column $col -width $len
  80         }
  81     }
  82 }
  83
  84 ## Code to do the sorting of the tree contents when clicked on
  85 proc SortBy {tree col direction} {
  86     # Determine currently sorted column and its sort direction
  87     foreach c {country capital currency} {
  88         set s [$tree heading $c state]
  89         if {("selected" in $s || "alternate" in $s) && $col ne $c} {
  90             # Sorted column has changed
  91             $tree heading $c -image noArrow state {!selected !alternate !user1}
  92             set direction [expr {"alternate" in $s}]
  93         }
  94     }
  95
  96     # Build something we can sort
  97     set data {}
  98     foreach row [$tree children {}] {
  99         lappend data [list [$tree set $row $col] $row]
 100     }
 101
 102     set dir [expr {$direction ? "-decreasing" : "-increasing"}]
 103     set r -1
 104
 105     # Now reshuffle the rows into the sorted order
 106     foreach info [lsort -dictionary -index 0 $dir $data] {
 107         $tree move [lindex $info 1] {} [incr r]
 108     }
 109
 110     # Switch the heading so that it will sort in the opposite direction
 111     $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]] \
 112         state [expr {$direction?"!selected alternate":"selected !alternate"}]
 113     if {[ttk::style theme use] eq "aqua"} {
 114         # Aqua theme displays native sort arrows when user1 state is set
 115         $tree heading $col state "user1"
 116     } else {
 117         $tree heading $col -image [expr {$direction?"upArrow":"downArrow"}]
 118     }
 119 }