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
}