Main Page | Namespace List | Class Hierarchy | Alphabetical List | Class List | File List | Namespace Members | Class Members | File Members | Related Pages

balloon.tcl

00001 # Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de> 00002 # 00003 # This file is free software; as a special exception the author gives 00004 # unlimited permission to copy and/or distribute it, with or without 00005 # modifications, as long as this notice is preserved. 00006 # 00007 # This program is distributed in the hope that it will be useful, but 00008 # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the 00009 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00010 # 00011 ## ---------------------------------------------------------------------------- 00012 ## Balloon - A tooltip class. 00013 ## This is a generic tooltip implementation. Just create a Balloon and 00014 ## switch it on() now and then. A Balloon is displayed if the mouse 00015 ## pointer does not leave the area where it has been initialized within 00016 ## 200 milliseconds by default. 00017 ## 00018 ## \author Michael Daum 00019 ## $Id: balloon.tcl,v 1.9 2004/10/04 07:41:33 foth Exp $ 00020 ## ---------------------------------------------------------------------------- 00021 class Balloon { 00022 inherit itk::Toplevel 00023 00024 itk_option define -delay delay Delay 200 00025 00026 public method on {x y text args}; ## \type TclNumber, TclNumber, TclString, TclList 00027 public method off {} 00028 constructor {args} {}; ## \type TclList 00029 private method _doit {x y}; ## \type TclNumber, TclNumber 00030 00031 ## id of the background job. 00032 ## When a balloon is going to be displayed we spawn a job with \a after 00033 ## and store the job id in this variable. 00034 private variable balloonId 0 00035 }; 00036 00037 ## ---------------------------------------------------------------------------- 00038 ## constructor 00039 ## ---------------------------------------------------------------------------- 00040 body Balloon::constructor {args} { 00041 wm withdraw $itk_interior 00042 wm overrideredirect $itk_interior 1 00043 wm transient $itk_interior 00044 00045 bind $itk_interior <Leave> [code $this off] 00046 00047 itk_component add text { 00048 label $itk_interior.text \ 00049 -bd 0 \ 00050 -padx 3 \ 00051 -pady 0 \ 00052 -justify left 00053 } { 00054 rename -foreground -textforeground textForeground Foreground 00055 rename -background -textbackground textBackground Background 00056 keep -cursor -relief -anchor -text -font -padx -pady -borderwidth 00057 } 00058 00059 pack $itk_component(text) -fill both -expand 1 -side left 00060 00061 eval itk_initialize $args 00062 } 00063 00064 ## ---------------------------------------------------------------------------- 00065 ## hide a tooltip. 00066 ## Call this method to switch off the tooltip balloon. 00067 ## ---------------------------------------------------------------------------- 00068 body Balloon::off {} { 00069 set pointerx [winfo pointerx $itk_interior] 00070 set pointery [winfo pointery $itk_interior] 00071 if {[winfo containing $pointerx $pointery] == $itk_interior} { 00072 return 00073 } 00074 00075 if {$balloonId > 0} { 00076 after cancel $balloonId 00077 set balloonId 0 00078 } else { 00079 wm withdraw $itk_interior 00080 } 00081 } 00082 00083 ## ---------------------------------------------------------------------------- 00084 ## do the actual display. 00085 ## This method is only called by Balloon::on() when the tcl loop gets idle. 00086 ## \param x the x coordinate where the balloon will be displayed 00087 ## \param y the y coordinate where the balloon will be displayed 00088 ## ---------------------------------------------------------------------------- 00089 body Balloon::_doit {x y} { 00090 set balloon $itk_interior 00091 set height [winfo reqheight $balloon] 00092 set width [winfo reqwidth $balloon] 00093 set screenWidth [winfo screenwidth $balloon] 00094 set screenHeight [winfo screenheight $balloon] 00095 00096 # guard against window reaching offscreen 00097 if {[expr $x + $width] > $screenWidth} { 00098 set x [expr $screenWidth - $width] 00099 } 00100 if {$x < 0} { 00101 set x 0 00102 } 00103 00104 if {$y > $screenHeight} { 00105 set y [expr $screenHeight - $height] 00106 } 00107 if {$y < 0} { 00108 set y 0 00109 } 00110 00111 wm geometry $balloon +$x+$y 00112 wm deiconify $balloon 00113 raise $balloon 00114 set balloonId 0 00115 } 00116 00117 ## ---------------------------------------------------------------------------- 00118 ## show a tooltip. 00119 ## This method actually displays a tooltip with a certain message and position. 00120 ## \param x the x coordinate where the balloon will be displayed 00121 ## \param y the y coordinate where the balloon will be displayed 00122 ## \param text the message text to be shown inside the tooltip 00123 ## \param args: If non-empty, draw the balloon immediately (do not wait). 00124 ## ---------------------------------------------------------------------------- 00125 body Balloon::on {x y text args} { 00126 if {[string trim $text] == ""} { 00127 return 00128 } 00129 00130 if {$balloonId > 0} { 00131 if {$text == $itk_option(-text)} { 00132 return 00133 } 00134 after cancel $balloonId 00135 } 00136 00137 configure -text "$text" 00138 if {$args == ""} { 00139 set balloonId [after $itk_option(-delay) [code $this _doit $x $y]] 00140 } else { 00141 _doit $x $y 00142 } 00143 } 00144

XCDG 0.95 (20 Oct 2004)