Subversion Repositories or1k

#

# Labeledframe

# ----------------------------------------------------------------------

# Implements a hull frame with a grooved relief, a label, and a

# frame childsite.

#

# The frame childsite can be 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

# a labeled frame and a childsite.  The options include the ability to

# position the label at configurable locations within the grooved relief

# of the hull frame, and control the display of the label.

#

#  To following demonstrates the different values which the "-labelpos"

#  option may be set to and the resulting layout of the label when

#  one executes the following command with "-labeltext" set to "LABEL":

#

#  example:

#   labeledframe .w -labeltext LABEL -labelpos 

#

#      ne          n         nw         se          s         sw

#

#   *LABEL****  **LABEL**  ****LABEL*  **********  ********* **********

#   *        *  *       *  *        *  *        *  *       * *        *

#   *        *  *       *  *        *  *        *  *       * *        *

#   *        *  *       *  *        *  *        *  *       * *        *

#   **********  *********  **********  *LABEL****  **LABEL** ****LABEL*

#

#      en          e         es         wn          s         ws

#

#   **********  *********  *********  *********  *********  **********

#   *        *  *        * *       *  *        * *       *  *        *

#   L        *  *        * *       *  *        L *       *  *        *

#   A        *  L        * *       *  *        A *       L  *        L

#   B        *  A        * L       *  *        B *       A  *        A

#   E        *  B        * A       *  *        E *       B  *        B

#   L        *  E        * B       *  *        L *       E  *        E

#   *        *  L        * E       *  *        * *       L  *        L

#   *        *  *        * L       *  *        * *       *  *        *

#   **********  ********** *********  ********** *********  **********

#

# ----------------------------------------------------------------------

#  AUTHOR: John A. Tucker               EMAIL: jatucker@spd.dsccc.com

#

# ======================================================================

#            Copyright (c) 1997 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 *Labeledframe.labelMargin    10      widgetDefault

option add *Labeledframe.labelFont     \

      "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"  widgetDefault

option add *Labeledframe.labelPos       n       widgetDefault

option add *Labeledframe.labelBorderWidth    2      widgetDefault

option add *Labeledframe.labelRelief         groove widgetDefault

#

# Usual options.

#

itk::usual Labeledframe {

    keep -background -cursor -labelfont -foreground -labelrelief -labelborderwidth

}

class iwidgets::Labeledframe {

  inherit itk::Widget

  itk_option define -ipadx iPadX IPad 0

  itk_option define -ipady iPadY IPad 0

  itk_option define -labelmargin labelMargin LabelMargin 10

  itk_option define -labelpos labelPos LabelPos n

  itk_option define -labeltext labelText LabelText ""

  constructor {args} {}

  destructor {}

  #

  # Public methods

  #

  public method childsite {}

  public method clientHandlesConfigure {{yes 1}}

  #

  # Private methods

  #

  private {

    method smt {value} { _setMarginThickness $value }

    method _positionLabel {{when later}}

    method _collapseMargin {}

    method _setMarginThickness {value}

    proc _initTable {}

    variable _reposition ""  ;# non-null => _positionLabel pending

    variable dontUpdate 0

    common _LAYOUT_TABLE

  }

}

#

# Provide a lowercased access method for the Labeledframe class.

#

proc ::iwidgets::labeledframe {pathName args} {

    uplevel ::iwidgets::Labeledframe $pathName $args

}

# -----------------------------------------------------------------------------

#                        CONSTRUCTOR

# -----------------------------------------------------------------------------

