1#!/bin/sh 2# the next line restarts using wish \ 3exec wish "$0" ${1+"$@"} 4 5## basic.tcl 6## 7## This demo shows the basic use of the table widget 8## 9## jeff at hobbs org 10 11source [file join [file dirname [info script]] loadtable.tcl] 12 13array set table { 14 rows 8 15 cols 8 16 table .t 17 array t 18} 19 20proc fill { array x y } { 21 upvar $array f 22 for {set i -$x} {$i<$x} {incr i} { 23 for {set j -$y} {$j<$y} {incr j} { set f($i,$j) "r$i,c$j" } 24 } 25} 26 27## Test out the use of a procedure to define tags on rows and columns 28proc rowProc row { if {$row>0 && $row%2} { return OddRow } } 29proc colProc col { if {$col>0 && $col%2} { return OddCol } } 30 31label .label -text "TkTable v1 Example" 32 33fill $table(array) $table(rows) $table(cols) 34table $table(table) -rows $table(rows) -cols $table(cols) \ 35 -variable $table(array) \ 36 -width 6 -height 6 \ 37 -titlerows 1 -titlecols 2 \ 38 -roworigin -1 -colorigin -2 \ 39 -yscrollcommand {.sy set} -xscrollcommand {.sx set} \ 40 -rowtagcommand rowProc -coltagcommand colProc \ 41 -colstretchmode last -rowstretchmode last \ 42 -selectmode extended -sparsearray 0 43 44scrollbar .sy -command [list $table(table) yview] 45scrollbar .sx -command [list $table(table) xview] -orient horizontal 46button .exit -text "Exit" -command {exit} 47 48grid .label - -sticky ew 49grid $table(table) .sy -sticky news 50grid .sx -sticky ew 51grid .exit -sticky ew -columnspan 2 52grid columnconfig . 0 -weight 1 53grid rowconfig . 1 -weight 1 54 55$table(table) tag config OddRow -bg orange -fg purple 56$table(table) tag config OddCol -bg brown -fg pink 57 58$table(table) width -2 7 -1 7 1 5 2 8 4 14 59 60puts [list Table is $table(table) with array [$table(table) cget -var]] 61 62