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 / extbutton.itk < prev    next >
Encoding:
Text File  |  2003-09-01  |  14.6 KB  |  440 lines
  1. #-------------------------------------------------------------------------------
  2. # Extbutton
  3. #-------------------------------------------------------------------------------
  4. # This [incr Widget] is pretty simple - it just extends the behavior of
  5. # the Tk button by allowing the user to add a bitmap or an image, which
  6. # can be placed at various locations relative to the text via the -imagepos
  7. # configuration option.
  8. #
  9. #-------------------------------------------------------------------------------
  10. # IMPORTANT NOTE: This [incr Widget] will only work with Tk 8.4 or later.
  11. #
  12. #-------------------------------------------------------------------------------
  13. # AUTHOR:  Chad Smith               E-mail: csmith@adc.com, itclguy@yahoo.com
  14. #-------------------------------------------------------------------------------
  15. # Permission to use, copy, modify, distribute, and license this software
  16. # and its documentation for any purpose is hereby granted as long as this
  17. # comment block remains intact.
  18. #-------------------------------------------------------------------------------
  19.  
  20. #
  21. # Default resources
  22. #
  23. option add *Extbutton.borderwidth 2 widgetDefault
  24. option add *Extbutton.relief raised widgetDefault
  25.  
  26. #
  27. # Usual options
  28. #
  29. itk::usual Extbutton {
  30.   keep -cursor -font
  31. }
  32.  
  33. itcl::class iwidgets::Extbutton {
  34.   inherit itk::Widget
  35.  
  36.   constructor {args} {}
  37.  
  38.   itk_option define -activebackground activeBackground Foreground #ececec
  39.   itk_option define -bd borderwidth BorderWidth 2
  40.   itk_option define -bitmap bitmap Bitmap {}
  41.   itk_option define -command command Command {}
  42.   itk_option define -defaultring defaultring DefaultRing 0
  43.   itk_option define -defaultringpad defaultringpad Pad 4
  44.   itk_option define -image image Image {}
  45.   itk_option define -imagepos imagePos Position w
  46.   itk_option define -relief relief Relief raised
  47.   itk_option define -state state State normal
  48.   itk_option define -text text Text {}
  49.  
  50.   public method invoke {} {eval $itk_option(-command)}
  51.   public method flash {}
  52.  
  53.   private method changeColor {event_}
  54.   private method sink {}
  55.   private method raise {} {configure -relief $_oldValues(-relief)}
  56.  
  57.   private variable _oldValues
  58. }
  59.  
  60.  
  61. #
  62. # Provide the usual lowercase access command.
  63. #
  64. proc iwidgets::extbutton {path_ args} {
  65.   uplevel iwidgets::Extbutton $path_ $args
  66. }
  67.  
  68.  
  69. #-------------------------------------------------------------------------------
  70. # OPTION: -bd
  71. #
  72. # DESCRIPTION: This isn't a new option.  Similar to -image, we just need to
  73. #   repack the frame when the borderwidth changes.  This option is kept by
  74. #   the private reliefframe component.
  75. #-------------------------------------------------------------------------------
  76. itcl::configbody iwidgets::Extbutton::bd {
  77.   pack $itk_component(frame) -padx 4 -pady 4
  78. }
  79.  
  80.  
  81. #-------------------------------------------------------------------------------
  82. # OPTION: -bitmap
  83. #
  84. # DESCRIPTION: This isn't a new option - we just need to reset the -image option
  85. #   so that the user can toggle back and forth between images and bitmaps.
  86. #   Otherwise, the image will take precedence and the user will be unable to
  87. #   change to a bitmap without manually setting the label component's -image to
  88. #   an empty string.  This option is kept by the image component.
  89. #-------------------------------------------------------------------------------
  90. itcl::configbody iwidgets::Extbutton::bitmap {
  91.   if {$itk_option(-bitmap) == ""} {
  92.     return
  93.   }
  94.   if {$itk_option(-image) != ""} {
  95.     configure -image {}
  96.   }
  97.   pack $itk_component(frame) -padx 4 -pady 4
  98. }
  99.  
  100.  
  101. #-------------------------------------------------------------------------------
  102. # OPTION: -command
  103. #
  104. # DESCRIPTION: Invoke the given command to simulate the Tk button's -command
  105. #   option.  The command is invoked on <ButtonRelease-1> events only or by
  106. #   direct calls to the public invoke() method.
  107. #-------------------------------------------------------------------------------
  108. itcl::configbody iwidgets::Extbutton::command {
  109.   if {$itk_option(-command) == ""} {
  110.     return
  111.   }
  112.  
  113.   # Only create the tag binding if the button is operable.
  114.   if {$itk_option(-state) == "normal"} {
  115.     bind $this-commandtag <ButtonRelease-1> [itcl::code $this invoke]
  116.   }
  117.  
  118.   # Associate the tag with each component if it's not already done.
  119.   if {[lsearch [bindtags $itk_interior] $this-commandtag] == -1} {
  120.     foreach component [component] {
  121.       bindtags [component $component] \
  122.         [linsert [bindtags [component $component]] end $this-commandtag]
  123.     }
  124.   }
  125. }
  126.  
  127.  
  128. #-------------------------------------------------------------------------------
  129. # OPTION: -defaultring
  130. #
  131. # DESCRIPTION: Controls display of the sunken frame surrounding the button.
  132. #   This option simulates the pushbutton iwidget -defaultring option.
  133. #-------------------------------------------------------------------------------
  134. itcl::configbody iwidgets::Extbutton::defaultring {
  135.   switch -- $itk_option(-defaultring) {
  136.     1 {set ring 1}
  137.     0 {set ring 0}
  138.     default {
  139.       error "Invalid option for -defaultring: \"$itk_option(-defaultring)\".  \
  140.              Should be 1 or 0."
  141.     }
  142.   }
  143.  
  144.   if ($ring) {
  145.     $itk_component(ring) configure -borderwidth 2
  146.     pack $itk_component(reliefframe) -padx $itk_option(-defaultringpad) \
  147.       -pady $itk_option(-defaultringpad)
  148.   } else {
  149.     $itk_component(ring) configure -borderwidth 0
  150.     pack $itk_component(reliefframe) -padx 0 -pady 0
  151.   }
  152. }
  153.  
  154.  
  155. #-------------------------------------------------------------------------------
  156. # OPTION: -defaultringpad
  157. #
  158. # DESCRIPTION: The pad distance between the ring and the button.
  159. #-------------------------------------------------------------------------------
  160. itcl::configbody iwidgets::Extbutton::defaultringpad {
  161.   # Must be an integer.
  162.   if ![string is integer $itk_option(-defaultringpad)] {
  163.     error "Invalid value specified for -defaultringpad:\
  164.        \"$itk_option(-defaultringpad)\".  Must be an integer."
  165.   }
  166.  
  167.   # Let's go ahead and make the maximum padding 20 pixels.  Surely no one
  168.   # will want more than that.
  169.   if {$itk_option(-defaultringpad) < 0 || $itk_option(-defaultringpad) > 20} {
  170.     error "Value for -defaultringpad must be between 0 and 20."
  171.   }
  172.  
  173.   # If the ring is displayed, repack it according to the new padding amount.
  174.   if {$itk_option(-defaultring)} {
  175.     pack $itk_component(reliefframe) -padx $itk_option(-defaultringpad) \
  176.       -pady $itk_option(-defaultringpad)
  177.   }
  178. }
  179.  
  180.  
  181. #-------------------------------------------------------------------------------
  182. # OPTION: -image
  183. #
  184. # DESCRIPTION: This isn't a new option - we just need to repack the frame after
  185. #   the image is changed in case the size is different than the previous one.
  186. #   This option is kept by the image component.
  187. #-------------------------------------------------------------------------------
  188. itcl::configbody iwidgets::Extbutton::image {
  189.   pack $itk_component(frame) -padx 4 -pady 4
  190. }
  191.  
  192.  
  193. #-------------------------------------------------------------------------------
  194. # OPTION: -imagepos
  195. #
  196. # DESCRIPTION: Allows the user to move the image to different locations areound
  197. #   the text.  Valid options are n, nw, ne, s, sw, se e, en, es, w, wn or ws.
  198. #-------------------------------------------------------------------------------
  199. itcl::configbody iwidgets::Extbutton::imagepos {
  200.   switch -- $itk_option(-imagepos) {
  201.     n  {set side top;    set anchor center}
  202.     ne {set side top;    set anchor e}
  203.     nw {set side top;    set anchor w}
  204.  
  205.     s  {set side bottom; set anchor center}
  206.     se {set side bottom; set anchor e}
  207.     sw {set side bottom; set anchor w}
  208.  
  209.     w  {set side left;   set anchor center}
  210.     wn {set side left;   set anchor n}
  211.     ws {set side left;   set anchor s}
  212.  
  213.     e  {set side right;  set anchor center}
  214.     en {set side right;  set anchor n}
  215.     es {set side right;  set anchor s}
  216.  
  217.     default {
  218.       error "Invalid option: \"$itk_option(-imagepos)\". \
  219.              Must be n, nw, ne, s, sw, se e, en, es, w, wn or ws."
  220.     }
  221.   }
  222.  
  223.   pack $itk_component(image) -side $side -anchor $anchor
  224.   pack $itk_component(frame) -padx 4 -pady 4
  225. }
  226.  
  227.  
  228. #-------------------------------------------------------------------------------
  229. # OPTION: -relief
  230. #
  231. # DESCRIPTION: Move the frame component according to the relief to simulate
  232. #   the text in a Tk button when its relief is changed.
  233. #-------------------------------------------------------------------------------
  234. itcl::configbody iwidgets::Extbutton::relief {
  235.   update idletasks
  236.   switch -- $itk_option(-relief) {
  237.     flat - ridge - groove {
  238.       place $itk_component(frame) -x 5 -y 5
  239.     }
  240.  
  241.     raised {
  242.       place $itk_component(frame) -x 4 -y 4
  243.     }
  244.  
  245.     sunken {
  246.       place $itk_component(frame) -x 6 -y 6
  247.     }
  248.  
  249.     default {
  250.       error "Invalid option: \"$itk_option(-relief)\".  \
  251.              Must be flat, ridge, groove, raised, or sunken."
  252.     }
  253.   }
  254. }
  255.  
  256.  
  257. #-------------------------------------------------------------------------------
  258. # OPTION: -state
  259. #
  260. # DESCRIPTION: Simulate the button's -state option.
  261. #-------------------------------------------------------------------------------
  262. itcl::configbody iwidgets::Extbutton::state {
  263.   switch -- $itk_option(-state) {
  264.     disabled {
  265.       bind $itk_interior <Enter> { }
  266.       bind $itk_interior <Leave> { }
  267.       bind $this-sunkentag <1> { }
  268.       bind $this-raisedtag <ButtonRelease-1> { }
  269.       bind $this-commandtag <ButtonRelease-1> { }
  270.       set _oldValues(-fg) [cget -foreground]
  271.       set _oldValues(-cursor) [cget -cursor]
  272.       configure -foreground $itk_option(-disabledforeground)
  273.       configure -cursor "X_cursor red black"
  274.     }
  275.  
  276.     normal {
  277.       bind $itk_interior <Enter> [itcl::code $this changeColor enter]
  278.       bind $itk_interior <Leave> [itcl::code $this changeColor leave]
  279.       bind $this-sunkentag <1> [itcl::code $this sink]
  280.       bind $this-raisedtag <ButtonRelease-1> [itcl::code $this raise]
  281.       bind $this-commandtag <ButtonRelease-1> [itcl::code $this invoke]
  282.       configure -foreground $_oldValues(-fg)
  283.       configure -cursor $_oldValues(-cursor)
  284.     }
  285.  
  286.     default {
  287.       error "Bad option for -state: \"$itk_option(-state)\".  Should be\
  288.     normal or disabled."
  289.     }
  290.   }
  291. }
  292.  
  293.  
  294. #-------------------------------------------------------------------------------
  295. # OPTION: -text
  296. #
  297. # DESCRIPTION: This isn't a new option.  Similar to -image, we just need to
  298. #   repack the frame when the text changes.   
  299. #-------------------------------------------------------------------------------
  300. itcl::configbody iwidgets::Extbutton::text {
  301.   pack $itk_component(frame) -padx 4 -pady 4
  302. }
  303.  
  304.  
  305.  
  306. #-------------------------------------------------------------------------------
  307. #                                CONSTRUCTOR
  308. #-------------------------------------------------------------------------------
  309. itcl::body iwidgets::Extbutton::constructor {args} {
  310.   # Extbutton will not work with versions of Tk less than 8.4 (the
  311.   # -activeforeground option was added to the Tk label widget in 8.4, for
  312.   # example).  So disallow its use unless the right wish is being used.
  313.   if {$::tk_version < 8.4} {
  314.     error "The extbutton \[incr Widget\] can only be used with versions of\
  315.       Tk greater than 8.3.\nYou're currently using version $::tk_version."
  316.   }
  317.  
  318.   # This frame is optionally displayed as a "default ring" around the button.
  319.   itk_component add ring {
  320.     frame $itk_interior.ring -relief sunken
  321.   } {
  322.     rename -background -ringbackground ringBackground Background
  323.   }
  324.  
  325.   # Add an outer frame for the widget's relief.  Ideally we could just keep
  326.   # the hull's -relief, but it's too tricky to handle relief changes.
  327.   itk_component add -private reliefframe {
  328.     frame $itk_component(ring).f
  329.   } {
  330.     rename -borderwidth -bd borderwidth BorderWidth
  331.     keep -relief
  332.     usual
  333.   }
  334.  
  335.   # This frame contains the image and text.  It will be moved slightly to
  336.   # simulate the text in a Tk button when the button is depressed/raised.
  337.   itk_component add frame {
  338.     frame $itk_component(reliefframe).f -borderwidth 0
  339.   }
  340.  
  341.   itk_component add image {
  342.     label $itk_component(frame).img -borderwidth 0
  343.   } {
  344.     keep -bitmap -background -image
  345.     rename -foreground -bitmapforeground foreground Foreground
  346.   }
  347.  
  348.   itk_component add label {
  349.     label $itk_component(frame).txt -borderwidth 0
  350.   } {
  351.     keep -activeforeground -background -disabledforeground
  352.     keep -font -foreground -justify -text
  353.   }
  354.  
  355.   pack $itk_component(image) $itk_component(label) -side left -padx 6 -pady 4
  356.   pack $itk_component(frame) -padx 4 -pady 4
  357.   pack $itk_component(reliefframe) -fill both
  358.   pack $itk_component(ring) -fill both
  359.  
  360.   # Create a couple of binding tags for handling relief changes.  Then
  361.   # add these tags to each component.
  362.   foreach component [component] {
  363.     bindtags [component $component] \
  364.       [linsert [bindtags [component $component]] end $this-sunkentag]
  365.     bindtags [component $component] \
  366.       [linsert [bindtags [component $component]] end $this-raisedtag]
  367.   }
  368.  
  369.   set _oldValues(-fg) [cget -foreground]
  370.   set _oldValues(-cursor) [cget -cursor]
  371.  
  372.   eval itk_initialize $args
  373. }
  374.  
  375.  
  376. #-------------------------------------------------------------------------------
  377. # METHOD: flash
  378. #
  379. # ACCESS: public
  380. #
  381. # DESCRIPTION: Simulate the Tk button flash command.
  382. #
  383. # ARGUMENTS: none
  384. #-------------------------------------------------------------------------------
  385. itcl::body iwidgets::Extbutton::flash {} {
  386.   set oldbg [cget -background]
  387.   config -background $itk_option(-activebackground)
  388.   update idletasks
  389.  
  390.   after 50; config -background $oldbg; update idletasks
  391.   after 50; config -background $itk_option(-activebackground); update idletasks
  392.   after 50; config -background $oldbg
  393. }
  394.  
  395.  
  396. #-------------------------------------------------------------------------------
  397. # METHOD: changeColor
  398. #
  399. # ACCESS: private
  400. #
  401. # DESCRIPTION: This method is invoked by <Enter> and <Leave> events to change
  402. #   the background and foreground colors of the widget.
  403. #
  404. # ARGUMENTS: event_ --> either "enter" or "leave"
  405. #-------------------------------------------------------------------------------
  406. itcl::body iwidgets::Extbutton::changeColor {event_} {
  407.   switch -- $event_ {
  408.     enter {
  409.       set _oldValues(-bg) [cget -background]
  410.       set _oldValues(-fg) [cget -foreground]
  411.       configure -background $itk_option(-activebackground)
  412.       configure -foreground $itk_option(-activeforeground)
  413.     }
  414.     leave {
  415.       configure -background $_oldValues(-bg)
  416.       configure -foreground $_oldValues(-fg)
  417.     }
  418.   }
  419. }
  420.  
  421.  
  422. #-------------------------------------------------------------------------------
  423. # METHOD: sink
  424. #
  425. # ACCESS: private
  426. #
  427. # DESCRIPTION: This method is invoked on <1> mouse events.  It saves the
  428. #   current relief for later restoral and configures the relief to sunken if
  429. #   it isn't already sunken.
  430. #
  431. # ARGUMENTS: none
  432. #-------------------------------------------------------------------------------
  433. itcl::body iwidgets::Extbutton::sink {} {
  434.   set _oldValues(-relief) [cget -relief]
  435.   if {$_oldValues(-relief) == "sunken"} {
  436.     return
  437.   }
  438.   configure -relief sunken
  439. }
  440.