| # Spinner |
| # ---------------------------------------------------------------------- |
| # Implements a spinner widget. The Spinner is comprised of an |
| # EntryField plus up and down arrow buttons. |
| # Spinner is meant to be used as a base class for creating more |
| # specific spinners such as SpinInt.itk |
| # Arrows may be drawn horizontally or vertically. |
| # User may define arrow behavior or accept the default arrow behavior. |
| # |
| # ---------------------------------------------------------------------- |
| # AUTHOR: Sue Yockey Phone: (214) 519-2517 |
| # E-mail: syockey@spd.dsccc.com |
| # yockey@acm.org |
| # |
| # @(#) $Id: spinner.itk,v 1.3 2001/08/17 19:04:37 smithc Exp $ |
| # ---------------------------------------------------------------------- |
| # Copyright (c) 1995 DSC Technologies Corporation |
| # ====================================================================== |
| # Permission to use, copy, modify, distribute and license this software |
| # and its documentation for any purpose, and without fee or written |
| # agreement with DSC, is hereby granted, provided that the above copyright |
| # notice appears in all copies and that both the copyright notice and |
| # warranty disclaimer below appear in supporting documentation, and that |
| # the names of DSC Technologies Corporation or DSC Communications |
| # Corporation not be used in advertising or publicity pertaining to the |
| # software without specific, written prior permission. |
| # |
| # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING |
| # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- |
| # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE |
| # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, |
| # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL |
| # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR |
| # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, |
| # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, |
| # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS |
| # SOFTWARE. |
| # ====================================================================== |
| |
| # |
| # Usual options. |
| # |
| itk::usual Spinner { |
| keep -background -borderwidth -cursor -foreground -highlightcolor \ |
| -highlightthickness -insertbackground -insertborderwidth \ |
| -insertofftime -insertontime -insertwidth -labelfont \ |
| -selectbackground -selectborderwidth -selectforeground \ |
| -textbackground -textfont |
| } |
| |
| # ------------------------------------------------------------------ |
| # SPINNER |
| # ------------------------------------------------------------------ |
| itcl::class iwidgets::Spinner { |
| inherit iwidgets::Entryfield |
| |
| constructor {args} {} |
| destructor {} |
| |
| itk_option define -arroworient arrowOrient Orient vertical |
| itk_option define -textfont textFont \ |
| Font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* |
| itk_option define -borderwidth borderWidth BorderWidth 2 |
| itk_option define -highlightthickness highlightThickness \ |
| HighlightThickness 2 |
| itk_option define -increment increment Command {} |
| itk_option define -decrement decrement Command {} |
| itk_option define -repeatdelay repeatDelay RepeatDelay 300 |
| itk_option define -repeatinterval repeatInterval RepeatInterval 100 |
| itk_option define -foreground foreground Foreground black |
| |
| public method down {} |
| public method up {} |
| |
| protected method _pushup {} |
| protected method _pushdown {} |
| protected method _relup {} |
| protected method _reldown {} |
| protected method _doup {rate} |
| protected method _dodown {rate} |
| protected method _up {} |
| protected method _down {} |
| |
| protected method _positionArrows {{when later}} |
| |
| protected variable _interior {} |
| protected variable _reposition "" ;# non-null => _positionArrows pending |
| protected variable _uptimer "" ;# non-null => _uptimer pending |
| protected variable _downtimer "" ;# non-null => _downtimer pending |
| } |
| |
| # |
| # Provide a lowercased access method for the Spinner class. |
| # |
| proc ::iwidgets::spinner {pathName args} { |
| uplevel ::iwidgets::Spinner $pathName $args |
| } |
| |
| # ------------------------------------------------------------------ |
| # CONSTRUCTOR |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::constructor {args} { |
| # |
| # Save off the interior for later use. |
| # |
| set _interior $itk_interior |
| |
| # |
| # Create up arrow button. |
| # |
| itk_component add uparrow { |
| canvas $itk_interior.uparrow -height 10 -width 10 \ |
| -relief raised -highlightthickness 0 |
| } { |
| keep -background -borderwidth |
| } |
| |
| # |
| # Create down arrow button. |
| # |
| itk_component add downarrow { |
| canvas $itk_interior.downarrow -height 10 -width 10 \ |
| -relief raised -highlightthickness 0 |
| } { |
| keep -background -borderwidth |
| } |
| |
| # |
| # Add bindings for button press events on the up and down buttons. |
| # |
| bind $itk_component(uparrow) <ButtonPress-1> [itcl::code $this _pushup] |
| bind $itk_component(uparrow) <ButtonRelease-1> [itcl::code $this _relup] |
| |
| bind $itk_component(downarrow) <ButtonPress-1> [itcl::code $this _pushdown] |
| bind $itk_component(downarrow) <ButtonRelease-1> [itcl::code $this _reldown] |
| |
| eval itk_initialize $args |
| |
| # |
| # When idle, position the arrows. |
| # |
| _positionArrows |
| } |
| |
| # ------------------------------------------------------------------ |
| # DESTRUCTOR |
| # ------------------------------------------------------------------ |
| |
| itcl::body iwidgets::Spinner::destructor {} { |
| if {$_reposition != ""} {after cancel $_reposition} |
| if {$_uptimer != ""} {after cancel $_uptimer} |
| if {$_downtimer != ""} {after cancel $_downtimer} |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTIONS |
| # ------------------------------------------------------------------ |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -arroworient |
| # |
| # Place arrows vertically or horizontally . |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinner::arroworient { |
| _positionArrows |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -textfont |
| # |
| # Change font, resize arrow buttons. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinner::textfont { |
| _positionArrows |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -highlightthickness |
| # |
| # Change highlightthickness, resize arrow buttons. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinner::highlightthickness { |
| _positionArrows |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -borderwidth |
| # |
| # Change borderwidth, resize arrow buttons. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinner::borderwidth { |
| _positionArrows |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -increment |
| # |
| # Up arrow callback. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinner::increment { |
| if {$itk_option(-increment) == {}} { |
| set itk_option(-increment) [itcl::code $this up] |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -decrement |
| # |
| # Down arrow callback. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinner::decrement { |
| if {$itk_option(-decrement) == {}} { |
| set itk_option(-decrement) [itcl::code $this down] |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -repeatinterval |
| # |
| # Arrow repeat rate in milliseconds. A repeatinterval of 0 disables |
| # button repeat. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinner::repeatinterval { |
| if {$itk_option(-repeatinterval) < 0} { |
| set itk_option(-repeatinterval) 0 |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -repeatdelay |
| # |
| # Arrow repeat delay in milliseconds. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinner::repeatdelay { |
| if {$itk_option(-repeatdelay) < 0} { |
| set itk_option(-repeatdelay) 0 |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -foreground |
| # |
| # Set the foreground color of the up and down arrows. Remember |
| # to make sure the "tag" exists before setting them... |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinner::foreground { |
| |
| if { [$itk_component(uparrow) gettags up] != "" } { |
| $itk_component(uparrow) itemconfigure up \ |
| -fill $itk_option(-foreground) |
| } |
| |
| if { [$itk_component(downarrow) gettags down] != "" } { |
| $itk_component(downarrow) itemconfigure down \ |
| -fill $itk_option(-foreground) |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHODS |
| # ------------------------------------------------------------------ |
| |
| # ------------------------------------------------------------------ |
| # METHOD: up |
| # |
| # Up arrow command. Meant to be overloaded by derived class. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::up {} { |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHOD: down |
| # |
| # Down arrow command. Meant to be overloaded by derived class. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::down {} { |
| } |
| |
| # ------------------------------------------------------------------ |
| # PROTECTED METHOD: _positionArrows ?when? |
| # |
| # Draw Arrows for spinner. If "when" is "now", the change is applied |
| # immediately. If it is "later" or it is not specified, then the |
| # change is applied later, when the application is idle. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::_positionArrows {{when later}} { |
| if {$when == "later"} { |
| if {$_reposition == ""} { |
| set _reposition [after idle [itcl::code $this _positionArrows now]] |
| } |
| return |
| } elseif {$when != "now"} { |
| error "bad option \"$when\": should be now or later" |
| } |
| |
| set _reposition "" |
| |
| set bdw [cget -borderwidth] |
| |
| # |
| # Based on the orientation of the arrows, pack them accordingly and |
| # determine the width and height of the spinners. For vertical |
| # orientation, it is really tight in the y direction, so we'll take |
| # advantage of the highlightthickness. Horizontal alignment has |
| # plenty of space vertically, thus we'll ignore the thickness. |
| # |
| switch $itk_option(-arroworient) { |
| vertical { |
| grid $itk_component(uparrow) -row 0 -column 0 |
| grid $itk_component(downarrow) -row 1 -column 0 |
| |
| set totalHgt [winfo reqheight $itk_component(entry)] |
| set spinHgt [expr {$totalHgt / 2}] |
| set spinWid [expr {round ($spinHgt * 1.6)}] |
| } |
| horizontal { |
| grid $itk_component(uparrow) -row 0 -column 0 |
| grid $itk_component(downarrow) -row 0 -column 1 |
| |
| set spinHgt [expr {[winfo reqheight $itk_component(entry)] - \ |
| (2 * [$itk_component(entry) cget -highlightthickness])}] |
| set spinWid $spinHgt |
| } |
| default { |
| error "bad orientation option \"$itk_option(-arroworient)\",\ |
| should be horizontal or vertical" |
| } |
| } |
| |
| # |
| # Configure the width and height of the spinners minus the borderwidth. |
| # Next delete the previous spinner polygons and create new ones. |
| # |
| $itk_component(uparrow) config \ |
| -height [expr {$spinHgt - (2 * $bdw)}] \ |
| -width [expr {$spinWid - (2 * $bdw)}] |
| $itk_component(uparrow) delete up |
| $itk_component(uparrow) create polygon \ |
| [expr {$spinWid / 2}] $bdw \ |
| [expr {$spinWid - $bdw - 1}] [expr {$spinHgt - $bdw -1}] \ |
| [expr {$bdw + 1}] [expr {$spinHgt - $bdw - 1}] \ |
| -fill $itk_option(-foreground) -tags up |
| |
| $itk_component(downarrow) config \ |
| -height [expr {$spinHgt - (2 * $bdw)}] \ |
| -width [expr {$spinWid - (2 * $bdw)}] |
| $itk_component(downarrow) delete down |
| $itk_component(downarrow) create polygon \ |
| [expr {$spinWid / 2}] [expr {($spinHgt - $bdw) - 1}] \ |
| [expr {$bdw + 2}] [expr {$bdw + 1}] \ |
| [expr {$spinWid - $bdw - 2}] [expr {$bdw + 1}] \ |
| -fill $itk_option(-foreground) -tags down |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _pushup |
| # |
| # Up arrow button press event. Call _doup with repeatdelay. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::_pushup {} { |
| $itk_component(uparrow) config -relief sunken |
| _doup $itk_option(-repeatdelay) |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _pushdown |
| # |
| # Down arrow button press event. Call _dodown with repeatdelay. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::_pushdown {} { |
| $itk_component(downarrow) config -relief sunken |
| _dodown $itk_option(-repeatdelay) |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _doup |
| # |
| # Call _up and post to do another one after "rate" milliseconds if |
| # repeatinterval > 0. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::_doup {rate} { |
| _up |
| |
| if {$itk_option(-repeatinterval) > 0} { |
| set _uptimer [after $rate [itcl::code $this _doup $itk_option(-repeatinterval)]] |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _dodown |
| # |
| # Call _down and post to do another one after "rate" milliseconds if |
| # repeatinterval > 0. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::_dodown {rate} { |
| _down |
| |
| if {$itk_option(-repeatinterval) > 0} { |
| set _downtimer \ |
| [after $rate [itcl::code $this _dodown $itk_option(-repeatinterval)]] |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _relup |
| # |
| # Up arrow button release event. Cancel pending up timer. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::_relup {} { |
| $itk_component(uparrow) config -relief raised |
| |
| if {$_uptimer != ""} { |
| after cancel $_uptimer |
| set _uptimer "" |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _reldown |
| # |
| # Up arrow button release event. Cancel pending down timer. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::_reldown {} { |
| $itk_component(downarrow) config -relief raised |
| |
| if {$_downtimer != ""} { |
| after cancel $_downtimer |
| set _downtimer "" |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _up |
| # |
| # Up arrow button press event. Call defined increment command. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::_up {} { |
| uplevel #0 $itk_option(-increment) |
| } |
| |
| # ------------------------------------------------------------------ |
| # PRIVATE METHOD: _down |
| # |
| # Down arrow button press event. Call defined decrement command. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinner::_down {} { |
| uplevel #0 $itk_option(-decrement) |
| } |