You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
238 lines
7.8 KiB
Plaintext
238 lines
7.8 KiB
Plaintext
# Spinint
|
|
# ----------------------------------------------------------------------
|
|
# Implements an integer spinner widget. It inherits basic spinner
|
|
# functionality from Spinner and adds specific features to create
|
|
# an integer-only spinner.
|
|
# Arrows may be placed horizontally or vertically.
|
|
# User may specify an integer range and step value.
|
|
# Spinner may be configured to wrap when min or max value is reached.
|
|
#
|
|
# NOTE:
|
|
# Spinint integer values should not exceed the size of a long integer.
|
|
# For a 32 bit long the integer range is -2147483648 to 2147483647.
|
|
#
|
|
# ----------------------------------------------------------------------
|
|
# AUTHOR: Sue Yockey Phone: (214) 519-2517
|
|
# E-mail: syockey@spd.dsccc.com
|
|
# yockey@acm.org
|
|
#
|
|
# @(#) $Id: spinint.itk,v 1.3 2001/08/07 19:56:48 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 Spinint {
|
|
keep -background -borderwidth -cursor -foreground -highlightcolor \
|
|
-highlightthickness -insertbackground -insertborderwidth \
|
|
-insertofftime -insertontime -insertwidth -labelfont \
|
|
-selectbackground -selectborderwidth -selectforeground \
|
|
-textbackground -textfont
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# SPININT
|
|
# ------------------------------------------------------------------
|
|
itcl::class iwidgets::Spinint {
|
|
inherit iwidgets::Spinner
|
|
|
|
constructor {args} {
|
|
Spinner::constructor -validate numeric
|
|
} {}
|
|
|
|
itk_option define -range range Range ""
|
|
itk_option define -step step Step 1
|
|
itk_option define -wrap wrap Wrap true
|
|
|
|
public method up {}
|
|
public method down {}
|
|
}
|
|
|
|
#
|
|
# Provide a lowercased access method for the Spinint class.
|
|
#
|
|
proc ::iwidgets::spinint {pathName args} {
|
|
uplevel ::iwidgets::Spinint $pathName $args
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# CONSTRUCTOR
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Spinint::constructor {args} {
|
|
eval itk_initialize $args
|
|
|
|
$itk_component(entry) delete 0 end
|
|
|
|
if {[lindex $itk_option(-range) 0] == ""} {
|
|
$itk_component(entry) insert 0 "0"
|
|
} else {
|
|
$itk_component(entry) insert 0 [lindex $itk_option(-range) 0]
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTIONS
|
|
# ------------------------------------------------------------------
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTION: -range
|
|
#
|
|
# Set min and max values for spinner.
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Spinint::range {
|
|
if {$itk_option(-range) != ""} {
|
|
if {[llength $itk_option(-range)] != 2} {
|
|
error "wrong # args: should be\
|
|
\"$itk_component(hull) configure -range {begin end}\""
|
|
}
|
|
|
|
set min [lindex $itk_option(-range) 0]
|
|
set max [lindex $itk_option(-range) 1]
|
|
|
|
if {![regexp {^-?[0-9]+$} $min]} {
|
|
error "bad range option \"$min\": begin value must be\
|
|
an integer"
|
|
}
|
|
if {![regexp {^-?[0-9]+$} $max]} {
|
|
error "bad range option \"$max\": end value must be\
|
|
an integer"
|
|
}
|
|
if {$min > $max} {
|
|
error "bad option starting range \"$min\": must be less\
|
|
than ending: \"$max\""
|
|
}
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTION: -step
|
|
#
|
|
# Increment spinner by step value.
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Spinint::step {
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTION: -wrap
|
|
#
|
|
# Specify whether spinner should wrap value if at min or max.
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Spinint::wrap {
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHODS
|
|
# ------------------------------------------------------------------
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: up
|
|
#
|
|
# Up arrow button press event. Increment value in entry.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Spinint::up {} {
|
|
set min_range [lindex $itk_option(-range) 0]
|
|
set max_range [lindex $itk_option(-range) 1]
|
|
|
|
set val [$itk_component(entry) get]
|
|
if {[lindex $itk_option(-range) 0] != ""} {
|
|
|
|
#
|
|
# Check boundaries.
|
|
#
|
|
if {$val >= $min_range && $val < $max_range} {
|
|
incr val $itk_option(-step)
|
|
$itk_component(entry) delete 0 end
|
|
$itk_component(entry) insert 0 $val
|
|
} else {
|
|
if {$itk_option(-wrap)} {
|
|
if {$val >= $max_range} {
|
|
$itk_component(entry) delete 0 end
|
|
$itk_component(entry) insert 0 $min_range
|
|
} elseif {$val < $min_range} {
|
|
$itk_component(entry) delete 0 end
|
|
$itk_component(entry) insert 0 $min_range
|
|
} else {
|
|
uplevel #0 $itk_option(-invalid)
|
|
}
|
|
} else {
|
|
uplevel #0 $itk_option(-invalid)
|
|
}
|
|
}
|
|
} else {
|
|
|
|
#
|
|
# No boundaries.
|
|
#
|
|
incr val $itk_option(-step)
|
|
$itk_component(entry) delete 0 end
|
|
$itk_component(entry) insert 0 $val
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: down
|
|
#
|
|
# Down arrow button press event. Decrement value in entry.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Spinint::down {} {
|
|
set min_range [lindex $itk_option(-range) 0]
|
|
set max_range [lindex $itk_option(-range) 1]
|
|
|
|
set val [$itk_component(entry) get]
|
|
if {[lindex $itk_option(-range) 0] != ""} {
|
|
|
|
#
|
|
# Check boundaries.
|
|
#
|
|
if {$val > $min_range && $val <= $max_range} {
|
|
incr val -$itk_option(-step)
|
|
$itk_component(entry) delete 0 end
|
|
$itk_component(entry) insert 0 $val
|
|
} else {
|
|
if {$itk_option(-wrap)} {
|
|
if {$val <= $min_range} {
|
|
$itk_component(entry) delete 0 end
|
|
$itk_component(entry) insert 0 $max_range
|
|
} elseif {$val > $max_range} {
|
|
$itk_component(entry) delete 0 end
|
|
$itk_component(entry) insert 0 $max_range
|
|
} else {
|
|
uplevel #0 $itk_option(-invalid)
|
|
}
|
|
} else {
|
|
uplevel #0 $itk_option(-invalid)
|
|
}
|
|
}
|
|
} else {
|
|
|
|
#
|
|
# No boundaries.
|
|
#
|
|
incr val -$itk_option(-step)
|
|
$itk_component(entry) delete 0 end
|
|
$itk_component(entry) insert 0 $val
|
|
}
|
|
}
|