Posted to tcl by Gerry at Tue Dec 04 01:25:43 GMT 2007view raw

  1. proc leftarrow thetable {
  2. if {$::incell} {
  3. $thetable icursor [expr {[$thetable icursor]-1}]
  4. return -code break
  5. }
  6. }
  7.  
  8. proc rightarrow thetable {
  9. if {$::incell} {
  10. $thetable icursor [expr {[$thetable icursor]+1}]
  11. return -code break
  12. }
  13. }
  14.  
  15. proc ttbrowsecmd thetable {
  16. set ::incell false
  17. .tktabtest.e configure -validate none
  18. .tktabtest.e delete 0 end
  19. .tktabtest.e insert 0 [$thetable get active]
  20. .tktabtest.e configure -validate key
  21. }
  22.  
  23. proc ttvcmd {thetable newcontent index} {
  24. if {[string equal [string index $newcontent $index] \n]} {
  25. event generate $thetable <Key-Down>
  26. return false
  27. }
  28. set ::incell true
  29. .tktabtest.e configure -validate none
  30. .tktabtest.e delete 0 end
  31. .tktabtest.e insert 0 $newcontent
  32. .tktabtest.e configure -validate key
  33. return true
  34. }
  35.  
  36. # First argument not used in example but needed in my app.
  37. proc tevcmd {theentry newcontent newchar} {
  38. if {[string equal $newchar \n]} {
  39. event generate .tktabtest.t <Key-Down>
  40. return false
  41. }
  42. .tktabtest.t set active $newcontent
  43. return true
  44. }
  45.  
  46. # First argument not used in example but needed in my app.
  47. proc entryreturn theentry {
  48. focus .tktabtest.t
  49. event generate .tktabtest.t <Key-Down>
  50. }
  51.  
  52. catch {destroy .tktabtest}
  53. set t [toplevel .tktabtest]
  54. pack [entry $t.e -width 30 -validate none -vcmd [list tevcmd %W %P %S]] \
  55. [table $t.t -variable tt -multiline false -browsecmd [list ttbrowsecmd %W ] \
  56. -validate true -vcmd [list ttvcmd %W %S %i]]
  57. array set tt [list 1,1 asdf 1,2 qwert 2,1 zxcv 2,2 1234567890123456789]
  58. # $t.t tag configure active -relief {}
  59. $t.t tag configure active -fg black
  60. bind $t.t <Button-1> {set ::incell true}
  61. bind $t.t <Key-Left> [list leftarrow %W]
  62. bind $t.t <Key-Right> [list rightarrow %W]
  63. bind $t.e <Return> [list entryreturn %W]
  64.  
  65.