Tile Table

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.

KPV 2008-06-03 : Added arrows to the column headers to visually indicate that the column is sorted in a given direction.


Jeff Smith 2019-06-10 : Below is an online demo using CloudTk



##+##########################################################################
#
# tileTable.tcl -- Creates multi-column table using tile's treeview widget
# by Keith Vetter, March 21, 2008
# KPV Jun 03, 2008 - added sort arrows on column headers
#

package require Tk
package require tile

namespace eval ::TileTable {}

image create bitmap ::TileTable::arrow(0) -data {
    #define arrowUp_width 7
    #define arrowUp_height 4
    static char arrowUp_bits[] = {
        0x08, 0x1c, 0x3e, 0x7f
    };
}
image create bitmap ::TileTable::arrow(1) -data {
    #define arrowDown_width 7
    #define arrowDown_height 4
    static char arrowDown_bits[] = {
        0x7f, 0x3e, 0x1c, 0x08
    };
}
image create bitmap ::TileTable::arrowBlank -data {
    #define arrowBlank_width 7
    #define arrowBlank_height 4
    static char arrowBlank_bits[] = {
        0x00, 0x00, 0x00, 0x00
    };
}
##+##########################################################################
# 
# ::TileTable::Create -- Creates a new tile table widget
# 
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 -image ::TileTable::arrowBlank \
            -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
}
##+##########################################################################
# 
# ::TileTable::SortBy -- Code to sort tree content when clicked on a header
# 
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
    set cmd [list ::TileTable::SortBy $tree $col [expr {!$direction}]]
    $tree heading $col -command $cmd
    ::TileTable::BandTable $tree
    ::TileTable::ArrowHeadings $tree $col $direction
}
##+##########################################################################
# 
# ::TileTable::ArrowHeadings -- Puts in up/down arrows to show sorting
# 
proc ::TileTable::ArrowHeadings {tree sortCol dir} {
    set idx -1
    foreach col [$tree cget -columns] {
        incr idx
        set img ::TileTable::arrowBlank
        if {$col == $sortCol} {
            set img ::TileTable::arrow($dir)
        }
        $tree heading $idx -image $img
    }
}
##+##########################################################################
# 
# ::TileTable::BandTable -- Draws bands on our table
# 
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
set tree .top.tree
return

LES on 2023-05-24: I tried to create another image and use it with the -image option in the 'insert' line (there is only one), but the image won't show. Do images only work for headings?