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 / valid.tcl < prev   
Encoding:
Text File  |  2001-10-22  |  1.9 KB  |  96 lines
  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish "$0" ${1+"$@"}
  4.  
  5. ## valid.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)
  9. ##
  10. ## jeff.hobbs@acm.org
  11.  
  12. source [file join [file dirname [info script]] loadtable.tcl]
  13.  
  14. array set table {
  15.     rows    10
  16.     cols    10
  17.     table    .table
  18. }
  19.  
  20. proc colorize num {
  21.     if {$num>0 && $num%2} { return colored }
  22. }
  23.  
  24. proc fill_headers {w {r 10} {c 10}} {
  25.     for {set i 1} {$i < $r} {incr i} {
  26.     $w set $i,0 "$i"
  27.     }
  28.     for {set j 1} {$j < $c} {incr j} {
  29.     if {$j%3==1} {
  30.         $w set 0,$j AlphaNum
  31.     } elseif {$j%2==1} {
  32.         $w set 0,$j Alpha
  33.     } elseif {$j} {
  34.         $w set 0,$j Real
  35.     }
  36.     }
  37. }
  38.  
  39. proc validate {c val} {
  40.     if {$c%3==1} {
  41.     ## Alphanum
  42.     set expr {^[A-Za-z0-9 ]*$}
  43.     } elseif {$c%2==1} {
  44.     ## Alpha
  45.     set expr {^[A-Za-z ]*$}
  46.     } elseif {$c} {
  47.     ## Real
  48.     set expr {^[-+]?[0-9]*\.?[0-9]*([0-9]\.?e[-+]?[0-9]*)?$}
  49.     }
  50.     if {[regexp $expr $val]} {
  51.     return 1
  52.     } else {
  53.     bell
  54.     return 0
  55.     }
  56. }
  57.  
  58. label .example -text "TkTable v1 Validated Table Example"
  59.  
  60. set t $table(table)
  61. table $t \
  62.     -rows $table(rows) \
  63.     -cols $table(cols) \
  64.     -cache 1 \
  65.     -titlerows 1 \
  66.     -titlecols 1 \
  67.     -yscrollcommand { .tsy set } \
  68.     -xscrollcommand { .tsx set } \
  69.     -width 5 -height 5 \
  70.     -coltagcommand colorize \
  71.     -flashmode on \
  72.     -selectmode extended \
  73.     -colstretch unset \
  74.     -rowstretch unset \
  75.     -validate yes \
  76.     -vcmd {if {![%W tag includes title %C]} { validate %c %S } }
  77.  
  78. fill_headers $t
  79. $t tag config colored -bg lightblue
  80. $t tag config title -fg red
  81. $t width 0 3
  82.  
  83. scrollbar .tsy -command [list $t yview]
  84. scrollbar .tsx -command [list $t xview] -orient horizontal
  85. button .exit -text "Exit" -command {exit}
  86.  
  87. grid .example -     -sticky ew
  88. grid $t       .tsy   -sticky news
  89. grid .tsx            -sticky ew
  90. grid .exit - -sticky ew
  91. grid columnconfig . 0 -weight 1
  92. grid rowconfig . 1 -weight 1
  93.  
  94. puts [list Table is $table(table)]
  95.  
  96.