body iwidgets::Labeledframe::constructor { args } {

  #

  #  Create a window with the same name as this object

  #

  itk_component add labelFrame {

    frame $itk_interior.lf \

          -relief groove \

          -class [namespace tail [info class]]

  } {

    keep -background -cursor

    rename -relief -labelrelief labelRelief LabelRelief

    rename -borderwidth -labelborderwidth labelBorderWidth LabelBorderWidth

    rename -highlightbackground -background background Background

    rename -highlightcolor -background background Background

  }

  #

  # Create the childsite frame window

  # _______

  # |_____|

  # |_|X|_|

  # |_____|

  #

  itk_component add childsite {

    frame $itk_component(labelFrame).childsite -highlightthickness 0 -bd 0

  }

  #

  # Create the label to be positioned within the grooved relief

  # of the labelFrame frame.

  #

  itk_component add label {

    label $itk_component(labelFrame).label -highlightthickness 0 -bd 0

  } {

    usual

    rename -bitmap -labelbitmap labelBitmap Bitmap

    rename -font -labelfont labelFont Font

    rename -image -labelimage labelImage Image

    #rename -text -labeltext labelText Text

    rename -textvariable -labelvariable labelVariable Variable

    ignore -highlightthickness -highlightcolor -text

  }

  grid $itk_component(childsite) -row 1 -column 1 -sticky nsew

  grid columnconfigure $itk_component(labelFrame) 1 -weight 1

  grid rowconfigure    $itk_component(labelFrame) 1 -weight 1

  lappend after_script [code $this _positionLabel]

  bind $itk_component(label)  +[code $this _positionLabel]

  pack $itk_component(labelFrame) -fill both -expand 1

  #

  # Initialize the class array of layout configuration options.  Since

  # this is a one time only thing.

  #

  _initTable

  eval itk_initialize $args

  #

  # When idle, position the label.

  #

  _positionLabel

}

# -----------------------------------------------------------------------------

#                           DESTRUCTOR

# -----------------------------------------------------------------------------

body iwidgets::Labeledframe::destructor {} {

  debug "In Labeledframe destructor for $this, reposition is $_reposition"

  if {$_reposition != ""} {

    debug "Canceling reposition $_reposition for $this"

    after cancel $_reposition

    set _reposition DESTRUCTOR

  }

}

# -----------------------------------------------------------------------------

#                             OPTIONS

# -----------------------------------------------------------------------------

# ------------------------------------------------------------------

# OPTION: -ipadx

#

# Specifies the width of the horizontal gap from the border to the

# the child site.

# ------------------------------------------------------------------

configbody iwidgets::Labeledframe::ipadx {

  grid configure $itk_component(childsite) -padx $itk_option(-ipadx)

  _positionLabel

}

# ------------------------------------------------------------------

# OPTION: -ipady

#

# Specifies the width of the vertical gap from the border to the

# the child site.

# ------------------------------------------------------------------

configbody iwidgets::Labeledframe::ipady {

  grid configure $itk_component(childsite) -pady $itk_option(-ipady)

  _positionLabel

}

# -----------------------------------------------------------------------------

# OPTION: -labelmargin

#

# Set the margin of the most adjacent side of the label to the labelFrame

# relief.

# ----------------------------------------------------------------------------

configbody iwidgets::Labeledframe::labelmargin {

  _positionLabel

}

# -----------------------------------------------------------------------------

# OPTION: -labelpos

#

# Set the position of the label within the relief of the labelFrame frame

# widget.

# ----------------------------------------------------------------------------

configbody iwidgets::Labeledframe::labelpos {

  _positionLabel

}

# -----------------------------------------------------------------------------

# OPTION: -labelpos

#

# Set the position of the label within the relief of the labelFrame frame

# widget.

# ----------------------------------------------------------------------------

configbody iwidgets::Labeledframe::labeltext {

  $itk_component(label) configure -text $itk_option(-labeltext)

  _positionLabel

}

# -----------------------------------------------------------------------------

#                            PROCS

# -----------------------------------------------------------------------------

# -----------------------------------------------------------------------------

# PRIVATE PROC: _initTable

#

# Initializes the _LAYOUT_TABLE common variable of the Labeledframe

# class.  The initialization is performed in its own proc ( as opposed

# to in the class definition ) so that the initialization occurs only

# once.

#

# _LAYOUT_TABLE common array description:

#   Provides a table of the configuration option values

#   used to place the label widget within the grooved relief of the labelFrame

#   frame for each of the 12 possible "-labelpos" values.

#

#   Each of the 12 rows is layed out as follows:

#     {"-relx" "-rely"  }

# -----------------------------------------------------------------------------

