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