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 / dynarows.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  2.3 KB  |  88 lines
  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish "$0" ${1+"$@"}
  4.  
  5. ## dynarows.tcl
  6. ##
  7. ## This demos shows the use of the validation mechanism of the table
  8. ## and uses the table's cache (no -command or -variable) with a cute
  9. ## dynamic row routine.
  10. ##
  11. ## jeff.hobbs@acm.org
  12.  
  13. source [file join [file dirname [info script]] loadtable.tcl]
  14.  
  15. proc table_validate {w idx} {
  16.     if {[scan $idx %d,%d row col] != 2} return
  17.     set val [$w get $idx]
  18.  
  19.     ## Entries in the last row are allowed to be empty
  20.     set nrows [$w cget -rows]
  21.     if {$row == ${nrows}-1 && [string match {} $val]} { return }
  22.  
  23.     if {[catch {clock scan $val} time]} {
  24.         bell
  25.         $w activate $idx
  26.         $w selection clear all
  27.         $w selection set active
  28.         $w see active
  29.     } else {
  30.         set date {}
  31.         foreach item [clock format $time -format "%m %d %Y"] {
  32.             lappend date [string trimleft $item "0"]
  33.         }
  34.         $w set $idx [join $date "/"]
  35.         if {$row == ${nrows}-1} {
  36.         ## if this is the last row and both cols 1 && 2 are not empty
  37.         ## then add a row and redo configs
  38.             if {[string comp [$w get $row,1] {}] && \
  39.                     [string comp [$w get $row,2] {}]} {
  40.         $w tag row {} $row
  41.         $w set $row,0 $row
  42.                 $w configure -rows [incr nrows]
  43.         $w tag row unset [incr row]
  44.         $w set $row,0 "*"
  45.                 $w see $row,1
  46.         $w activate $row,1
  47.             }
  48.         }
  49.     }
  50. }
  51.  
  52. label .example -text "Dynamic Date Validated Rows"
  53.  
  54. set t .table
  55. table $t -rows 2 -cols 3 -cache 1 -selecttype row \
  56.     -titlerows 1 -titlecols 1 \
  57.     -yscrollcommand { .sy set } \
  58.     -xscrollcommand { .sx set } \
  59.     -height 5 -colstretch unset -rowstretch unset \
  60.     -autoclear 1 -browsecommand {table_validate %W %s}
  61.  
  62. $t set 0,1 "Begin" 0,2 "End" 1,0 "*"
  63. $t tag config unset -fg \#008811
  64. $t tag config title -fg red
  65. $t tag row unset 1
  66. $t width 0 3
  67.  
  68. scrollbar .sy -command [list $t yview]
  69. scrollbar .sx -command [list $t xview] -orient horizontal
  70. grid .example -     -sticky ew
  71. grid $t       .sy   -sticky news
  72. grid .sx            -sticky ew
  73. grid columnconfig . 0 -weight 1
  74. grid rowconfig . 1 -weight 1
  75.  
  76. bind $t <Return> {
  77.     set r [%W index active row]
  78.     set c [%W index active col]
  79.     if {$c == 2} {
  80.     %W activate [incr r],1
  81.     } else {
  82.     %W activate $r,[incr c]
  83.     }
  84.     %W see active
  85.     break
  86. }
  87. bind $t <KP_Enter> [bind $t <Return>]
  88.