Version 5 of Tile Table

Updated 2008-03-21 14:11:41 by kpv

Keith Vetter 2008-03-21 : Here's yet another example of creating a table in tk. This one uses tile and is based off code from "A multi-columned list of countries" from the tcl 8.5 demo.

You can't do spans or fancy text formatting, but it does let you sort any column by clicking on the header.


##+##########################################################################
#
# tileTable.tcl -- Creates multi-column table using tile's treeview widget
# by Keith Vetter, March 21, 2008
#

package require Tk
package require tile

namespace eval ::TileTable {}
proc ::TileTable::Create {w headers data} {
    
    ::ttk::treeview $w.tree -columns $headers -show headings \
        -yscroll "$w.vsb set" -xscroll "$w.hsb set" -selectmode browse
    scrollbar $w.vsb -orient vertical -command "$w.tree yview"
    scrollbar $w.hsb -orient horizontal -command "$w.tree xview"

    grid $w.tree $w.vsb -sticky nsew
    grid $w.hsb          -sticky nsew
    grid column $w 0 -weight 1
    grid row    $w 0 -weight 1

    set font [::ttk::style lookup [$w.tree cget -style] -font]
    foreach col $headers {
        set name [string totitle $col]
        $w.tree heading $col -text $name \
            -command [list ::TileTable::SortBy $w.tree $col 0] 
        $w.tree column $col -anchor c -width [font measure $font xxx$name]
    }

    set lnum -1
    foreach datum $data {
        $w.tree insert {} end -values $datum -tag tag[incr lnum]

        # Fix up column widths
        foreach col $headers value $datum {
            if {$col eq ""} break
            set len [font measure $font "$value  "]
            if {[$w.tree column $col -width] < $len} {
                $w.tree column $col -width $len
            }
        }
    }
    ::TileTable::BandTable $w.tree
}

## Code to do the sorting of the tree contents when clicked on
proc ::TileTable::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 ::TileTable::SortBy $tree $col [expr {!$direction}]]
    ::TileTable::BandTable $tree
}
proc ::TileTable::BandTable {tree} {
    array set colors {0 white 1 \#aaffff}

    set id 1
    foreach row [$tree children {}] {
	set id [expr {! $id}]
	set tag [$tree item $row -tag]
	$tree tag configure $tag -background $colors($id)
    }
}

###############
#
# Demo code
#
set headers {country capital currency}
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}
}
toplevel .top
::TileTable::Create .top $headers $data
return