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 / spreadsheet.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  3.0 KB  |  123 lines
  1. #!/bin/sh
  2. # the next line restarts using wish \
  3.     exec wish "$0" ${1+"$@"}
  4.  
  5. ## spreadsheet.tcl
  6. ##
  7. ## This demos shows how you can simulate a 3D table
  8. ## and has other basic features to begin a basic spreadsheet
  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.     page    AA
  18.     table    .table
  19.     default    pink
  20.     AA        orange
  21.     BB        blue
  22.     CC        green
  23. }
  24.  
  25. proc colorize num { if {$num>0 && $num%2} { return colored } }
  26.  
  27. proc fill {array {r 10} {c 10}} {
  28.     upvar \#0 $array ary
  29.     for {set i 0} {$i < $r} {incr i} {
  30.     for {set j 0} {$j < $c} {incr j} {
  31.         if {$j && $i} {
  32.         set ary($i,$j) "$array $i,$j"
  33.         } elseif {$i} {
  34.         set ary($i,$j) "$i"
  35.         } elseif {$j} {
  36.         set ary($i,$j) [format %c [expr 64+$j]]
  37.         }
  38.     }
  39.     }
  40. }
  41.  
  42. proc changepage {w e name el op} {
  43.     global $name table
  44.     if {[string comp {} $el]} { set name [list $name\($el\)] }
  45.     set i [set $name]
  46.     if {[string comp $i [$w cget -var]]} {
  47.     $w sel clear all
  48.     $w config -variable $i
  49.     $e config -textvar ${i}(active)
  50.     $w activate origin
  51.     if {[info exists table($i)]} {
  52.         $w tag config colored -bg $table($i)
  53.     } else {
  54.         $w tag config colored -bg $table(default)
  55.     }
  56.     $w see active
  57.     }
  58. }
  59.  
  60. label .example -text "TkTable v1 Spreadsheet Example"
  61.  
  62. label .current -textvar table(current) -width 5
  63. entry .active -textvar $table(page)(active)
  64. label .lpage -text "PAGE:" -width 6 -anchor e
  65. tk_optionMenu .page table(page) AA BB CC DD
  66.  
  67. fill $table(page)
  68. fill BB [expr {$table(rows)/2}] [expr {$table(cols)/2}]
  69.  
  70. trace var table(page) w [list changepage $table(table) .active]
  71.  
  72. set t $table(table)
  73. table $t \
  74.     -rows $table(rows) \
  75.     -cols $table(cols) \
  76.     -variable $table(page) \
  77.     -titlerows 1 \
  78.     -titlecols 1 \
  79.     -yscrollcommand { .sy set } \
  80.     -xscrollcommand { .sx set } \
  81.     -coltagcommand colorize \
  82.     -flashmode on \
  83.     -selectmode extended \
  84.     -colstretch unset \
  85.     -rowstretch unset \
  86.     -width 5 -height 5 \
  87.     -browsecommand {set table(current) %S}
  88.  
  89. $t tag config colored -bg $table($table(page))
  90. $t tag config title -fg red -relief groove
  91. $t tag config blue -bg blue
  92. $t tag config green -bg green
  93. $t tag cell green 6,3 5,7 4,9
  94. $t tag cell blue 8,8
  95. $t tag row blue 7
  96. $t tag col blue 6 8
  97. $t width 0 3 2 7
  98.  
  99. scrollbar .sy -command [list $t yview]
  100. scrollbar .sx -command [list $t xview] -orient horizontal
  101. button .exit -text "Exit" -command exit
  102.  
  103. grid .example -       -      -     -   -sticky ew
  104. grid .current .active .lpage .page -   -sticky ew
  105. grid $t       -       -      -     .sy -sticky ns
  106. grid .sx      -       -      -         -sticky ew
  107. grid .exit - - - - -sticky ew
  108. grid columnconfig . 1 -weight 1
  109. grid rowconfig . 2 -weight 1
  110. grid config $t -sticky news
  111.  
  112. bind .active <Return> [list tkTableMoveCell $t 1 0]
  113.  
  114. menu .menu
  115. menu .menu.file
  116. . config -menu .menu
  117. .menu add cascade -label "File" -underline 0 -menu .menu.file
  118. .menu.file add command -label "Fill Array" -command { fill $table(page) }
  119. .menu.file add command -label "Quit" -command exit
  120.  
  121. puts [list Table is $table(table) with array [$table(table) cget -var]]
  122.  
  123.