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 / pushbutton.itk < prev    next >
Text File  |  2003-09-01  |  12KB  |  357 lines
  1. #
  2. # Pushbutton
  3. # ----------------------------------------------------------------------
  4. # Implements a Motif-like Pushbutton with an optional default ring.
  5. #
  6. # WISH LIST:
  7. #    1)  Allow bitmaps and text on the same button face (Tk limitation).
  8. #    2)  provide arm and disarm bitmaps.
  9. #
  10. # ----------------------------------------------------------------------
  11. #   AUTHOR:  Mark L. Ulferts        EMAIL: mulferts@austin.dsccc.com
  12. #            Bret A. Schuhmacher    EMAIL: bas@wn.com
  13. #
  14. #   @(#) $Id: pushbutton.itk,v 1.3 2001/08/17 19:03:44 smithc Exp $
  15. # ----------------------------------------------------------------------
  16. #            Copyright (c) 1995 DSC Technologies Corporation
  17. # ======================================================================
  18. # Permission to use, copy, modify, distribute and license this software 
  19. # and its documentation for any purpose, and without fee or written 
  20. # agreement with DSC, is hereby granted, provided that the above copyright 
  21. # notice appears in all copies and that both the copyright notice and 
  22. # warranty disclaimer below appear in supporting documentation, and that 
  23. # the names of DSC Technologies Corporation or DSC Communications 
  24. # Corporation not be used in advertising or publicity pertaining to the 
  25. # software without specific, written prior permission.
  26. # 
  27. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  28. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  29. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  30. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  31. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  32. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  33. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  34. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  35. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  36. # SOFTWARE.
  37. # ======================================================================
  38.  
  39. #
  40. # Usual options.
  41. #
  42. itk::usual Pushbutton {
  43.     keep -activebackground -activeforeground -background -borderwidth \
  44.      -cursor -disabledforeground -font -foreground -highlightbackground \
  45.      -highlightcolor -highlightthickness 
  46. }
  47.  
  48. # ------------------------------------------------------------------
  49. #                            PUSHBUTTON
  50. # ------------------------------------------------------------------
  51. itcl::class iwidgets::Pushbutton {
  52.     inherit itk::Widget
  53.  
  54.     constructor {args} {}
  55.     destructor {}
  56.  
  57.     itk_option define -padx padX Pad 11
  58.     itk_option define -pady padY Pad 4
  59.     itk_option define -font font Font \
  60.         -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*
  61.     itk_option define -text text Text {}
  62.     itk_option define -bitmap bitmap Bitmap {}
  63.     itk_option define -image image Image {}
  64.     itk_option define -highlightthickness highlightThickness \
  65.         HighlightThickness 2
  66.     itk_option define -borderwidth borderWidth BorderWidth 2
  67.     itk_option define -defaultring defaultRing DefaultRing 0
  68.     itk_option define -defaultringpad defaultRingPad Pad 4
  69.     itk_option define -height height Height 0
  70.     itk_option define -width width Width 0
  71.     itk_option define -takefocus takeFocus TakeFocus 0
  72.  
  73.     public method flash {} 
  74.     public method invoke {} 
  75.  
  76.     protected method _relayout {{when later}} 
  77.     protected variable _reposition ""  ;# non-null => _relayout pending
  78. }
  79.  
  80. #
  81. # Provide a lowercased access method for the Pushbutton class.
  82. # 
  83. proc ::iwidgets::pushbutton {pathName args} {
  84.     uplevel ::iwidgets::Pushbutton $pathName $args
  85. }
  86.  
  87. #
  88. # Use option database to override default resources of base classes.
  89. #
  90. option add *Pushbutton.borderWidth 2 widgetDefault
  91.  
  92. # ------------------------------------------------------------------
  93. #                        CONSTRUCTOR
  94. # ------------------------------------------------------------------
  95. itcl::body iwidgets::Pushbutton::constructor {args} {
  96.     #
  97.     # Reconfigure the hull to act as the outer sunken ring of
  98.     # the pushbutton, complete with focus ring.
  99.     #
  100.     itk_option add hull.borderwidth hull.relief
  101.     itk_option add hull.highlightcolor
  102.     itk_option add hull.highlightbackground
  103.     
  104.     component hull configure \
  105.         -borderwidth [$this cget -borderwidth]
  106.     
  107.     pack propagate $itk_component(hull) no
  108.  
  109.     itk_component add pushbutton {
  110.     button $itk_component(hull).pushbutton \
  111.     } {
  112.         usual
  113.     keep -underline -wraplength -state -command 
  114.     }
  115.     pack $itk_component(pushbutton) -expand 1 -fill both 
  116.     
  117.     #
  118.     # Initialize the widget based on the command line options.
  119.     #
  120.     eval itk_initialize $args
  121.  
  122.     #
  123.     # Layout the pushbutton.
  124.     #
  125.     _relayout
  126. }
  127.  
  128. # ------------------------------------------------------------------
  129. #                           DESTRUCTOR
  130. # ------------------------------------------------------------------
  131. itcl::body iwidgets::Pushbutton::destructor {} {
  132.     if {$_reposition != ""} {after cancel $_reposition}
  133. }
  134.  
  135. # ------------------------------------------------------------------
  136. #                             OPTIONS
  137. # ------------------------------------------------------------------
  138.  
  139. # ------------------------------------------------------------------
  140. # OPTION: -padx
  141. #
  142. # Specifies the extra space surrounding the label in the x direction.
  143. # ------------------------------------------------------------------
  144. itcl::configbody iwidgets::Pushbutton::padx {
  145.     $itk_component(pushbutton) configure -padx $itk_option(-padx)
  146.  
  147.     _relayout
  148. }
  149.  
  150. # ------------------------------------------------------------------
  151. # OPTION: -pady
  152. #
  153. # Specifies the extra space surrounding the label in the y direction.
  154. # ------------------------------------------------------------------
  155. itcl::configbody iwidgets::Pushbutton::pady {
  156.     $itk_component(pushbutton) configure -pady $itk_option(-pady)
  157.  
  158.     _relayout
  159. }
  160.  
  161. # ------------------------------------------------------------------
  162. # OPTION: -font
  163. #
  164. # Specifies the label font.
  165. # ------------------------------------------------------------------
  166. itcl::configbody iwidgets::Pushbutton::font {
  167.     $itk_component(pushbutton) configure -font $itk_option(-font)
  168.  
  169.     _relayout
  170. }
  171.  
  172. # ------------------------------------------------------------------
  173. # OPTION: -text
  174. #
  175. # Specifies the label text.
  176. # ------------------------------------------------------------------
  177. itcl::configbody iwidgets::Pushbutton::text {
  178.     $itk_component(pushbutton) configure -text $itk_option(-text)
  179.  
  180.     _relayout
  181. }
  182.  
  183. # ------------------------------------------------------------------
  184. # OPTION: -bitmap
  185. #
  186. # Specifies the label bitmap.
  187. # ------------------------------------------------------------------
  188. itcl::configbody iwidgets::Pushbutton::bitmap {
  189.     $itk_component(pushbutton) configure -bitmap $itk_option(-bitmap)
  190.  
  191.     _relayout
  192. }
  193.  
  194. # ------------------------------------------------------------------
  195. # OPTION: -image
  196. #
  197. # Specifies the label image.
  198. # ------------------------------------------------------------------
  199. itcl::configbody iwidgets::Pushbutton::image {
  200.     $itk_component(pushbutton) configure -image $itk_option(-image)
  201.  
  202.     _relayout
  203. }
  204.  
  205. # ------------------------------------------------------------------
  206. # OPTION: -highlightthickness
  207. #
  208. # Specifies the thickness of the highlight ring.
  209. # ------------------------------------------------------------------
  210. itcl::configbody iwidgets::Pushbutton::highlightthickness {
  211.     $itk_component(pushbutton) configure \
  212.         -highlightthickness $itk_option(-highlightthickness)
  213.  
  214.     _relayout
  215. }
  216.  
  217. # ------------------------------------------------------------------
  218. # OPTION: -borderwidth
  219. #
  220. # Specifies the width of the relief border.
  221. # ------------------------------------------------------------------
  222. itcl::configbody iwidgets::Pushbutton::borderwidth {
  223.     $itk_component(pushbutton) configure -borderwidth $itk_option(-borderwidth)
  224.  
  225.     _relayout
  226. }
  227.  
  228. # ------------------------------------------------------------------
  229. # OPTION: -defaultring
  230. #
  231. # Boolean describing whether the button displays its default ring.  
  232. # ------------------------------------------------------------------
  233. itcl::configbody iwidgets::Pushbutton::defaultring {
  234.     _relayout
  235. }
  236.  
  237. # ------------------------------------------------------------------
  238. # OPTION: -defaultringpad
  239. #
  240. # The size of the padded default ring around the button.
  241. # ------------------------------------------------------------------
  242. itcl::configbody iwidgets::Pushbutton::defaultringpad {
  243.     pack $itk_component(pushbutton) \
  244.         -padx $itk_option(-defaultringpad) \
  245.         -pady $itk_option(-defaultringpad)
  246. }
  247.  
  248. # ------------------------------------------------------------------
  249. # OPTION: -height
  250. #
  251. # Specifies the height of the button inclusive of any default ring.
  252. # A value of zero lets the push button determine the height based
  253. # on the requested height plus highlightring and defaultringpad.
  254. # ------------------------------------------------------------------
  255. itcl::configbody iwidgets::Pushbutton::height {
  256.     _relayout
  257. }
  258.  
  259. # ------------------------------------------------------------------
  260. # OPTION: -width
  261. #
  262. # Specifies the width of the button inclusive of any default ring.
  263. # A value of zero lets the push button determine the width based
  264. # on the requested width plus highlightring and defaultringpad.
  265. # ------------------------------------------------------------------
  266. itcl::configbody iwidgets::Pushbutton::width {
  267.     _relayout
  268. }
  269.  
  270. # ------------------------------------------------------------------
  271. #                            METHODS
  272. # ------------------------------------------------------------------
  273.  
  274. # ------------------------------------------------------------------
  275. # METHOD: flash
  276. #
  277. # Thin wrap of standard button widget flash method.
  278. # ------------------------------------------------------------------
  279. itcl::body iwidgets::Pushbutton::flash {} {
  280.     $itk_component(pushbutton) flash
  281. }
  282.  
  283. # ------------------------------------------------------------------
  284. # METHOD: invoke
  285. #
  286. # Thin wrap of standard button widget invoke method.
  287. # ------------------------------------------------------------------
  288. itcl::body iwidgets::Pushbutton::invoke {} {
  289.     $itk_component(pushbutton) invoke
  290. }
  291.  
  292. # ------------------------------------------------------------------
  293. # PROTECTED METHOD: _relayout ?when?
  294. #
  295. # Adjust the width and height of the Pushbutton to accomadate all the
  296. # current options settings.  Add back in the highlightthickness to 
  297. # the button such that the correct reqwidth and reqheight are computed.  
  298. # Set the width and height based on the reqwidth/reqheight, 
  299. # highlightthickness, and ringpad.  Finally, configure the defaultring
  300. # properly. If "when" is "now", the change is applied immediately.  If 
  301. # it is "later" or it is not specified, then the change is applied later,
  302. # when the application is idle.
  303. # ------------------------------------------------------------------
  304. itcl::body iwidgets::Pushbutton::_relayout {{when later}} {
  305.     if {$when == "later"} {
  306.     if {$_reposition == ""} {
  307.         set _reposition [after idle [itcl::code $this _relayout now]]
  308.     }
  309.     return
  310.     } elseif {$when != "now"} {
  311.     error "bad option \"$when\": should be now or later"
  312.     }
  313.  
  314.     set _reposition ""
  315.  
  316.     if {$itk_option(-width) == 0} {
  317.     set w [expr {[winfo reqwidth $itk_component(pushbutton)] \
  318.         + 2 * $itk_option(-highlightthickness) \
  319.         + 2 * $itk_option(-borderwidth) \
  320.         + 2 * $itk_option(-defaultringpad)}]
  321.     } else {
  322.     set w $itk_option(-width)
  323.     }
  324.     
  325.     if {$itk_option(-height) == 0} {
  326.     set h [expr {[winfo reqheight $itk_component(pushbutton)] \
  327.         + 2 * $itk_option(-highlightthickness) \
  328.         + 2 * $itk_option(-borderwidth) \
  329.         + 2 * $itk_option(-defaultringpad)}]
  330.     } else {
  331.     set h $itk_option(-height)
  332.     }
  333.     
  334.     component hull configure -width $w -height $h
  335.     
  336.     if {$itk_option(-defaultring)} {
  337.     component hull configure -relief sunken \
  338.         -highlightthickness [$this cget -highlightthickness] \
  339.         -takefocus 1
  340.  
  341.     configure -takefocus 1
  342.     
  343.     component pushbutton configure \
  344.         -highlightthickness 0 -takefocus 0
  345.     
  346.     } else {
  347.     component hull configure -relief flat \
  348.         -highlightthickness 0 -takefocus 0
  349.     
  350.     component pushbutton configure \
  351.         -highlightthickness [$this cget -highlightthickness] \
  352.         -takefocus 1
  353.  
  354.     configure -takefocus 0
  355.     }
  356. }
  357.