home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / labeledframe.itk < prev    next >
Text File  |  2003-09-01  |  18KB  |  497 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. itcl::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.   # Protected methods
  107.   #
  108.   protected {
  109.     method _positionLabel {{when later}}
  110.     method _collapseMargin {}
  111.     method _setMarginThickness {value}
  112.     method smt {value} { _setMarginThickness $value }
  113.   }
  114.  
  115.   #
  116.   # Private methods/data
  117.   #
  118.   private {
  119.     proc _initTable {}
  120.  
  121.     variable _reposition ""  ;# non-null => _positionLabel pending
  122.     variable itk_hull ""
  123.  
  124.     common _LAYOUT_TABLE 
  125.   }
  126. }
  127.  
  128. #
  129. # Provide a lowercased access method for the Labeledframe class.
  130. # 
  131. proc ::iwidgets::labeledframe {pathName args} {
  132.     uplevel ::iwidgets::Labeledframe $pathName $args
  133. }
  134.  
  135. # -----------------------------------------------------------------------------
  136. #                        CONSTRUCTOR
  137. # -----------------------------------------------------------------------------
  138. itcl::body iwidgets::Labeledframe::constructor { args } {
  139.   #
  140.   #  Create a window with the same name as this object
  141.   #
  142.   set itk_hull [namespace tail $this]
  143.   set itk_interior $itk_hull
  144.  
  145.   itk_component add hull {
  146.     frame $itk_hull \
  147.           -relief groove \
  148.           -class [namespace tail [info class]]
  149.   } {
  150.     keep -background -cursor -relief -borderwidth
  151.     rename -highlightbackground -background background Background
  152.     rename -highlightcolor -background background Background
  153.   }
  154.   bind itk-delete-$itk_hull <Destroy> "itcl::delete object $this"
  155.  
  156.   set tags [bindtags $itk_hull]
  157.   bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
  158.  
  159.   #
  160.   # Create the childsite frame window
  161.   # _______
  162.   # |_____|
  163.   # |_|X|_|
  164.   # |_____|
  165.   #
  166.   itk_component add childsite {
  167.     frame $itk_interior.childsite -highlightthickness 0 -bd 0
  168.   } 
  169.  
  170.   #
  171.   # Create the label to be positioned within the grooved relief
  172.   # of the hull frame.
  173.   #
  174.   itk_component add label {
  175.     label $itk_interior.label -highlightthickness 0 -bd 0
  176.   } { 
  177.     usual
  178.     rename -bitmap -labelbitmap labelBitmap Bitmap
  179.     rename -font -labelfont labelFont Font
  180.     rename -image -labelimage labelImage Image
  181.     rename -text -labeltext labelText Text
  182.     rename -textvariable -labelvariable labelVariable Variable
  183.     ignore -highlightthickness -highlightcolor
  184.   }
  185.  
  186.   grid $itk_component(childsite) -row 1 -column 1 -sticky nsew
  187.   grid columnconfigure $itk_interior 1 -weight 1
  188.   grid rowconfigure    $itk_interior 1 -weight 1
  189.  
  190.   bind $itk_component(label) <Configure> +[itcl::code $this _positionLabel]
  191.  
  192.   #
  193.   # Initialize the class array of layout configuration options.  Since
  194.   # this is a one time only thing.
  195.   #
  196.   _initTable
  197.  
  198.   eval itk_initialize $args
  199.  
  200.   # 
  201.   # When idle, position the label.
  202.   #
  203.   _positionLabel
  204. }
  205.  
  206. # -----------------------------------------------------------------------------
  207. #                           DESTRUCTOR
  208. # -----------------------------------------------------------------------------
  209. itcl::body iwidgets::Labeledframe::destructor {} {
  210.  
  211.   if {$_reposition != ""} {
  212.     after cancel $_reposition
  213.   }
  214.  
  215.   if {[winfo exists $itk_hull]} {
  216.     set tags [bindtags $itk_hull]
  217.     set i [lsearch $tags itk-delete-$itk_hull]
  218.     if {$i >= 0} {
  219.       bindtags $itk_hull [lreplace $tags $i $i]
  220.     }
  221.     destroy $itk_hull
  222.   }
  223. }
  224.  
  225. # -----------------------------------------------------------------------------
  226. #                             OPTIONS
  227. # -----------------------------------------------------------------------------
  228.  
  229. # ------------------------------------------------------------------
  230. # OPTION: -ipadx
  231. #
  232. # Specifies the width of the horizontal gap from the border to the
  233. # the child site.
  234. # ------------------------------------------------------------------
  235. itcl::configbody iwidgets::Labeledframe::ipadx {
  236.   grid configure $itk_component(childsite) -padx $itk_option(-ipadx)
  237.   _positionLabel
  238. }
  239.  
  240. # ------------------------------------------------------------------
  241. # OPTION: -ipady
  242. #
  243. # Specifies the width of the vertical gap from the border to the
  244. # the child site.
  245. # ------------------------------------------------------------------
  246. itcl::configbody iwidgets::Labeledframe::ipady {
  247.   grid configure $itk_component(childsite) -pady $itk_option(-ipady)
  248.   _positionLabel
  249. }
  250.  
  251. # -----------------------------------------------------------------------------
  252. # OPTION: -labelmargin
  253. #
  254. # Set the margin of the most adjacent side of the label to the hull
  255. # relief.
  256. # ----------------------------------------------------------------------------
  257. itcl::configbody iwidgets::Labeledframe::labelmargin {
  258.   _positionLabel
  259. }
  260.  
  261. # -----------------------------------------------------------------------------
  262. # OPTION: -labelpos
  263. #
  264. # Set the position of the label within the relief of the hull frame
  265. # widget.
  266. # ----------------------------------------------------------------------------
  267. itcl::configbody iwidgets::Labeledframe::labelpos {
  268.   _positionLabel
  269. }
  270.  
  271. # -----------------------------------------------------------------------------
  272. #                            PROCS
  273. # -----------------------------------------------------------------------------
  274.  
  275. # -----------------------------------------------------------------------------
  276. # PRIVATE PROC: _initTable
  277. #
  278. # Initializes the _LAYOUT_TABLE common variable of the Labeledframe
  279. # class.  The initialization is performed in its own proc ( as opposed
  280. # to in the class definition ) so that the initialization occurs only
  281. # once.
  282. #
  283. # _LAYOUT_TABLE common array description:
  284. #   Provides a table of the configuration option values
  285. #   used to place the label widget within the grooved relief of the hull
  286. #   frame for each of the 12 possible "-labelpos" values.
  287. #
  288. #   Each of the 12 rows is layed out as follows:
  289. #     {"-relx" "-rely" <rowconfigure|columnconfigure> <row/column number>}
  290. # -----------------------------------------------------------------------------
  291. itcl::body iwidgets::Labeledframe::_initTable {} {
  292.   array set _LAYOUT_TABLE {
  293.     nw-relx 0.0  nw-rely 0.0  nw-wrap 0 nw-conf rowconfigure    nw-num 0
  294.     n-relx  0.5  n-rely  0.0  n-wrap  0 n-conf  rowconfigure    n-num  0
  295.     ne-relx 1.0  ne-rely 0.0  ne-wrap 0 ne-conf rowconfigure    ne-num 0
  296.  
  297.     sw-relx 0.0  sw-rely 1.0  sw-wrap 0 sw-conf rowconfigure    sw-num 2
  298.     s-relx  0.5  s-rely  1.0  s-wrap  0 s-conf  rowconfigure    s-num  2
  299.     se-relx 1.0  se-rely 1.0  se-wrap 0 se-conf rowconfigure    se-num 2
  300.  
  301.     en-relx 1.0  en-rely 0.0  en-wrap 1 en-conf columnconfigure en-num 2
  302.     e-relx  1.0  e-rely  0.5  e-wrap  1 e-conf  columnconfigure e-num  2
  303.     es-relx 1.0  es-rely 1.0  es-wrap 1 es-conf columnconfigure es-num 2
  304.  
  305.     wn-relx 0.0  wn-rely 0.0  wn-wrap 1 wn-conf columnconfigure wn-num 0
  306.     w-relx  0.0  w-rely  0.5  w-wrap  1 w-conf  columnconfigure w-num  0
  307.     ws-relx 0.0  ws-rely 1.0  ws-wrap 1 ws-conf columnconfigure ws-num 0
  308.     }
  309.  
  310.   #
  311.   # Since this is a one time only thing, we'll redefine the proc to be empty
  312.   # afterwards so it only happens once.
  313.   #
  314.   # NOTE: Be careful to use the "body" command, or the proc will get lost!
  315.   #
  316.   itcl::body ::iwidgets::Labeledframe::_initTable {} {}
  317. }
  318.  
  319. # -----------------------------------------------------------------------------
  320. #                            METHODS
  321. # -----------------------------------------------------------------------------
  322.  
  323. # -----------------------------------------------------------------------------
  324. # PUBLIC METHOD:: childsite
  325. #
  326. # -----------------------------------------------------------------------------
  327. itcl::body iwidgets::Labeledframe::childsite {} {
  328.   return $itk_component(childsite)
  329. }
  330.  
  331. # -----------------------------------------------------------------------------
  332. # PROTECTED METHOD: _positionLabel ?when?
  333. #
  334. # Places the label in the relief of the hull.  If "when" is "now", the
  335. # change is applied immediately.  If it is "later" or it is not
  336. # specified, then the change is applied later, when the application
  337. # is idle.
  338. # -----------------------------------------------------------------------------
  339. itcl::body iwidgets::Labeledframe::_positionLabel {{when later}} {
  340.  
  341.   if {$when == "later"} {
  342.     if {$_reposition == ""} {
  343.       set _reposition [after idle [itcl::code $this _positionLabel now]]
  344.     }
  345.     return
  346.   } 
  347.  
  348.   set pos $itk_option(-labelpos)
  349.  
  350.   #
  351.   # If there is not an entry for the "relx" value associated with
  352.   # the given "-labelpos" option value, then it invalid.
  353.   #
  354.   if { [catch {set relx $_LAYOUT_TABLE($pos-relx)}] } {
  355.     error "bad labelpos option\"$itk_option(-labelpos)\": should be\
  356.                   nw, n, ne, sw, s, se, en, e, es, wn, w, or ws"
  357.   }
  358.  
  359.   update idletasks
  360.   $itk_component(label) configure -wraplength $_LAYOUT_TABLE($pos-wrap)
  361.   set labelWidth [winfo reqwidth $itk_component(label)]
  362.   set labelHeight [winfo reqheight $itk_component(label)]
  363.   set borderwidth $itk_option(-borderwidth)
  364.   set margin $itk_option(-labelmargin)
  365.  
  366.   switch $pos {
  367.     nw {
  368.       set labelThickness $labelHeight
  369.       set minsize [expr {$labelThickness/2.0}]
  370.       set xPos [expr {$minsize+$borderwidth+$margin}]
  371.       set yPos -$minsize
  372.     }
  373.     n {
  374.       set labelThickness $labelHeight
  375.       set minsize [expr {$labelThickness/2.0}]
  376.       set xPos [expr {-$labelWidth/2.0}]
  377.       set yPos -$minsize
  378.     }
  379.     ne  {
  380.       set labelThickness $labelHeight
  381.       set minsize [expr {$labelThickness/2.0}]
  382.       set xPos [expr {-($minsize+$borderwidth+$margin+$labelWidth)}]
  383.       set yPos -$minsize
  384.     }
  385.  
  386.     sw  {
  387.       set labelThickness $labelHeight
  388.       set minsize [expr {$labelThickness/2.0}]
  389.       set xPos [expr {$minsize+$borderwidth+$margin}]
  390.       set yPos -$minsize
  391.     }
  392.     s {
  393.       set labelThickness $labelHeight
  394.       set minsize [expr {$labelThickness/2.0}]
  395.       set xPos [expr {-$labelWidth/2.0}]
  396.       set yPos [expr {-$labelHeight/2.0}]
  397.     }
  398.     se {
  399.       set labelThickness $labelHeight
  400.       set minsize [expr {$labelThickness/2.0}]
  401.       set xPos [expr {-($minsize+$borderwidth+$margin+$labelWidth)}]
  402.       set yPos [expr {-$labelHeight/2.0}]
  403.     }
  404.  
  405.     wn {
  406.       set labelThickness $labelWidth
  407.       set minsize [expr {$labelThickness/2.0}]
  408.       set xPos -$minsize
  409.       set yPos [expr {$minsize+$margin+$borderwidth}]
  410.     }
  411.     w {
  412.       set labelThickness $labelWidth
  413.       set minsize [expr {$labelThickness/2.0}]
  414.       set xPos -$minsize
  415.       set yPos [expr {-($labelHeight/2.0)}]
  416.     }
  417.     ws {
  418.       set labelThickness $labelWidth
  419.       set minsize [expr {$labelThickness/2.0}]
  420.       set xPos -$minsize
  421.       set yPos [expr {-($minsize+$borderwidth+$margin+$labelHeight)}]
  422.     }
  423.  
  424.     en {
  425.       set labelThickness $labelWidth
  426.       set minsize [expr {$labelThickness/2.0}]
  427.       set xPos -$minsize
  428.       set yPos [expr {$minsize+$borderwidth+$margin}]
  429.     }
  430.     e {
  431.       set labelThickness $labelWidth
  432.       set minsize [expr {$labelThickness/2.0}]
  433.       set xPos -$minsize
  434.       set yPos [expr {-($labelHeight/2.0)}]
  435.     }
  436.     es {
  437.       set labelThickness $labelWidth
  438.       set minsize [expr {$labelThickness/2.0}]
  439.       set xPos -$minsize
  440.       set yPos [expr {-($minsize+$borderwidth+$margin+$labelHeight)}]
  441.     }
  442.   }
  443.   _setMarginThickness $minsize
  444.  
  445.   place $itk_component(label) \
  446.         -relx $_LAYOUT_TABLE($pos-relx) -x $xPos \
  447.         -rely $_LAYOUT_TABLE($pos-rely) -y $yPos \
  448.         -anchor nw
  449.  
  450.   set what $_LAYOUT_TABLE($pos-conf)
  451.   set number $_LAYOUT_TABLE($pos-num)
  452.  
  453.   grid $what $itk_interior $number -minsize $minsize
  454.  
  455.   set _reposition ""
  456. }
  457.  
  458. # -----------------------------------------------------------------------------
  459. # PROTECTED METHOD: _collapseMargin
  460. #
  461. # Resets the "-minsize" of all rows and columns of the hull's grid
  462. # used to set the label margin to 0
  463. # -----------------------------------------------------------------------------
  464. itcl::body iwidgets::Labeledframe::_collapseMargin {} {
  465.   grid columnconfigure $itk_interior 0 -minsize 0
  466.   grid columnconfigure $itk_interior 2 -minsize 0
  467.   grid rowconfigure $itk_interior 0 -minsize 0
  468.   grid rowconfigure $itk_interior 2 -minsize 0
  469. }
  470.  
  471. # -----------------------------------------------------------------------------
  472. # PROTECTED METHOD: _setMarginThickness
  473. #
  474. # Set the margin thickness ( i.e. the hidden "-highlightthickness"
  475. # of the hull ) to the input value.
  476. #
  477. # The "-highlightthickness" option of the hull frame is not intended to be
  478. # configured by users of this class, but does need to be configured to properly
  479. # place the label whenever the label is configured.
  480. #
  481. # Therefore, since I can't find a better way at this time, I achieve this 
  482. # configuration by: adding the "-highlightthickness" option back into
  483. # the hull frame; configuring the "-highlightthickness" option to properly
  484. # place the label;  and then remove the "-highlightthickness" option from the
  485. # hull.
  486. #
  487. # This way the option is not visible or configurable without some hacking.
  488. #
  489. # -----------------------------------------------------------------------------
  490. itcl::body iwidgets::Labeledframe::_setMarginThickness {value} {
  491.   itk_option add hull.highlightthickness
  492.   $itk_component(hull) configure -highlightthickness $value
  493.   itk_option remove hull.highlightthickness
  494. }
  495.  
  496.  
  497.