Posted to tcl by emiliano at Tue Sep 30 20:26:00 GMT 2008view pretty
package require Tk 8.5 namespace eval ttk { namespace eval spinbox {} image create bitmap ttk::spinbox::up -data { #define up_width 7 #define up_height 4 static unsigned char up_bits[] = { 0x08, 0x1c, 0x3e, 0x7f}; } image create bitmap ttk::spinbox::down -data { #define down_width 7 #define down_height 4 static unsigned char down_bits[] = { 0x7f, 0x3e, 0x1c, 0x08}; } ttk::style configure TSpinbox.Toolbutton -padding 0 option add *TSpinbox.TButton.style TSpinbox.Toolbutton option add *TSpinbox.TButton.takeFocus 0 option add *TSpinbox.u.image ttk::spinbox::up option add *TSpinbox.d.image ttk::spinbox::down } proc ttk::spinbox {w args} { # check whether $w exists if {[winfo exists $w]} { error "$w already exists in parent" } # create a namespace to hold private variables namespace eval ttk::spinbox::${w} { variable widget array set widget {} } # create the widget ttk::frame $w -class TSpinbox set e [ttk::entry $w.e] set u [ttk::button $w.u] set d [ttk::button $w.d] grid $e $u -sticky news grid ^ $d -sticky news grid columnconfigure $w 0 -weight 1 bind $w <<ThemeChanged>> { ttk::style configure TSpinbox.Toolbutton -padding 0 } # move all instance commands to the private namespace rename $w [namespace current]::${w}::${w} # install our custom widget command proc $w args [list [namespace current]::instancecmd $w {*}$args] # return the newly created widget name return $w } proc ttk::spinbox::instancecmd {w args} { } proc ttk::spinbox::configurecmd {args} { } proc ttk::spinbox::destroycmd {w} { namespace delete ttk::spinbox::${w} } # test if 1 { set i 0 foreach theme [ttk::themes] { after [expr {5000 * [incr i]} ] [list ttk::setTheme $theme] puts $theme } place [ttk::frame .bf] -x 0 -y 0 -relwidth 1.0 -relheight 1.0 set w [ttk::spinbox .w] pack $w -pady 3 set cb [ttk::combobox .cb] pack $cb -pady 3 }