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 / debug.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  3.2 KB  |  113 lines
  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish "$0" ${1+"$@"}
  4.  
  5. ## version2.tcl
  6. ##
  7. ## This demo uses most features 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    25
  15.     cols    20
  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 colProc col { if {$col > 0 && $col % 2} { return OddCol } }
  29.  
  30. label .label -text "TkTable v2 Example"
  31.  
  32. fill $table(array) $table(rows) $table(cols)
  33. table $table(table) \
  34.     -rows $table(rows) -cols $table(cols) \
  35.     -variable $table(array) \
  36.     -width 6 -height 8 \
  37.     -titlerows 1 -titlecols 2 \
  38.     -roworigin -5 -colorigin -2 \
  39.     -yscrollcommand {.sy set} \
  40.     -xscrollcommand {.sx set} \
  41.     -coltagcommand colProc \
  42.     -selectmode extended \
  43.     -rowstretch unset \
  44.     -colstretch unset \
  45.     -selecttitles 0 \
  46.     -drawmode single
  47.  
  48. scrollbar .sy -command [list $table(table) yview]
  49. scrollbar .sx -command [list $table(table) xview] -orient horizontal
  50. button .exit -text "Exit" -command {exit}
  51. grid .label - -sticky ew
  52. grid $table(table) .sy -sticky news
  53. grid .sx -sticky ew
  54. grid .exit -sticky ew -columnspan 2
  55. grid columnconfig . 0 -weight 1
  56. grid rowconfig . 1 -weight 1
  57.  
  58. $table(table) tag config OddCol -bg brown -fg pink
  59. $table(table) tag config title -bg red -fg green -relief sunken
  60. $table(table) tag config dis -state disabled
  61.  
  62. set i -1
  63. set first [$table(table) cget -colorigin]
  64. foreach anchor {n s e w nw ne sw se c} {
  65.     $table(table) tag config $anchor -anchor $anchor
  66.     $table(table) tag row $anchor [incr i]
  67.     $table(table) set $i,$first $anchor
  68. }
  69. font create courier -family Courier -size 10
  70. $table(table) tag config s -font courier -justify center
  71.  
  72. image create photo logo \
  73.     -file [file join [file dirname [info script]] tcllogo.gif]
  74. $table(table) tag config logo -image logo -showtext 1
  75. $table(table) tag cell logo 1,2 2,3 4,1
  76. $table(table) tag cell dis 2,1 1,-1 3,0
  77. $table(table) width -2 8 -1 9 0 12 4 14
  78.  
  79. $table(table) set \
  80.     1,1 "multi-line\ntext\nmight be\ninteresting" \
  81.     3,2 "more\nmulti-line\nplaying\n" \
  82.     2,2 "null\0byte"
  83.  
  84. set i -1
  85.  
  86. # This is in the row span
  87. set l [label $table(table).s -text "Window s" -bg yellow]
  88. $table(table) window config 6,0 -sticky s -window $l
  89.  
  90. # This is in the row titles
  91. set l [label $table(table).ne -text "Window ne" -bg yellow]
  92. $table(table) window config 4,-1 -sticky ne -window $l
  93.  
  94. # This will get swallowed by a span
  95. set l [label $table(table).ew -text "Window ew" -bg yellow]
  96. $table(table) window config 5,3 -sticky ew -window $l
  97.  
  98. # This is in the col titles
  99. set l [label $table(table).news -text "Window news" -bg yellow]
  100. $table(table) window config -5,1 -sticky news -window $l
  101.  
  102. set l [label [winfo parent $table(table)].l -text "Sibling l" -bg orange]
  103. $table(table) window config 5,1 -sticky news -window $l
  104.  
  105. if {![catch {$table(table) span}]} {
  106.     $table(table) span -1,-2 0,3 1,2 0,5 3,2 2,2 6,0 4,0
  107. }
  108.  
  109. puts [list Table is $table(table) with array [$table(table) cget -var]]
  110.  
  111. #$table(table) postscript -file out.ps -first origin -last 2,2
  112. #if {[string match {} [info commands tkcon]]} exit
  113.