home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / iwidgets2.2.0 / scripts / labeledwidget.itk < prev    next >
Text File  |  1999-02-24  |  14KB  |  407 lines
  1. #
  2. # Labeledwidget
  3. # ----------------------------------------------------------------------
  4. # Implements a labeled widget which contains a label and child site.
  5. # The child site is a frame which can filled with any widget via a 
  6. # derived class or though the use of the childSite method.  This class
  7. # was designed to be a general purpose base class for supporting the 
  8. # combination of label widget and a childsite.  The options include the
  9. # ability to position the label around the childsite widget, modify the
  10. # font and margin, and control the display of the label.  
  11. #
  12. # ----------------------------------------------------------------------
  13. #  AUTHOR: Mark L. Ulferts               EMAIL: mulferts@spd.dsccc.com
  14. #
  15. #  @(#) $Id: labeledwidget.itk,v 1.1 1998/07/27 18:49:33 stanton Exp $
  16. # ----------------------------------------------------------------------
  17. #            Copyright (c) 1995 DSC Technologies Corporation
  18. # ======================================================================
  19. # Permission to use, copy, modify, distribute and license this software 
  20. # and its documentation for any purpose, and without fee or written 
  21. # agreement with DSC, is hereby granted, provided that the above copyright 
  22. # notice appears in all copies and that both the copyright notice and 
  23. # warranty disclaimer below appear in supporting documentation, and that 
  24. # the names of DSC Technologies Corporation or DSC Communications 
  25. # Corporation not be used in advertising or publicity pertaining to the 
  26. # software without specific, written prior permission.
  27. # 
  28. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  29. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  30. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  31. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  32. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  33. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  34. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  35. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  36. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  37. # SOFTWARE.
  38. # ======================================================================
  39.  
  40. #
  41. # Default resources.
  42. #
  43. option add *Labeledwidget.labelMargin 1 widgetDefault
  44.  
  45. #
  46. # Usual options.
  47. #
  48. itk::usual Labeledwidget {
  49.     keep -background -cursor -foreground -labelfont
  50. }
  51.  
  52. # ------------------------------------------------------------------
  53. #                            LABELEDWIDGET
  54. # ------------------------------------------------------------------
  55. class iwidgets::Labeledwidget {
  56.     inherit itk::Widget
  57.  
  58.     constructor {args} {}
  59.     destructor {}
  60.  
  61.     itk_option define -labelpos labelPos Position w
  62.     itk_option define -labelmargin labelMargin Margin 1
  63.     itk_option define -labeltext labelText Text {}
  64.     itk_option define -labelvariable labelVariable Variable {}
  65.     itk_option define -labelbitmap labelBitmap Bitmap {}
  66.     itk_option define -labelimage labelImage Image {}
  67.  
  68.     public method childsite
  69.     
  70.     protected method _positionLabel {{when later}}
  71.  
  72.     proc alignlabels {args} {}
  73.  
  74.     protected variable _reposition ""  ;# non-null => _positionLabel pending
  75. }
  76.     
  77. #
  78. # Provide a lowercased access method for the Labeledwidget class.
  79. # 
  80. proc ::iwidgets::labeledwidget {pathName args} {
  81.     uplevel ::iwidgets::Labeledwidget $pathName $args
  82. }
  83.  
  84. # ------------------------------------------------------------------
  85. #                        CONSTRUCTOR
  86. # ------------------------------------------------------------------
  87. body iwidgets::Labeledwidget::constructor {args} {
  88.     # 
  89.     # Create the outermost frame to maintain geometry.
  90.     #
  91.     itk_component add shell {
  92.     frame $itk_interior.shell
  93.     } {
  94.     keep -background -cursor
  95.     }
  96.     pack $itk_component(shell) -fill both -expand yes
  97.     
  98.     #
  99.     # Create a frame for the childsite widget.
  100.     #
  101.     itk_component add lwchildsite {
  102.     frame $itk_component(shell).lwchildsite
  103.     } {
  104.     keep -background -cursor
  105.     }
  106.     pack $itk_component(lwchildsite) -fill both -expand yes
  107.     set itk_interior $itk_component(lwchildsite)
  108.     
  109.     #
  110.     # Create label.
  111.     #
  112.     itk_component add label {
  113.     label $itk_component(shell).label
  114.     } {
  115.     keep -background -foreground -cursor 
  116.     
  117.     rename -font -labelfont labelFont Font
  118.     }
  119.     
  120.     #
  121.     # Create margin between label and the child site.
  122.     #
  123.     itk_component add labmargin {
  124.     frame $itk_component(shell).labmargin
  125.     } {
  126.     keep -background -cursor
  127.     }
  128.     
  129.     #
  130.     # Explicitly handle configs that may have been ignored earlier.
  131.     #
  132.     eval itk_initialize $args
  133.  
  134.     # 
  135.     # When idle, position the label.
  136.     #
  137.     _positionLabel
  138. }
  139.  
  140. # ------------------------------------------------------------------
  141. #                           DESTURCTOR
  142. # ------------------------------------------------------------------
  143. body iwidgets::Labeledwidget::destructor {} {
  144.     if {$_reposition != ""} {after cancel $_reposition}
  145. }
  146.  
  147. # ------------------------------------------------------------------
  148. #                             OPTIONS
  149. # ------------------------------------------------------------------
  150.  
  151. # ------------------------------------------------------------------
  152. # OPTION: -labelpos
  153. #
  154. # Set the position of the label on the labeled widget.  The margin
  155. # between the label and childsite comes along for the ride.
  156. # ------------------------------------------------------------------
  157. configbody iwidgets::Labeledwidget::labelpos {
  158.     _positionLabel
  159. }
  160.  
  161. # ------------------------------------------------------------------
  162. # OPTION: -labelmargin
  163. #
  164. # Specifies the distance between the widget and label.
  165. # ------------------------------------------------------------------
  166. configbody iwidgets::Labeledwidget::labelmargin {
  167.     _positionLabel
  168. }
  169.  
  170. # ------------------------------------------------------------------
  171. # OPTION: -labeltext
  172. #
  173. # Specifies the label text.
  174. # ------------------------------------------------------------------
  175. configbody iwidgets::Labeledwidget::labeltext {
  176.     $itk_component(label) configure -text $itk_option(-labeltext)
  177.     
  178.     _positionLabel
  179. }
  180.  
  181. # ------------------------------------------------------------------
  182. # OPTION: -labelvariable
  183. #
  184. # Specifies the label text variable.
  185. # ------------------------------------------------------------------
  186. configbody iwidgets::Labeledwidget::labelvariable {
  187.     $itk_component(label) configure -textvariable $itk_option(-labelvariable)
  188.     
  189.     _positionLabel
  190. }
  191.  
  192. # ------------------------------------------------------------------
  193. # OPTION: -labelbitmap
  194. #
  195. # Specifies the label bitmap.
  196. # ------------------------------------------------------------------
  197. configbody iwidgets::Labeledwidget::labelbitmap {
  198.     $itk_component(label) configure -bitmap $itk_option(-labelbitmap)
  199.     
  200.     _positionLabel
  201. }
  202.  
  203. # ------------------------------------------------------------------
  204. # OPTION: -labelimage
  205. #
  206. # Specifies the label image.
  207. # ------------------------------------------------------------------
  208. configbody iwidgets::Labeledwidget::labelimage {
  209.     $itk_component(label) configure -image $itk_option(-labelimage)
  210.     
  211.     _positionLabel
  212. }
  213.  
  214. # ------------------------------------------------------------------
  215. #                            METHODS
  216. # ------------------------------------------------------------------
  217.  
  218. # ------------------------------------------------------------------
  219. # METHOD: childsite
  220. #
  221. # Returns the path name of the child site widget.
  222. # ------------------------------------------------------------------
  223. body iwidgets::Labeledwidget::childsite {} {
  224.     return $itk_component(lwchildsite)
  225. }
  226.  
  227. # ------------------------------------------------------------------
  228. # PROCEDURE: alignlabels widget ?widget ...?
  229. #
  230. # The alignlabels procedure takes a list of widgets derived from
  231. # the Labeledwidget class and adjusts the label margin to align 
  232. # the labels.
  233. # ------------------------------------------------------------------
  234. body iwidgets::Labeledwidget::alignlabels {args} {
  235.     update
  236.     set maxLabelWidth 0
  237.     
  238.     #
  239.     # Verify that all the widgets are of type Labeledwidget and 
  240.     # determine the size of the maximum length label string.
  241.     #
  242.     foreach iwid $args {
  243.     set objcmd [itcl::find objects -isa Labeledwidget *::$iwid]
  244.  
  245.     if {$objcmd == ""} {
  246.         error "$iwid is not a \"Labeledwidget\""
  247.     }
  248.     
  249.     set csWidth [winfo reqwidth $iwid.shell.lwchildsite]
  250.     set shellWidth [winfo reqwidth $iwid.shell]
  251.         
  252.     if {[expr $shellWidth - $csWidth] > $maxLabelWidth} {
  253.         set maxLabelWidth [expr $shellWidth - $csWidth]
  254.     }
  255.     }
  256.     
  257.     #
  258.     # Adjust the margins for the labels such that the child sites and
  259.     # labels line up.
  260.     #
  261.     foreach iwid $args {
  262.     set csWidth [winfo reqwidth $iwid.shell.lwchildsite]
  263.     set shellWidth [winfo reqwidth $iwid.shell]
  264.     
  265.     set labelSize [expr $shellWidth - $csWidth]
  266.     
  267.     if {$maxLabelWidth > $labelSize} {
  268.         set dist [expr $maxLabelWidth - \
  269.             ($labelSize - [winfo reqwidth $iwid.shell.labmargin])]
  270.         
  271.         set objcmd [itcl::find objects -isa Labeledwidget *::$iwid]
  272.         $objcmd configure -labelmargin $dist 
  273.     }
  274.     }    
  275. }
  276.  
  277. # ------------------------------------------------------------------
  278. # PROTECTED METHOD: _positionLabel ?when?
  279. #
  280. # Packs the label and label margin.  If "when" is "now", the
  281. # change is applied immediately.  If it is "later" or it is not
  282. # specified, then the change is applied later, when the application
  283. # is idle.
  284. # ------------------------------------------------------------------
  285. body iwidgets::Labeledwidget::_positionLabel {{when later}} {
  286.     if {$when == "later"} {
  287.     if {$_reposition == ""} {
  288.         set _reposition [after idle [code $this _positionLabel now]]
  289.     }
  290.     return
  291.     } elseif {$when != "now"} {
  292.     error "bad option \"$when\": should be now or later"
  293.     }
  294.  
  295.     if {($itk_option(-labeltext) != {}) ||
  296.         ($itk_option(-labelbitmap) != {}) ||
  297.         ($itk_option(-labelimage) != {})} {
  298.     switch $itk_option(-labelpos) {
  299.         nw {
  300.         pack configure $itk_component(lwchildsite) -side top
  301.         
  302.         $itk_component(labmargin) configure -width 1 -height \
  303.             [winfo pixels $itk_component(labmargin) \
  304.              $itk_option(-labelmargin)]
  305.         pack configure $itk_component(labmargin) -side top \
  306.             -before $itk_component(lwchildsite)
  307.         pack configure $itk_component(label) -anchor w \
  308.             -side top -before $itk_component(labmargin)
  309.         }
  310.         
  311.         n {
  312.         pack configure $itk_component(lwchildsite) -side top
  313.         
  314.         $itk_component(labmargin) configure -width 1 -height \
  315.             [winfo pixels $itk_component(labmargin) \
  316.             $itk_option(-labelmargin)]
  317.         pack configure $itk_component(labmargin) -side top \
  318.             -before $itk_component(lwchildsite)
  319.         pack configure $itk_component(label) -anchor center \
  320.             -before $itk_component(labmargin) -side top
  321.         }
  322.         
  323.         ne {
  324.         pack configure $itk_component(lwchildsite) -side top
  325.         
  326.         $itk_component(labmargin) configure -width 1 -height \
  327.             [winfo pixels $itk_component(labmargin) \
  328.             $itk_option(-labelmargin)]
  329.         pack configure $itk_component(labmargin) -side top \
  330.             -before $itk_component(lwchildsite)
  331.         pack configure $itk_component(label) -anchor e \
  332.             -side top -before $itk_component(labmargin)
  333.         }
  334.         
  335.         e {
  336.         pack configure $itk_component(lwchildsite) -side right
  337.         
  338.         $itk_component(labmargin) configure -height 1 -width \
  339.             [winfo pixels $itk_component(labmargin) \
  340.             $itk_option(-labelmargin)]
  341.         pack configure $itk_component(labmargin) \
  342.             -side right -before $itk_component(lwchildsite)
  343.         pack configure $itk_component(label) -anchor center \
  344.             -side right -before $itk_component(labmargin)
  345.         }
  346.         
  347.         se {
  348.         pack configure $itk_component(lwchildsite) -side top
  349.         
  350.         $itk_component(labmargin) configure -width 1 -height \
  351.             [winfo pixels $itk_component(labmargin) \
  352.             $itk_option(-labelmargin)]
  353.         pack configure $itk_component(labmargin) \
  354.             -side top -after $itk_component(lwchildsite)
  355.         pack configure $itk_component(label) -anchor e \
  356.             -side bottom -after $itk_component(labmargin)
  357.         }
  358.         
  359.         s {
  360.         pack configure $itk_component(lwchildsite) -side top
  361.         
  362.         $itk_component(labmargin) configure -width 1 -height \
  363.             [winfo pixels $itk_component(labmargin) \
  364.             $itk_option(-labelmargin)]
  365.         pack configure $itk_component(labmargin) \
  366.             -side top -after $itk_component(lwchildsite)
  367.         pack configure $itk_component(label) -anchor center \
  368.             -side bottom -after $itk_component(labmargin)
  369.         }
  370.         
  371.         sw {
  372.         pack configure $itk_component(lwchildsite) -side top
  373.         
  374.         $itk_component(labmargin) configure -width 1 -height \
  375.             [winfo pixels $itk_component(labmargin) \
  376.             $itk_option(-labelmargin)]
  377.         pack configure $itk_component(labmargin) \
  378.             -side top -after $itk_component(lwchildsite)
  379.         pack configure $itk_component(label) -anchor w \
  380.             -side bottom -after $itk_component(labmargin)
  381.         }
  382.         
  383.         w {
  384.         pack configure $itk_component(lwchildsite) -side right
  385.         
  386.         $itk_component(labmargin) configure -height 1 -width \
  387.             [winfo pixels $itk_component(labmargin) \
  388.             $itk_option(-labelmargin)]
  389.         pack configure $itk_component(labmargin) \
  390.             -side left -before $itk_component(lwchildsite)
  391.         pack configure $itk_component(label) -anchor center \
  392.             -side left -before $itk_component(labmargin)
  393.         }
  394.     }
  395.  
  396.     #
  397.     # Else, neither the  label text, bitmap, or image have a value, so
  398.     # un pack them the label and margin.
  399.     #
  400.     } else {
  401.     pack forget $itk_component(label)
  402.     pack forget $itk_component(labmargin)
  403.     }
  404.  
  405.     set _reposition ""
  406. }
  407.