| # |
| # Labeledwidget |
| # ---------------------------------------------------------------------- |
| # Implements a labeled widget which contains a label and child site. |
| # The child site is a frame which can filled with any widget via a |
| # derived class or though the use of the childsite method. This class |
| # was designed to be a general purpose base class for supporting the |
| # combination of label widget and a childsite, where a label may be |
| # text, bitmap or image. The options include the ability to position |
| # the label around the childsite widget, modify the font and margin, |
| # and control the display of the label. |
| # |
| # ---------------------------------------------------------------------- |
| # AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com |
| # |
| # @(#) $Id: labeledwidget.itk,v 1.4 2001/08/20 20:02:53 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 Labeledwidget { |
| keep -background -cursor -foreground -labelfont |
| } |
| |
| # ------------------------------------------------------------------ |
| # LABELEDWIDGET |
| # ------------------------------------------------------------------ |
| itcl::class iwidgets::Labeledwidget { |
| inherit itk::Widget |
| |
| constructor {args} {} |
| destructor {} |
| |
| itk_option define -disabledforeground disabledForeground \ |
| DisabledForeground \#a3a3a3 |
| itk_option define -labelpos labelPos Position w |
| itk_option define -labelmargin labelMargin Margin 2 |
| itk_option define -labeltext labelText Text {} |
| itk_option define -labelvariable labelVariable Variable {} |
| itk_option define -labelbitmap labelBitmap Bitmap {} |
| itk_option define -labelimage labelImage Image {} |
| itk_option define -state state State normal |
| itk_option define -sticky sticky Sticky nsew |
| |
| public method childsite |
| |
| private method _positionLabel {{when later}} |
| |
| proc alignlabels {args} {} |
| |
| protected variable _reposition "" ;# non-null => _positionLabel pending |
| } |
| |
| # |
| # Provide a lowercased access method for the Labeledwidget class. |
| # |
| proc ::iwidgets::labeledwidget {pathName args} { |
| uplevel ::iwidgets::Labeledwidget $pathName $args |
| } |
| |
| # ------------------------------------------------------------------ |
| # CONSTRUCTOR |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Labeledwidget::constructor {args} { |
| # |
| # Create a frame for the childsite widget. |
| # |
| itk_component add -protected lwchildsite { |
| frame $itk_interior.lwchildsite |
| } |
| |
| # |
| # Create label. |
| # |
| itk_component add label { |
| label $itk_interior.label |
| } { |
| usual |
| |
| rename -font -labelfont labelFont Font |
| ignore -highlightcolor -highlightthickness |
| } |
| |
| # |
| # Set the interior to be the childsite for derived classes. |
| # |
| set itk_interior $itk_component(lwchildsite) |
| |
| # |
| # Initialize the widget based on the command line options. |
| # |
| eval itk_initialize $args |
| |
| # |
| # When idle, position the label. |
| # |
| _positionLabel |
| } |
| |
| # ------------------------------------------------------------------ |
| # DESTRUCTOR |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Labeledwidget::destructor {} { |
| if {$_reposition != ""} {after cancel $_reposition} |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTIONS |
| # ------------------------------------------------------------------ |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -disabledforeground |
| # |
| # Specified the foreground to be used on the label when disabled. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Labeledwidget::disabledforeground {} |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -labelpos |
| # |
| # Set the position of the label on the labeled widget. The margin |
| # between the label and childsite comes along for the ride. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Labeledwidget::labelpos { |
| _positionLabel |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -labelmargin |
| # |
| # Specifies the distance between the widget and label. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Labeledwidget::labelmargin { |
| _positionLabel |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -labeltext |
| # |
| # Specifies the label text. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Labeledwidget::labeltext { |
| $itk_component(label) configure -text $itk_option(-labeltext) |
| |
| _positionLabel |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -labelvariable |
| # |
| # Specifies the label text variable. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Labeledwidget::labelvariable { |
| $itk_component(label) configure -textvariable $itk_option(-labelvariable) |
| |
| _positionLabel |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -labelbitmap |
| # |
| # Specifies the label bitmap. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Labeledwidget::labelbitmap { |
| $itk_component(label) configure -bitmap $itk_option(-labelbitmap) |
| |
| _positionLabel |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -labelimage |
| # |
| # Specifies the label image. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Labeledwidget::labelimage { |
| $itk_component(label) configure -image $itk_option(-labelimage) |
| |
| _positionLabel |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -sticky |
| # |
| # Specifies the stickyness of the child site. This option was added |
| # by James Bonfield (committed by Chad Smith 8/20/01). |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Labeledwidget::sticky { |
| grid $itk_component(lwchildsite) -sticky $itk_option(-sticky) |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -state |
| # |
| # Specifies the state of the label. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Labeledwidget::state { |
| _positionLabel |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHODS |
| # ------------------------------------------------------------------ |
| |
| # ------------------------------------------------------------------ |
| # METHOD: childsite |
| # |
| # Returns the path name of the child site widget. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Labeledwidget::childsite {} { |
| return $itk_component(lwchildsite) |
| } |
| |
| # ------------------------------------------------------------------ |
| # PROCEDURE: alignlabels widget ?widget ...? |
| # |
| # The alignlabels procedure takes a list of widgets derived from |
| # the Labeledwidget class and adjusts the label margin to align |
| # the labels. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Labeledwidget::alignlabels {args} { |
| update |
| set maxLabelWidth 0 |
| |
| # |
| # Verify that all the widgets are of type Labeledwidget and |
| # determine the size of the maximum length label string. |
| # |
| foreach iwid $args { |
| set objcmd [itcl::find objects -isa Labeledwidget *::$iwid] |
| |
| if {$objcmd == ""} { |
| error "$iwid is not a \"Labeledwidget\"" |
| } |
| |
| set csWidth [winfo reqwidth $iwid.lwchildsite] |
| set shellWidth [winfo reqwidth $iwid] |
| |
| if {($shellWidth - $csWidth) > $maxLabelWidth} { |
| set maxLabelWidth [expr {$shellWidth - $csWidth}] |
| } |
| } |
| |
| # |
| # Adjust the margins for the labels such that the child sites and |
| # labels line up. |
| # |
| foreach iwid $args { |
| set csWidth [winfo reqwidth $iwid.lwchildsite] |
| set shellWidth [winfo reqwidth $iwid] |
| |
| set labelSize [expr {$shellWidth - $csWidth}] |
| |
| if {$maxLabelWidth > $labelSize} { |
| set objcmd [itcl::find objects -isa Labeledwidget *::$iwid] |
| set dist [expr {$maxLabelWidth - \ |
| ($labelSize - [$objcmd cget -labelmargin])}] |
| |
| $objcmd configure -labelmargin $dist |
| } |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # PROTECTED METHOD: _positionLabel ?when? |
| # |
| # Packs the label and label margin. 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::Labeledwidget::_positionLabel {{when later}} { |
| if {$when == "later"} { |
| if {$_reposition == ""} { |
| set _reposition [after idle [itcl::code $this _positionLabel now]] |
| } |
| return |
| |
| } elseif {$when != "now"} { |
| error "bad option \"$when\": should be now or later" |
| } |
| |
| # |
| # If we have a label, be it text, bitmap, or image continue. |
| # |
| if {($itk_option(-labeltext) != {}) || \ |
| ($itk_option(-labelbitmap) != {}) || \ |
| ($itk_option(-labelimage) != {}) || \ |
| ($itk_option(-labelvariable) != {})} { |
| |
| # |
| # Set the foreground color based on the state. |
| # |
| if {[info exists itk_option(-state)]} { |
| switch -- $itk_option(-state) { |
| disabled { |
| $itk_component(label) configure \ |
| -foreground $itk_option(-disabledforeground) |
| } |
| normal { |
| $itk_component(label) configure \ |
| -foreground $itk_option(-foreground) |
| } |
| } |
| } |
| |
| set parent [winfo parent $itk_component(lwchildsite)] |
| |
| # |
| # Switch on the label position option. Using the grid, |
| # adjust the row/column setting of the label, margin, and |
| # and childsite. The margin height/width is adjust based |
| # on the orientation as well. Finally, set the weights such |
| # that the childsite takes the heat on expansion and shrinkage. |
| # |
| switch $itk_option(-labelpos) { |
| nw - |
| n - |
| ne { |
| grid $itk_component(label) -row 0 -column 0 \ |
| -sticky $itk_option(-labelpos) |
| grid $itk_component(lwchildsite) -row 2 -column 0 \ |
| -sticky $itk_option(-sticky) |
| |
| grid rowconfigure $parent 0 -weight 0 -minsize 0 |
| grid rowconfigure $parent 1 -weight 0 -minsize \ |
| [winfo pixels $itk_component(label) \ |
| $itk_option(-labelmargin)] |
| grid rowconfigure $parent 2 -weight 1 -minsize 0 |
| |
| grid columnconfigure $parent 0 -weight 1 -minsize 0 |
| grid columnconfigure $parent 1 -weight 0 -minsize 0 |
| grid columnconfigure $parent 2 -weight 0 -minsize 0 |
| } |
| |
| en - |
| e - |
| es { |
| grid $itk_component(lwchildsite) -row 0 -column 0 \ |
| -sticky $itk_option(-sticky) |
| grid $itk_component(label) -row 0 -column 2 \ |
| -sticky $itk_option(-labelpos) |
| |
| grid rowconfigure $parent 0 -weight 1 -minsize 0 |
| grid rowconfigure $parent 1 -weight 0 -minsize 0 |
| grid rowconfigure $parent 2 -weight 0 -minsize 0 |
| |
| grid columnconfigure $parent 0 -weight 1 -minsize 0 |
| grid columnconfigure $parent 1 -weight 0 -minsize \ |
| [winfo pixels $itk_component(label) \ |
| $itk_option(-labelmargin)] |
| grid columnconfigure $parent 2 -weight 0 -minsize 0 |
| } |
| |
| se - |
| s - |
| sw { |
| grid $itk_component(lwchildsite) -row 0 -column 0 \ |
| -sticky $itk_option(-sticky) |
| grid $itk_component(label) -row 2 -column 0 \ |
| -sticky $itk_option(-labelpos) |
| |
| grid rowconfigure $parent 0 -weight 1 -minsize 0 |
| grid rowconfigure $parent 1 -weight 0 -minsize \ |
| [winfo pixels $itk_component(label) \ |
| $itk_option(-labelmargin)] |
| grid rowconfigure $parent 2 -weight 0 -minsize 0 |
| |
| grid columnconfigure $parent 0 -weight 1 -minsize 0 |
| grid columnconfigure $parent 1 -weight 0 -minsize 0 |
| grid columnconfigure $parent 2 -weight 0 -minsize 0 |
| } |
| |
| wn - |
| w - |
| ws { |
| grid $itk_component(lwchildsite) -row 0 -column 2 \ |
| -sticky $itk_option(-sticky) |
| grid $itk_component(label) -row 0 -column 0 \ |
| -sticky $itk_option(-labelpos) |
| |
| grid rowconfigure $parent 0 -weight 1 -minsize 0 |
| grid rowconfigure $parent 1 -weight 0 -minsize 0 |
| grid rowconfigure $parent 2 -weight 0 -minsize 0 |
| |
| grid columnconfigure $parent 0 -weight 0 -minsize 0 |
| grid columnconfigure $parent 1 -weight 0 -minsize \ |
| [winfo pixels $itk_component(label) \ |
| $itk_option(-labelmargin)] |
| grid columnconfigure $parent 2 -weight 1 -minsize 0 |
| } |
| |
| default { |
| error "bad labelpos option\ |
| \"$itk_option(-labelpos)\": should be\ |
| nw, n, ne, sw, s, se, en, e, es, wn, w, or ws" |
| } |
| } |
| |
| # |
| # Else, neither the label text, bitmap, or image have a value, so |
| # forget them so they don't appear and manage only the childsite. |
| # |
| } else { |
| grid forget $itk_component(label) |
| |
| grid $itk_component(lwchildsite) -row 0 -column 0 -sticky $itk_option(-sticky) |
| |
| set parent [winfo parent $itk_component(lwchildsite)] |
| |
| grid rowconfigure $parent 0 -weight 1 -minsize 0 |
| grid rowconfigure $parent 1 -weight 0 -minsize 0 |
| grid rowconfigure $parent 2 -weight 0 -minsize 0 |
| grid columnconfigure $parent 0 -weight 1 -minsize 0 |
| grid columnconfigure $parent 1 -weight 0 -minsize 0 |
| grid columnconfigure $parent 2 -weight 0 -minsize 0 |
| } |
| |
| # |
| # Reset the resposition flag. |
| # |
| set _reposition "" |
| } |