# # 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. 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@spd.dsccc.com # # @(#) $Id: labeledwidget.itk,v 1.3 2006/09/11 20:35:55 irby 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. # ====================================================================== # # Default resources. # option add *Labeledwidget.labelMargin 1 widgetDefault # # Usual options. # itk::usual Labeledwidget { keep -background -cursor -foreground -labelfont } # ------------------------------------------------------------------ # LABELEDWIDGET # ------------------------------------------------------------------ class iwidgets::Labeledwidget { inherit itk::Widget constructor {args} {} destructor {} itk_option define -labelpos labelPos Position w itk_option define -labelmargin labelMargin Margin 1 itk_option define -labeltext labelText Text {} itk_option define -labelvariable labelVariable Variable {} itk_option define -labelbitmap labelBitmap Bitmap {} itk_option define -labelimage labelImage Image {} public method childsite protected 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 # ------------------------------------------------------------------ body iwidgets::Labeledwidget::constructor {args} { # # Create the outermost frame to maintain geometry. # itk_component add shell { frame $itk_interior.shell } { keep -background -cursor } pack $itk_component(shell) -fill both -expand yes # # Create a frame for the childsite widget. # itk_component add lwchildsite { frame $itk_component(shell).lwchildsite } { keep -background -cursor } pack $itk_component(lwchildsite) -fill both -expand yes set itk_interior $itk_component(lwchildsite) # # Create label. # itk_component add label { label $itk_component(shell).label } { keep -background -foreground -cursor rename -font -labelfont labelFont Font } # # Create margin between label and the child site. # itk_component add labmargin { frame $itk_component(shell).labmargin } { keep -background -cursor } # # Explicitly handle configs that may have been ignored earlier. # eval itk_initialize $args # # When idle, position the label. # _positionLabel } # ------------------------------------------------------------------ # DESTURCTOR # ------------------------------------------------------------------ body iwidgets::Labeledwidget::destructor {} { if {$_reposition != ""} {after cancel $_reposition} } # ------------------------------------------------------------------ # OPTIONS # ------------------------------------------------------------------ # ------------------------------------------------------------------ # OPTION: -labelpos # # Set the position of the label on the labeled widget. The margin # between the label and childsite comes along for the ride. # ------------------------------------------------------------------ configbody iwidgets::Labeledwidget::labelpos { _positionLabel } # ------------------------------------------------------------------ # OPTION: -labelmargin # # Specifies the distance between the widget and label. # ------------------------------------------------------------------ configbody iwidgets::Labeledwidget::labelmargin { _positionLabel } # ------------------------------------------------------------------ # OPTION: -labeltext # # Specifies the label text. # ------------------------------------------------------------------ configbody iwidgets::Labeledwidget::labeltext { $itk_component(label) configure -text $itk_option(-labeltext) _positionLabel } # ------------------------------------------------------------------ # OPTION: -labelvariable # # Specifies the label text variable. # ------------------------------------------------------------------ configbody iwidgets::Labeledwidget::labelvariable { $itk_component(label) configure -textvariable $itk_option(-labelvariable) _positionLabel } # ------------------------------------------------------------------ # OPTION: -labelbitmap # # Specifies the label bitmap. # ------------------------------------------------------------------ configbody iwidgets::Labeledwidget::labelbitmap { $itk_component(label) configure -bitmap $itk_option(-labelbitmap) _positionLabel } # ------------------------------------------------------------------ # OPTION: -labelimage # # Specifies the label image. # ------------------------------------------------------------------ configbody iwidgets::Labeledwidget::labelimage { $itk_component(label) configure -image $itk_option(-labelimage) _positionLabel } # ------------------------------------------------------------------ # METHODS # ------------------------------------------------------------------ # ------------------------------------------------------------------ # METHOD: childsite # # Returns the path name of the child site widget. # ------------------------------------------------------------------ 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. # ------------------------------------------------------------------ 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.shell.lwchildsite] set shellWidth [winfo reqwidth $iwid.shell] if {[expr $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.shell.lwchildsite] set shellWidth [winfo reqwidth $iwid.shell] set labelSize [expr $shellWidth - $csWidth] if {$maxLabelWidth > $labelSize} { set dist [expr $maxLabelWidth - \ ($labelSize - [winfo reqwidth $iwid.shell.labmargin])] set objcmd [itcl::find objects -isa Labeledwidget *::$iwid] $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. # ------------------------------------------------------------------ body iwidgets::Labeledwidget::_positionLabel {{when later}} { if {$when == "later"} { if {$_reposition == ""} { set _reposition [after idle [code $this _positionLabel now]] } return } elseif {$when != "now"} { error "bad option \"$when\": should be now or later" } if {($itk_option(-labeltext) != {}) || ($itk_option(-labelbitmap) != {}) || ($itk_option(-labelimage) != {})} { switch $itk_option(-labelpos) { nw { pack configure $itk_component(lwchildsite) -side top $itk_component(labmargin) configure -width 1 -height \ [winfo pixels $itk_component(labmargin) \ $itk_option(-labelmargin)] pack configure $itk_component(labmargin) -side top \ -before $itk_component(lwchildsite) pack configure $itk_component(label) -anchor w \ -side top -before $itk_component(labmargin) } n { pack configure $itk_component(lwchildsite) -side top $itk_component(labmargin) configure -width 1 -height \ [winfo pixels $itk_component(labmargin) \ $itk_option(-labelmargin)] pack configure $itk_component(labmargin) -side top \ -before $itk_component(lwchildsite) pack configure $itk_component(label) -anchor center \ -before $itk_component(labmargin) -side top } ne { pack configure $itk_component(lwchildsite) -side top $itk_component(labmargin) configure -width 1 -height \ [winfo pixels $itk_component(labmargin) \ $itk_option(-labelmargin)] pack configure $itk_component(labmargin) -side top \ -before $itk_component(lwchildsite) pack configure $itk_component(label) -anchor e \ -side top -before $itk_component(labmargin) } e { pack configure $itk_component(lwchildsite) -side right $itk_component(labmargin) configure -height 1 -width \ [winfo pixels $itk_component(labmargin) \ $itk_option(-labelmargin)] pack configure $itk_component(labmargin) \ -side right -before $itk_component(lwchildsite) pack configure $itk_component(label) -anchor center \ -side right -before $itk_component(labmargin) } se { pack configure $itk_component(lwchildsite) -side top $itk_component(labmargin) configure -width 1 -height \ [winfo pixels $itk_component(labmargin) \ $itk_option(-labelmargin)] pack configure $itk_component(labmargin) \ -side top -after $itk_component(lwchildsite) pack configure $itk_component(label) -anchor e \ -side bottom -after $itk_component(labmargin) } s { pack configure $itk_component(lwchildsite) -side top $itk_component(labmargin) configure -width 1 -height \ [winfo pixels $itk_component(labmargin) \ $itk_option(-labelmargin)] pack configure $itk_component(labmargin) \ -side top -after $itk_component(lwchildsite) pack configure $itk_component(label) -anchor center \ -side bottom -after $itk_component(labmargin) } sw { pack configure $itk_component(lwchildsite) -side top $itk_component(labmargin) configure -width 1 -height \ [winfo pixels $itk_component(labmargin) \ $itk_option(-labelmargin)] pack configure $itk_component(labmargin) \ -side top -after $itk_component(lwchildsite) pack configure $itk_component(label) -anchor w \ -side bottom -after $itk_component(labmargin) } w { pack configure $itk_component(lwchildsite) -side right $itk_component(labmargin) configure -height 1 -width \ [winfo pixels $itk_component(labmargin) \ $itk_option(-labelmargin)] pack configure $itk_component(labmargin) \ -side left -before $itk_component(lwchildsite) pack configure $itk_component(label) -anchor center \ -side left -before $itk_component(labmargin) } } # # Else, neither the label text, bitmap, or image have a value, so # un pack them the label and margin. # } else { pack forget $itk_component(label) pack forget $itk_component(labmargin) } set _reposition "" }