home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / iwidgets3.0.0 / scripts / labeledframe.itk < prev    next >
Text File  |  1999-02-24  |  17KB  |  492 lines
  1. #
  2. # Labeledframe
  3. # ----------------------------------------------------------------------
  4. # Implements a hull frame with a grooved relief, a label, and a
  5. # frame childsite.
  6. #
  7. # The frame childsite can be filled with any widget via a derived class
  8. # or though the use of the childsite method.  This class was designed
  9. # to be a general purpose base class for supporting the combination of
  10. # a labeled frame and a childsite.  The options include the ability to
  11. # position the label at configurable locations within the grooved relief
  12. # of the hull frame, and control the display of the label.
  13. #
  14. #  To following demonstrates the different values which the "-labelpos"
  15. #  option may be set to and the resulting layout of the label when
  16. #  one executes the following command with "-labeltext" set to "LABEL":
  17. #
  18. #  example:
  19. #   labeledframe .w -labeltext LABEL -labelpos <ne,n,nw,se,s,sw,en,e,es,wn,s,ws>
  20. #
  21. #      ne          n         nw         se          s         sw
  22. #
  23. #   *LABEL****  **LABEL**  ****LABEL*  **********  ********* **********
  24. #   *        *  *       *  *        *  *        *  *       * *        *  
  25. #   *        *  *       *  *        *  *        *  *       * *        *  
  26. #   *        *  *       *  *        *  *        *  *       * *        *
  27. #   **********  *********  **********  *LABEL****  **LABEL** ****LABEL*
  28. #
  29. #      en          e         es         wn          s         ws
  30. #
  31. #   **********  *********  *********  *********  *********  **********
  32. #   *        *  *        * *       *  *        * *       *  *        *
  33. #   L        *  *        * *       *  *        L *       *  *        *
  34. #   A        *  L        * *       *  *        A *       L  *        L
  35. #   B        *  A        * L       *  *        B *       A  *        A
  36. #   E        *  B        * A       *  *        E *       B  *        B
  37. #   L        *  E        * B       *  *        L *       E  *        E
  38. #   *        *  L        * E       *  *        * *       L  *        L
  39. #   *        *  *        * L       *  *        * *       *  *        *
  40. #   **********  ********** *********  ********** *********  **********
  41. #
  42. # ----------------------------------------------------------------------
  43. #  AUTHOR: John A. Tucker               EMAIL: jatucker@spd.dsccc.com
  44. #
  45. # ======================================================================
  46. #            Copyright (c) 1997 DSC Technologies Corporation
  47. # ======================================================================
  48. # Permission to use, copy, modify, distribute and license this software 
  49. # and its documentation for any purpose, and without fee or written 
  50. # agreement with DSC, is hereby granted, provided that the above copyright 
  51. # notice appears in all copies and that both the copyright notice and 
  52. # warranty disclaimer below appear in supporting documentation, and that 
  53. # the names of DSC Technologies Corporation or DSC Communications 
  54. # Corporation not be used in advertising or publicity pertaining to the 
  55. # software without specific, written prior permission.
  56. # 
  57. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  58. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  59. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  60. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  61. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  62. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  63. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  64. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  65. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  66. # SOFTWARE.
  67. # ======================================================================
  68.  
  69. #
  70. # Default resources.
  71. #
  72. option add *Labeledframe.labelMargin    10      widgetDefault
  73. option add *Labeledframe.labelFont     \
  74.       "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"  widgetDefault
  75. option add *Labeledframe.labelPos       n       widgetDefault
  76. option add *Labeledframe.borderWidth    2      widgetDefault
  77. option add *Labeledframe.relief         groove widgetDefault
  78.  
  79.  
  80. #
  81. # Usual options.
  82. #
  83. itk::usual Labeledframe {
  84.     keep -background -cursor -labelfont -foreground
  85. }
  86.  
  87. class iwidgets::Labeledframe {
  88.  
  89.   inherit itk::Archetype
  90.  
  91.   itk_option define -ipadx iPadX IPad 0
  92.   itk_option define -ipady iPadY IPad 0
  93.  
  94.   itk_option define -labelmargin labelMargin LabelMargin 10
  95.   itk_option define -labelpos labelPos LabelPos n
  96.  
  97.   constructor {args} {}
  98.   destructor {}
  99.  
  100.   #
  101.   # Public methods
  102.   #
  103.   public method childsite {}
  104.  
  105.   #
  106.   # Private methods
  107.   #
  108.     method smt {value} { _setMarginThickness $value }
  109.   private {
  110.     method _positionLabel {{when later}}
  111.     method _collapseMargin {}
  112.     method _setMarginThickness {value}
  113.  
  114.     proc _initTable {}
  115.  
  116.     variable _reposition ""  ;# non-null => _positionLabel pending
  117.     variable itk_hull ""
  118.  
  119.     common _LAYOUT_TABLE 
  120.   }
  121. }
  122.  
  123. #
  124. # Provide a lowercased access method for the Labeledframe class.
  125. # 
  126. proc ::iwidgets::labeledframe {pathName args} {
  127.     uplevel ::iwidgets::Labeledframe $pathName $args
  128. }
  129.  
  130. # -----------------------------------------------------------------------------
  131. #                        CONSTRUCTOR
  132. # -----------------------------------------------------------------------------
  133. body iwidgets::Labeledframe::constructor { args } {
  134.   #
  135.   #  Create a window with the same name as this object
  136.   #
  137.   set itk_hull [namespace tail $this]
  138.   set itk_interior $itk_hull
  139.  
  140.   itk_component add hull {
  141.     frame $itk_hull \
  142.           -relief groove \
  143.           -class [namespace tail [info class]]
  144.   } {
  145.     keep -background -cursor -relief -borderwidth
  146.     rename -highlightbackground -background background Background
  147.     rename -highlightcolor -background background Background
  148.   }
  149.   bind itk-delete-$itk_hull <Destroy> "delete object $this"
  150.  
  151.   set tags [bindtags $itk_hull]
  152.   bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
  153.  
  154.   #
  155.   # Create the childsite frame window
  156.   # _______
  157.   # |_____|
  158.   # |_|X|_|
  159.   # |_____|
  160.   #
  161.   itk_component add childsite {
  162.     frame $itk_interior.childsite -highlightthickness 0 -bd 0
  163.   } 
  164.  
  165.   #
  166.   # Create the label to be positioned within the grooved relief
  167.   # of the hull frame.
  168.   #
  169.   itk_component add label {
  170.     label $itk_interior.label -highlightthickness 0 -bd 0
  171.   } { 
  172.     usual
  173.     rename -bitmap -labelbitmap labelBitmap Bitmap
  174.     rename -font -labelfont labelFont Font
  175.     rename -image -labelimage labelImage Image
  176.     rename -text -labeltext labelText Text
  177.     rename -textvariable -labelvariable labelVariable Variable
  178.     ignore -highlightthickness -highlightcolor
  179.   }
  180.  
  181.   grid $itk_component(childsite) -row 1 -column 1 -sticky nsew
  182.   grid columnconfigure $itk_interior 1 -weight 1
  183.   grid rowconfigure    $itk_interior 1 -weight 1
  184.  
  185.   bind $itk_component(label) <Configure> +[code $this _positionLabel]
  186.  
  187.   #
  188.   # Initialize the class array of layout configuration options.  Since
  189.   # this is a one time only thing.
  190.   #
  191.   _initTable
  192.  
  193.   eval itk_initialize $args
  194.  
  195.   # 
  196.   # When idle, position the label.
  197.   #
  198.   _positionLabel
  199. }
  200.  
  201. # -----------------------------------------------------------------------------
  202. #                           DESTURCTOR
  203. # -----------------------------------------------------------------------------
  204. body iwidgets::Labeledframe::destructor {} {
  205.  
  206.   if {$_reposition != ""} {
  207.     after cancel $_reposition
  208.   }
  209.  
  210.   if {[winfo exists $itk_hull]} {
  211.     set tags [bindtags $itk_hull]
  212.     set i [lsearch $tags itk-delete-$itk_hull]
  213.     if {$i >= 0} {
  214.       bindtags $itk_hull [lreplace $tags $i $i]
  215.     }
  216.     destroy $itk_hull
  217.   }
  218. }
  219.  
  220. # -----------------------------------------------------------------------------
  221. #                             OPTIONS
  222. # -----------------------------------------------------------------------------
  223.  
  224. # ------------------------------------------------------------------
  225. # OPTION: -ipadx
  226. #
  227. # Specifies the width of the horizontal gap from the border to the
  228. # the child site.
  229. # ------------------------------------------------------------------
  230. configbody iwidgets::Labeledframe::ipadx {
  231.   grid configure $itk_component(childsite) -padx $itk_option(-ipadx)
  232.   _positionLabel
  233. }
  234.  
  235. # ------------------------------------------------------------------
  236. # OPTION: -ipady
  237. #
  238. # Specifies the width of the vertical gap from the border to the
  239. # the child site.
  240. # ------------------------------------------------------------------
  241. configbody iwidgets::Labeledframe::ipady {
  242.   grid configure $itk_component(childsite) -pady $itk_option(-ipady)
  243.   _positionLabel
  244. }
  245.  
  246. # -----------------------------------------------------------------------------
  247. # OPTION: -labelmargin
  248. #
  249. # Set the margin of the most adjacent side of the label to the hull
  250. # relief.
  251. # ----------------------------------------------------------------------------
  252. configbody iwidgets::Labeledframe::labelmargin {
  253.   _positionLabel
  254. }
  255.  
  256. # -----------------------------------------------------------------------------
  257. # OPTION: -labelpos
  258. #
  259. # Set the position of the label within the relief of the hull frame
  260. # widget.
  261. # ----------------------------------------------------------------------------
  262. configbody iwidgets::Labeledframe::labelpos {
  263.   _positionLabel
  264. }
  265.  
  266. # -----------------------------------------------------------------------------
  267. #                            PROCS
  268. # -----------------------------------------------------------------------------
  269.  
  270. # -----------------------------------------------------------------------------
  271. # PRIVATE PROC: _initTable
  272. #
  273. # Initializes the _LAYOUT_TABLE common variable of the Labeledframe
  274. # class.  The initialization is performed in its own proc ( as opposed
  275. # to in the class definition ) so that the initialization occurs only
  276. # once.
  277. #
  278. # _LAYOUT_TABLE common array description:
  279. #   Provides a table of the configuration option values
  280. #   used to place the label widget within the grooved relief of the hull
  281. #   frame for each of the 12 possible "-labelpos" values.
  282. #
  283. #   Each of the 12 rows is layed out as follows:
  284. #     {"-relx" "-rely" <rowconfigure|columnconfigure> <row/column number>}
  285. # -----------------------------------------------------------------------------
  286. body iwidgets::Labeledframe::_initTable {} {
  287.   array set _LAYOUT_TABLE {
  288.     nw-relx 0.0  nw-rely 0.0  nw-wrap 0 nw-conf rowconfigure    nw-num 0
  289.     n-relx  0.5  n-rely  0.0  n-wrap  0 n-conf  rowconfigure    n-num  0
  290.     ne-relx 1.0  ne-rely 0.0  ne-wrap 0 ne-conf rowconfigure    ne-num 0
  291.  
  292.     sw-relx 0.0  sw-rely 1.0  sw-wrap 0 sw-conf rowconfigure    sw-num 2
  293.     s-relx  0.5  s-rely  1.0  s-wrap  0 s-conf  rowconfigure    s-num  2
  294.     se-relx 1.0  se-rely 1.0  se-wrap 0 se-conf rowconfigure    se-num 2
  295.  
  296.     en-relx 1.0  en-rely 0.0  en-wrap 1 en-conf columnconfigure en-num 2
  297.     e-relx  1.0  e-rely  0.5  e-wrap  1 e-conf  columnconfigure e-num  2
  298.     es-relx 1.0  es-rely 1.0  es-wrap 1 es-conf columnconfigure es-num 2
  299.  
  300.     wn-relx 0.0  wn-rely 0.0  wn-wrap 1 wn-conf columnconfigure wn-num 0
  301.     w-relx  0.0  w-rely  0.5  w-wrap  1 w-conf  columnconfigure w-num  0
  302.     ws-relx 0.0  ws-rely 1.0  ws-wrap 1 ws-conf columnconfigure ws-num 0
  303.     }
  304.  
  305.   #
  306.   # Since this is a one time only thing, we'll redefine the proc to be empty
  307.   # afterwards so it only happens once.
  308.   #
  309.   # NOTE: Be careful to use the "body" command, or the proc will get lost!
  310.   #
  311.   itcl::body ::iwidgets::Labeledframe::_initTable {} {}
  312. }
  313.  
  314. # -----------------------------------------------------------------------------
  315. #                            METHODS
  316. # -----------------------------------------------------------------------------
  317.  
  318. # -----------------------------------------------------------------------------
  319. # PUBLIC METHOD:: childsite
  320. #
  321. # -----------------------------------------------------------------------------
  322. body iwidgets::Labeledframe::childsite {} {
  323.   return $itk_component(childsite)
  324. }
  325.  
  326. # -----------------------------------------------------------------------------
  327. # PROTECTED METHOD: _positionLabel ?when?
  328. #
  329. # Places the label in the relief of the hull.  If "when" is "now", the
  330. # change is applied immediately.  If it is "later" or it is not
  331. # specified, then the change is applied later, when the application
  332. # is idle.
  333. # -----------------------------------------------------------------------------
  334. body iwidgets::Labeledframe::_positionLabel {{when later}} {
  335.  
  336.   if {$when == "later"} {
  337.     if {$_reposition == ""} {
  338.       set _reposition [after idle [code $this _positionLabel now]]
  339.     }
  340.     return
  341.   } 
  342.  
  343.   set pos $itk_option(-labelpos)
  344.  
  345.   #
  346.   # If there is not an entry for the "relx" value associated with
  347.   # the given "-labelpos" option value, then it invalid.
  348.   #
  349.   if { [catch {set relx $_LAYOUT_TABLE($pos-relx)}] } {
  350.     error "bad labelpos option\"$itk_option(-labelpos)\": should be\
  351.                   nw, n, ne, sw, s, se, en, e, es, wn, w, or ws"
  352.   }
  353.  
  354.   update idletasks
  355.   $itk_component(label) configure -wraplength $_LAYOUT_TABLE($pos-wrap)
  356.   set labelWidth [winfo reqwidth $itk_component(label)]
  357.   set labelHeight [winfo reqheight $itk_component(label)]
  358.   set borderwidth $itk_option(-borderwidth)
  359.   set margin $itk_option(-labelmargin)
  360.  
  361.   switch $pos {
  362.     nw {
  363.       set labelThickness $labelHeight
  364.       set minsize [expr $labelThickness/2.0]
  365.       set xPos [expr $minsize+$borderwidth+$margin]
  366.       set yPos -$minsize
  367.     }
  368.     n {
  369.       set labelThickness $labelHeight
  370.       set minsize [expr $labelThickness/2.0]
  371.       set xPos [expr -$labelWidth/2.0]
  372.       set yPos -$minsize
  373.     }
  374.     ne  {
  375.       set labelThickness $labelHeight
  376.       set minsize [expr $labelThickness/2.0]
  377.       set xPos [expr -($minsize+$borderwidth+$margin+$labelWidth)]
  378.       set yPos -$minsize
  379.     }
  380.  
  381.     sw  {
  382.       set labelThickness $labelHeight
  383.       set minsize [expr $labelThickness/2.0]
  384.       set xPos [expr $minsize+$borderwidth+$margin]
  385.       set yPos -$minsize
  386.     }
  387.     s {
  388.       set labelThickness $labelHeight
  389.       set minsize [expr $labelThickness/2.0]
  390.       set xPos [expr -$labelWidth/2.0]
  391.       set yPos [expr -$labelHeight/2.0]
  392.     }
  393.     se {
  394.       set labelThickness $labelHeight
  395.       set minsize [expr $labelThickness/2.0]
  396.       set xPos [expr -($minsize+$borderwidth+$margin+$labelWidth)]
  397.       set yPos [expr -$labelHeight/2.0]
  398.     }
  399.  
  400.     wn {
  401.       set labelThickness $labelWidth
  402.       set minsize [expr $labelThickness/2.0]
  403.       set xPos -$minsize
  404.       set yPos [expr $minsize+$margin+$borderwidth]
  405.     }
  406.     w {
  407.       set labelThickness $labelWidth
  408.       set minsize [expr $labelThickness/2.0]
  409.       set xPos -$minsize
  410.       set yPos [expr -($labelHeight/2.0)]
  411.     }
  412.     ws {
  413.       set labelThickness $labelWidth
  414.       set minsize [expr $labelThickness/2.0]
  415.       set xPos -$minsize
  416.       set yPos [expr -($minsize+$borderwidth+$margin+$labelHeight)]
  417.     }
  418.  
  419.     en {
  420.       set labelThickness $labelWidth
  421.       set minsize [expr $labelThickness/2.0]
  422.       set xPos -$minsize
  423.       set yPos [expr $minsize+$borderwidth+$margin]
  424.     }
  425.     e {
  426.       set labelThickness $labelWidth
  427.       set minsize [expr $labelThickness/2.0]
  428.       set xPos -$minsize
  429.       set yPos [expr -($labelHeight/2.0)]
  430.     }
  431.     es {
  432.       set labelThickness $labelWidth
  433.       set minsize [expr $labelThickness/2.0]
  434.       set xPos -$minsize
  435.       set yPos [expr -($minsize+$borderwidth+$margin+$labelHeight)]
  436.     }
  437.   }
  438.   _setMarginThickness $minsize
  439.  
  440.   place $itk_component(label) \
  441.         -relx $_LAYOUT_TABLE($pos-relx) -x $xPos \
  442.         -rely $_LAYOUT_TABLE($pos-rely) -y $yPos \
  443.         -anchor nw
  444.  
  445.   set what $_LAYOUT_TABLE($pos-conf)
  446.   set number $_LAYOUT_TABLE($pos-num)
  447.  
  448.   grid $what $itk_interior $number -minsize $minsize
  449.  
  450.   set _reposition ""
  451. }
  452.  
  453. # -----------------------------------------------------------------------------
  454. # PROTECTED METHOD: _collapseMargin
  455. #
  456. # Resets the "-minsize" of all rows and columns of the hull's grid
  457. # used to set the label margin to 0
  458. # -----------------------------------------------------------------------------
  459. body iwidgets::Labeledframe::_collapseMargin {} {
  460.   grid columnconfigure $itk_interior 0 -minsize 0
  461.   grid columnconfigure $itk_interior 2 -minsize 0
  462.   grid rowconfigure $itk_interior 0 -minsize 0
  463.   grid rowconfigure $itk_interior 2 -minsize 0
  464. }
  465.  
  466. # -----------------------------------------------------------------------------
  467. # PROTECTED METHOD: _setMarginThickness
  468. #
  469. # Set the margin thickness ( i.e. the hidden "-highlightthickness"
  470. # of the hull ) to the input value.
  471. #
  472. # The "-highlightthickness" option of the hull frame is not intended to be
  473. # configured by users of this class, but does need to be configured to properly
  474. # place the label whenever the label is configured.
  475. #
  476. # Therefore, since I can't find a better way at this time, I achieve this 
  477. # configuration by: adding the "-highlightthickness" option back into
  478. # the hull frame; configuring the "-highlightthickness" option to properly
  479. # place the label;  and then remove the "-highlightthickness" option from the
  480. # hull.
  481. #
  482. # This way the option is not visible or configurable without some hacking.
  483. #
  484. # -----------------------------------------------------------------------------
  485. body iwidgets::Labeledframe::_setMarginThickness {value} {
  486.   itk_option add hull.highlightthickness
  487.   $itk_component(hull) configure -highlightthickness $value
  488.   itk_option remove hull.highlightthickness
  489. }
  490.  
  491.  
  492.