home *** CD-ROM | disk | FTP | other *** search
/ Chip: Linux Special / CorelLinux_CHIP.iso / live / usr / X11R6 / lib / X11 / cbb / balloon.tcl < prev    next >
Encoding:
Tcl/Tk script  |  1998-10-07  |  2.5 KB  |  85 lines
  1. #!/usr/bin/wish -f
  2. #  'CBB' -- Check Book Balancer
  3. #
  4. #   balloon.tcl -- Routines for handling balloon help.
  5. #
  6. #  Written by Stewart Allen <stewart@neuron.com> as part of the
  7. #    Visual Tcl application.
  8. #
  9. #  Modified by Curtis L. Olson to work with in the framework of CBB.
  10. #
  11. #  This program is free software; you can redistribute it and/or modify
  12. #  it under the terms of the GNU General Public License as published by
  13. #  the Free Software Foundation; either version 2 of the License, or
  14. #  (at your option) any later version.
  15. #
  16. #  This program is distributed in the hope that it will be useful,
  17. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. #  GNU General Public License for more details.
  20. #
  21. #  You should have received a copy of the GNU General Public License
  22. #  along with this program; if not, write to the Free Software
  23. #  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  24. #
  25. # $Id: balloon.tcl,v 1.2 1996/12/11 04:17:38 curt Exp $
  26. # (Log is kept at end of this file)
  27.  
  28.  
  29. bind cbb(balloon) <Enter> {
  30.     set cbb(balloon,set) 0
  31.     set cbb(balloon,first) 1
  32.     set cbb(balloon,id) [after 500 {cbb_balloon %W $cbb(balloon,%W)}]
  33. }
  34.  
  35. bind cbb(balloon) <Leave> {
  36.     set cbb(balloon,first) 0
  37.     cbb_kill_balloon
  38. }
  39.  
  40. bind cbb(balloon) <Motion> {
  41.     if {$cbb(balloon,set) == 0} {
  42.     after cancel $cbb(balloon,id)
  43.     set cbb(balloon,id) [after 500 {cbb_balloon %W $cbb(balloon,%W)}]
  44.     }
  45. }
  46.  
  47. proc cbb_set_balloon {target message} {
  48.     global cbb
  49.     set cbb(balloon,$target) $message
  50.     bindtags $target "[bindtags $target] cbb(balloon)"
  51. }
  52.  
  53. proc cbb_kill_balloon {} {
  54.     global cbb
  55.     after cancel $cbb(balloon,id)
  56.     if {[winfo exists .balloon] == 1} {
  57.         destroy .balloon
  58.     }
  59.     set cbb(balloon,set) 0
  60. }
  61.  
  62. proc cbb_balloon {target message} {
  63.     global cbb
  64.     if {$cbb(balloon,first) == 1 && $cbb(balloon,on) == 1} {
  65.         set cbb(balloon,first) 2
  66.         set x [expr [winfo rootx $target] + ([winfo width $target]/2)]
  67.         set y [expr [winfo rooty $target] + [winfo height $target] + 4]
  68.         toplevel .balloon -bg black
  69.         wm overrideredirect .balloon 1
  70.         label .balloon.l \
  71.         -text $message -relief flat -font $cbb(default_font) \
  72.             -bg #ffffaa -fg black -padx 2 -pady 0 -anchor w
  73.         pack .balloon.l -side left -padx 1 -pady 1
  74.         wm geometry .balloon +${x}+${y}
  75.         set cbb(balloon,set) 1
  76.     }
  77. }
  78.  
  79.  
  80. # ----------------------------------------------------------------------------
  81. # $Log: balloon.tcl,v $
  82. # Revision 1.2  1996/12/11 04:17:38  curt
  83. # Added cvs headers/log.
  84. #
  85.