body iwidgets::Labeledframe::_initTable {} {

  array set _LAYOUT_TABLE {

    nw-relx 0.0  nw-rely 0.0  nw-wrap 0 nw-conf rowconfigure    nw-num 0

    n-relx  0.5  n-rely  0.0  n-wrap  0 n-conf  rowconfigure    n-num  0

    ne-relx 1.0  ne-rely 0.0  ne-wrap 0 ne-conf rowconfigure    ne-num 0

    sw-relx 0.0  sw-rely 1.0  sw-wrap 0 sw-conf rowconfigure    sw-num 2

    s-relx  0.5  s-rely  1.0  s-wrap  0 s-conf  rowconfigure    s-num  2

    se-relx 1.0  se-rely 1.0  se-wrap 0 se-conf rowconfigure    se-num 2

    en-relx 1.0  en-rely 0.0  en-wrap 1 en-conf columnconfigure en-num 2

    e-relx  1.0  e-rely  0.5  e-wrap  1 e-conf  columnconfigure e-num  2

    es-relx 1.0  es-rely 1.0  es-wrap 1 es-conf columnconfigure es-num 2

    wn-relx 0.0  wn-rely 0.0  wn-wrap 1 wn-conf columnconfigure wn-num 0

    w-relx  0.0  w-rely  0.5  w-wrap  1 w-conf  columnconfigure w-num  0

    ws-relx 0.0  ws-rely 1.0  ws-wrap 1 ws-conf columnconfigure ws-num 0

    }

  #

  # Since this is a one time only thing, we'll redefine the proc to be empty

  # afterwards so it only happens once.

  #

  # NOTE: Be careful to use the "body" command, or the proc will get lost!

  #

  itcl::body ::iwidgets::Labeledframe::_initTable {} {}

}

# -----------------------------------------------------------------------------

#                            METHODS

# -----------------------------------------------------------------------------

# -----------------------------------------------------------------------------

# PUBLIC METHOD:: childsite

#

# -----------------------------------------------------------------------------

body iwidgets::Labeledframe::childsite {} {

  return $itk_component(childsite)

}

# -----------------------------------------------------------------------------

# PUBLIC METHOD:: clientHandlesConfigure

#

# -----------------------------------------------------------------------------

body iwidgets::Labeledframe::clientHandlesConfigure {{yes 1}} {

  if {$yes} {

    set dontUpdate 1

    bind $itk_component(label)  { }

    return [code $this _positionLabel now]

  } else {

    bind $itk_component(label)  [code $this _positionLabel]

    set dontUpdate 0

  }

}

# -----------------------------------------------------------------------------

# PROTECTED METHOD: _positionLabel ?when?

#

