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 / buttons.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  1.9 KB  |  83 lines
  1. #!/bin/sh
  2. # next line is a comment in tcl \
  3. exec wish "$0" ${1+"$@"}
  4.  
  5. ## buttons.tcl
  6. ##
  7. ## demonstrates the simulation of a button array
  8. ##
  9. ## ellson@lucent.com
  10. ## modifications made by jeff.hobbs@acm.org
  11.  
  12. source [file join [file dirname [info script]] loadtable.tcl]
  13.  
  14. array set table {
  15.     rows    20
  16.     cols    20
  17.     table    .table
  18. }
  19.  
  20. # create the table
  21. set t $table(table)
  22. table $t -rows [expr {$table(rows)+1}] -cols [expr {$table(cols)+1}] \
  23.     -titlerows  1 -titlecols  1 \
  24.     -roworigin -1 -colorigin -1 \
  25.     -colwidth 4 \
  26.     -width 8 -height 8 \
  27.     -variable tab \
  28.     -flashmode off \
  29.     -cursor top_left_arrow \
  30.     -borderwidth 2 \
  31.     -state disabled \
  32.     -xscrollcommand ".sx set" -yscrollcommand ".sy set"
  33.  
  34. scrollbar .sx -orient h -command "$t xview"
  35. scrollbar .sy -orient v -command "$t yview"
  36.  
  37. grid $t .sy -sticky nsew
  38. grid .sx -sticky ew
  39. grid columnconfig . 0 -weight 1
  40. grid rowconfig . 0 -weight 1
  41.  
  42. # set up tags for the various states of the buttons
  43. $t tag configure OFF -bg red -relief raised
  44. $t tag configure ON  -bg green -relief sunken
  45. $t tag configure sel -bg gray75 -relief flat
  46.  
  47. # clean up if mouse leaves the widget
  48. bind $t <Leave> {
  49.     %W selection clear all
  50. }
  51.  
  52. # highlight the cell under the mouse
  53. bind $t <Motion> {
  54.     if {[%W selection includes @%x,%y]} break
  55.     %W selection clear all
  56.     %W selection set @%x,%y
  57.     break
  58.     ## "break" prevents the call to tkTableCheckBorder
  59. }
  60.  
  61. # mousebutton 1 toggles the value of the cell
  62. # use of "selection includes" would work here
  63. bind $t <1> {
  64.     set rc [%W cursel]
  65.     if {[string match ON $tab($rc)]} {
  66.     set tab($rc) OFF
  67.         %W tag celltag OFF $rc
  68.     } {
  69.     set tab($rc) ON
  70.         %W tag celltag ON $rc
  71.     }
  72. }
  73.  
  74. # inititialize the array, titles, and celltags
  75. for {set i 0} {$i < $table(rows)} {incr i} {
  76.     set tab($i,-1) $i
  77.     for {set j 0} {$j < $table(cols)} {incr j} {
  78.         if {! $i} {set tab(-1,$j) $j}
  79.     set tab($i,$j) "OFF"
  80.         $t tag celltag OFF $i,$j
  81.     }
  82. }
  83.