Posted to tcl by emiliano at Tue Sep 30 20:26:00 GMT 2008view raw

  1. package require Tk 8.5
  2.  
  3. namespace eval ttk {
  4.  
  5. namespace eval spinbox {}
  6.  
  7. image create bitmap ttk::spinbox::up -data {
  8. #define up_width 7
  9. #define up_height 4
  10. static unsigned char up_bits[] = {
  11. 0x08, 0x1c, 0x3e, 0x7f};
  12. }
  13.  
  14. image create bitmap ttk::spinbox::down -data {
  15. #define down_width 7
  16. #define down_height 4
  17. static unsigned char down_bits[] = {
  18. 0x7f, 0x3e, 0x1c, 0x08};
  19. }
  20.  
  21. ttk::style configure TSpinbox.Toolbutton -padding 0
  22.  
  23. option add *TSpinbox.TButton.style TSpinbox.Toolbutton
  24. option add *TSpinbox.TButton.takeFocus 0
  25. option add *TSpinbox.u.image ttk::spinbox::up
  26. option add *TSpinbox.d.image ttk::spinbox::down
  27. }
  28.  
  29.  
  30. proc ttk::spinbox {w args} {
  31. # check whether $w exists
  32. if {[winfo exists $w]} {
  33. error "$w already exists in parent"
  34. }
  35.  
  36. # create a namespace to hold private variables
  37. namespace eval ttk::spinbox::${w} {
  38. variable widget
  39. array set widget {}
  40. }
  41.  
  42. # create the widget
  43. ttk::frame $w -class TSpinbox
  44. set e [ttk::entry $w.e]
  45. set u [ttk::button $w.u]
  46. set d [ttk::button $w.d]
  47.  
  48. grid $e $u -sticky news
  49. grid ^ $d -sticky news
  50.  
  51. grid columnconfigure $w 0 -weight 1
  52.  
  53. bind $w <<ThemeChanged>> {
  54. ttk::style configure TSpinbox.Toolbutton -padding 0
  55. }
  56.  
  57. # move all instance commands to the private namespace
  58. rename $w [namespace current]::${w}::${w}
  59.  
  60. # install our custom widget command
  61. proc $w args [list [namespace current]::instancecmd $w {*}$args]
  62.  
  63. # return the newly created widget name
  64. return $w
  65. }
  66.  
  67. proc ttk::spinbox::instancecmd {w args} {
  68.  
  69. }
  70.  
  71. proc ttk::spinbox::configurecmd {args} {
  72.  
  73. }
  74.  
  75. proc ttk::spinbox::destroycmd {w} {
  76. namespace delete ttk::spinbox::${w}
  77. }
  78.  
  79.  
  80.  
  81.  
  82. # test
  83. if 1 {
  84.  
  85. set i 0
  86. foreach theme [ttk::themes] {
  87. after [expr {5000 * [incr i]} ] [list ttk::setTheme $theme]
  88. puts $theme
  89. }
  90.  
  91. place [ttk::frame .bf] -x 0 -y 0 -relwidth 1.0 -relheight 1.0
  92.  
  93. set w [ttk::spinbox .w]
  94. pack $w -pady 3
  95.  
  96. set cb [ttk::combobox .cb]
  97. pack $cb -pady 3
  98. }