# Places the label in the relief of the labelFrame.  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::Labeledframe::_positionLabel {{when later}} {

  if {$when == "later"} {

    if {$_reposition != ""} {

      after cancel $_reposition

    }

    set _reposition [after idle [code $this _positionLabel now]]

    return

  }

  set pos $itk_option(-labelpos)

  #

  # If there is not an entry for the "relx" value associated with

  # the given "-labelpos" option value, then it invalid.

  #

  if { [catch {set relx $_LAYOUT_TABLE($pos-relx)}] } {

    error "bad labelpos option\"$itk_option(-labelpos)\": should be\

                  nw, n, ne, sw, s, se, en, e, es, wn, w, or ws"

  }

  if {!$dontUpdate} {

    update idletasks

    if {[string compare $_reposition DESTRUCTOR] == 0} {

      # OOPS...  We are in the process of being destroyed.  Get out of here...

      debug "Stuck in _postionLabel during destruction"

      return

    }

  }

  $itk_component(label) configure -wraplength $_LAYOUT_TABLE($pos-wrap)

  # If there is no text in the label, do not add it to the computation.

  if {$itk_option(-labeltext) == ""} {

      set minsize 0

      if {[place slaves $itk_component(labelFrame)] != ""} {

          place forget $itk_component(label)

      }

    _setMarginThickness 0

  } else {

    set labelWidth [winfo reqwidth $itk_component(label)]

    set labelHeight [winfo reqheight $itk_component(label)]

      set borderwidth $itk_option(-labelborderwidth)

      set margin $itk_option(-labelmargin)

      switch $pos {

        nw {

          set labelThickness $labelHeight

          set minsize [expr $labelThickness/2.0]

          set xPos [expr $minsize+$borderwidth+$margin]

          set yPos -$minsize

        }

        n {

          set labelThickness $labelHeight

          set minsize [expr $labelThickness/2.0]

          set xPos [expr -$labelWidth/2.0]

          set yPos -$minsize

        }

        ne  {

          set labelThickness $labelHeight

          set minsize [expr $labelThickness/2.0]

          set xPos [expr -($minsize+$borderwidth+$margin+$labelWidth)]

          set yPos -$minsize

        }

        sw  {

          set labelThickness $labelHeight

          set minsize [expr $labelThickness/2.0]

          set xPos [expr $minsize+$borderwidth+$margin]

          set yPos -$minsize

        }

        s {

          set labelThickness $labelHeight

          set minsize [expr $labelThickness/2.0]

          set xPos [expr -$labelWidth/2.0]

          set yPos [expr -$labelHeight/2.0]

        }

        se {

          set labelThickness $labelHeight

          set minsize [expr $labelThickness/2.0]

          set xPos [expr -($minsize+$borderwidth+$margin+$labelWidth)]

          set yPos [expr -$labelHeight/2.0]

        }

        wn {

          set labelThickness $labelWidth

          set minsize [expr $labelThickness/2.0]

          set xPos -$minsize

          set yPos [expr $minsize+$margin+$borderwidth]

        }

        w {

          set labelThickness $labelWidth

          set minsize [expr $labelThickness/2.0]

          set xPos -$minsize

          set yPos [expr -($labelHeight/2.0)]

        }

        ws {

          set labelThickness $labelWidth

          set minsize [expr $labelThickness/2.0]

          set xPos -$minsize

          set yPos [expr -($minsize+$borderwidth+$margin+$labelHeight)]

        }

        en {

          set labelThickness $labelWidth

          set minsize [expr $labelThickness/2.0]

          set xPos -$minsize

          set yPos [expr $minsize+$borderwidth+$margin]

        }

        e {

          set labelThickness $labelWidth

          set minsize [expr $labelThickness/2.0]

          set xPos -$minsize

          set yPos [expr -($labelHeight/2.0)]

        }

        es {

          set labelThickness $labelWidth

          set minsize [expr $labelThickness/2.0]

          set xPos -$minsize

          set yPos [expr -($minsize+$borderwidth+$margin+$labelHeight)]

        }

      }

      _setMarginThickness $minsize

      place $itk_component(label) \

        -relx $_LAYOUT_TABLE($pos-relx) -x $xPos \

        -rely $_LAYOUT_TABLE($pos-rely) -y $yPos \

        -anchor nw

  }

  set what $_LAYOUT_TABLE($pos-conf)

  set number $_LAYOUT_TABLE($pos-num)

  grid $what $itk_component(labelFrame) $number -minsize $minsize

  set _reposition ""

}

# -----------------------------------------------------------------------------

# PROTECTED METHOD: _collapseMargin

#

# Resets the "-minsize" of all rows and columns of the labelFrame's grid

# used to set the label margin to 0

# -----------------------------------------------------------------------------

body iwidgets::Labeledframe::_collapseMargin {} {

  grid columnconfigure $itk_component(labelFrame) 0 -minsize 0

  grid columnconfigure $itk_component(labelFrame) 2 -minsize 0

  grid rowconfigure $itk_component(labelFrame) 0 -minsize 0

  grid rowconfigure $itk_component(labelFrame) 2 -minsize 0

}

# -----------------------------------------------------------------------------

# PROTECTED METHOD: _setMarginThickness

#

# Set the margin thickness ( i.e. the hidden "-highlightthickness"

# of the labelFrame ) to the input value.

#

# -----------------------------------------------------------------------------

body iwidgets::Labeledframe::_setMarginThickness {value} {

  $itk_component(labelFrame) configure -highlightthickness $value

}