diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | library/demos/mclist.tcl | 98 | ||||
| -rw-r--r-- | library/demos/widget | 4 |
3 files changed, 106 insertions, 1 deletions
@@ -1,3 +1,8 @@ +2007-11-02 Donal K. Fellows <dkf@users.sf.net> + + * library/demos/mclist.tcl: Added a demo of how to do a multi-column + sortable listbox. + 2007-11-02 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> * library/msgbox.tcl: Made message dialog use Ttk widgets for better diff --git a/library/demos/mclist.tcl b/library/demos/mclist.tcl new file mode 100644 index 0000000..ed2f55a --- /dev/null +++ b/library/demos/mclist.tcl @@ -0,0 +1,98 @@ +# mclist.tcl -- +# +# This demonstration script creates a toplevel window containing a Ttk +# tree widget configured as a multi-column listbox. +# +# RCS: @(#) $Id: mclist.tcl,v 1.1 2007/11/02 23:48:11 dkf Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk +package require Ttk + +set w .mclist +catch {destroy $w} +toplevel $w +wm title $w "Multi-Column List" +wm iconname $w "mclist" +positionWindow $w + +## Explanatory text +ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -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." +pack $w.msg -fill x + +## See Code / Dismiss +pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x + +ttk::frame $w.container +ttk::treeview $w.tree -columns {country capital currency} -show headings \ + -yscroll "$w.vsb set" -xscroll "$w.hsb set" +if {[tk windowingsystem] ne "aqua"} { + ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" + ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" +} else { + scrollbar $w.vsb -orient vertical -command "$w.tree yview" + scrollbar $w.hsb -orient horizontal -command "$w.tree xview" +} +pack $w.container -fill both -expand 1 +grid $w.tree $w.vsb -in $w.container -sticky nsew +grid $w.hsb -in $w.container -sticky nsew +grid column $w.container 0 -weight 1 +grid row $w.container 0 -weight 1 + +## The data we're going to insert +set data { + Argentina {Buenos Aires} ARS + Australia Canberra AUD + Brazil Brazilia BRL + Canada Ottawa CAD + China Beijing CNY + France Paris EUR + Germany Berlin EUR + India {New Delhi} INR + Italy Rome EUR + Japan Tokyo JPY + Mexico {Mexico City} MXN + Russia Moscow RUB + {South Africa} Pretoria ZAR + {United Kingdom} London GBP + {United States} {Washington, D.C.} USD +} + +## Code to insert the data nicely +set font [ttk::style lookup [$w.tree cget -style] -font] +foreach col {country capital currency} name {Country Capital Currency} { + $w.tree heading $col -command [list SortBy $w.tree $col 0] -text $name + $w.tree column $col -width [font measure $font $name] +} +foreach {country capital currency} $data { + $w.tree insert {} end -values [list $country $capital $currency] + foreach col {country capital currency} { + set len [font measure $font "[set $col] "] + if {[$w.tree column $col -width] < $len} { + $w.tree column $col -width $len + } + } +} + +## Code to do the sorting of the tree contents when clicked on +proc SortBy {tree col direction} { + # Build something we can sort + set data {} + foreach row [$tree children {}] { + lappend data [list [$tree set $row $col] $row] + } + + set dir [expr {$direction ? "-decreasing" : "-increasing"}] + set r -1 + + # Now reshuffle the rows into the sorted order + foreach info [lsort -dictionary -index 0 $dir $data] { + $tree move [lindex $info 1] {} [incr r] + } + + # Switch the heading so that it will sort in the opposite direction + $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]] +} diff --git a/library/demos/widget b/library/demos/widget index 333e29a..6bcb0c6 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -10,7 +10,7 @@ exec wish "$0" "$@" # separate ".tcl" files is this directory, which are sourced by this script as # needed. # -# RCS: @(#) $Id: widget,v 1.44 2007/11/01 11:34:00 das Exp $ +# RCS: @(#) $Id: widget,v 1.45 2007/11/02 23:48:11 dkf Exp $ package require Tcl 8.5 package require Tk 8.5 @@ -329,6 +329,8 @@ addFormattedText { @@demo colors Colors: change the color scheme for the application @@demo sayings A collection of famous and infamous sayings @@new + @@demo mclist A multi-column list of countries + @@new @@demo tree A directory browser tree @@subtitle Entries, Spin-boxes and Combo-boxes |