home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / demos / Tktable / basic.tcl next >
Encoding:
Text File  |  2001-10-22  |  1.6 KB  |  62 lines
  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish "$0" ${1+"$@"}
  4.  
  5. ## basic.tcl
  6. ##
  7. ## This demo shows the basic use of the table widget
  8. ##
  9. ## jeff.hobbs@acm.org
  10.  
  11. source [file join [file dirname [info script]] loadtable.tcl]
  12.  
  13. array set table {
  14.     rows    8
  15.     cols    8
  16.     table    .t
  17.     array    t
  18. }
  19.  
  20. proc 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
  28. proc rowProc row { if {$row>0 && $row%2} { return OddRow } }
  29. proc colProc col { if {$col>0 && $col%2} { return OddCol } }
  30.  
  31. label .label -text "TkTable v1 Example"
  32.  
  33. fill $table(array) $table(rows) $table(cols)
  34. table $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.  
  44. scrollbar .sy -command [list $table(table) yview]
  45. scrollbar .sx -command [list $table(table) xview] -orient horizontal
  46. button .exit -text "Exit" -command {exit}
  47.  
  48. grid .label - -sticky ew
  49. grid $table(table) .sy -sticky news
  50. grid .sx -sticky ew
  51. grid .exit -sticky ew -columnspan 2
  52. grid columnconfig . 0 -weight 1
  53. grid 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.  
  60. puts [list Table is $table(table) with array [$table(table) cget -var]]
  61.  
  62.