Main Page | Modules | Class Hierarchy | Alphabetical List | Class List | File List | 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 pointer 00015 ## does not leave the area where it has been initialized within 200 milliseconds 00016 ## by default. 00017 ## 00018 ## \author Michael Daum 00019 ## 00020 ## $Id: Balloon.tcl,v 1.8 2004/02/25 14:42:08 micha Exp $ 00021 ## ---------------------------------------------------------------------------- 00022 class Balloon { 00023 inherit itk::Toplevel 00024 00025 itk_option define -delay delay Delay 200 00026 00027 public method on {x y text}; ## \type TclNumber, TclNumber, TclString 00028 public method off {} 00029 constructor {args} {}; ## \type TclList 00030 private method _doit {x y}; ## \type TclNumber, TclNumber 00031 00032 ## id of the background job. 00033 ## When a balloon is going to be displayed we spawn a job with \a after 00034 ## and store the job id in this variable. 00035 private variable balloonId 0 00036 }; 00037 00038 ## ---------------------------------------------------------------------------- 00039 ## constructor 00040 ## ---------------------------------------------------------------------------- 00041 body Balloon::constructor {args} { 00042 wm withdraw $itk_interior 00043 wm overrideredirect $itk_interior 1 00044 wm transient $itk_interior 00045 00046 bind $itk_interior <Leave> [code $this off] 00047 00048 itk_component add text { 00049 label $itk_interior.text \ 00050 -bd 0 \ 00051 -padx 3 \ 00052 -pady 0 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 actuall 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 if {[expr $x + $width] > $screenWidth} { 00097 set x [expr $screenWidth - $width] 00098 } 00099 if {$x < 0} { 00100 set x 0 00101 } 00102 00103 set y [expr $y + $height] 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 ## ---------------------------------------------------------------------------- 00124 body Balloon::on {x y text} { 00125 if {[string trim $text] == ""} { 00126 return 00127 } 00128 00129 if {$balloonId > 0} { 00130 if {$text == $itk_option(-text)} { 00131 return 00132 } 00133 after cancel $balloonId 00134 } 00135 00136 configure -text "$text" 00137 set balloonId [after $itk_option(-delay) [code $this _doit $x $y]] 00138 } 00139

YADA 2.0-alpha (20 Oct 2004)