Version 35 of balloon help

Updated 2016-01-30 01:34:11 by pooryorick

Balloon help, also known as tooltips, is a GUI feature in which a small window containing additional information appears when a pointer hovers over an object in the GUI.

Balloon Help Systems

ClassyTcl
Perl/Tk Tk::Balloon
balloon
Information on two different ballon systems.
balloon , by Vitor Wagner
Tklib's tooltip
balloonhelp, MegaWidget package
Dynamic Help, Bwidget
tooltip, by Mark G. Saye
Tix
Includes a balloon widget has a balloon widget: see http://tix.sourceforge.net/man/html/TixCmd/tixBalloon.htm

See Also

TreeView Tooltips
Have a treeview beneerate <<RowEnter>> and <<RowLeav>> virtual events that can be used by balloon help systems.

Description

Some shops use "tooltips" for almost any action associated with mouseover, including ...

Tk::Balloon attaches balloons to canvas items, in contrast to most of the example here. However SCoTT SmeDLeY offers a pure Tk analogue [L1 ].

Examples

Effective Tcl

Bwidget has balloons under the title of "Dynamic help"; here's an example how simple that can be (RS):

interp alias {} help {} DynamicHelp::register
Button .f.open -image $im(open) -command {starDOM::openFile .t}
help .f.open balloon "Open existing XML file"

Other Balloon/Tooltip Systems

 What: tooltips
 Where: From the contact
 Description: Tk program which provides functionality similar to
        the one Microsoft has.
 Updated:
 Contact: mailto:[email protected] (Paul D. Boyer)

 What: ToolTips
 Where: From the contact
 Description: Provides a way to allow one to associate Microsoft-like tooltips
        to icons in a Tk application.
 Updated:
 Contact: mailto:[email protected] (Paul Boyer )

Other packages and applications relating to tooltips or balloon help include:

 What: tktray
 Where: http://www.electricmemo.com/tktray.zip ???
 Description: Simple application running as a toolbar app under
        Windows 95/NT. Set the tooltip text, icons, etc.
        Written in Delphi 2.
 Updated: 06/1998
 Contact: mailto:[email protected] (Mark Lawson)
 What: XWordPad
 Where: http://www.geocities.com/SiliconValley/Campus/6846/ 
 Description: Tcl/Tk text editor supporting plain text of unlimited
        size.  Uses standard menus, supports copy, paste, cut,
        unlimited undo/redo, toolbar and balloon help, quick
        search, font, style and size choices, multifile file
        editing, etc.
        Runs on Tcl/Tk 7.4-8.x, and works on Unix and Windows.
        Currently at version 2.1.
 Updated: 02/2000
 Contact: mailto:[email protected] 
 What: ClassyTcl/Tk
 Where: http://rrna.uia.ac.be/classytcl/
 Description: Dynamically loadable object system (both tcl and C based are
        available), widget set and GUI builder.
        ClassyTk is a widget set which includes BarChart, ChartGrid,
        LineChart, Balloon (help),
        CmdWidget (command line widget), DefaultMenu (select from
        user defined defaults), DragDrop, DynaMenu, DynaTool (toolbar),
        FileSelect, InputDialog, ProgressDialog, SaveDialog, SelectDialog,
        getcolor, getfont, yorn, Browser, Editor, Fold (foldable frame),
        HTML, MultiFrame, NoteBook, OptionBox, OptionMenu, Paned, Progress,
        Table, Tree, ColorEntry, FontSelect, Selector, as well as improved
        versions of Canvas (supports zooming, undo/redo, rotate, save, load,
        group, and printing), Entry, FileEntry, ListBox, Message, NumEntry,
        RepeatButton, ScrolledFrame, Text, and more.
        The ClassyTcl Builder can be used to graphically create interfaces,
        and is invoked via the cbuild command.
        Comes with sample applications such as cedit,
        ccalc (calculator),
        ccenter (early stage program manager),
        cdraw (vector drawing),
        cedit (text editor),
        cfiles (early stage file manager),
        ctester (test ClassyTcl widgets).
        Requires Tcl/Tk 8.x and ExtraL if ClassyTcl widgets are used.
        Currently at ClassyTcl and ClassyTk are at version 1.0.0 .
 Updated: 08/2001
 Contact: mailto:[email protected] (Peter.DeRijk)
 What: MegaWidget package
 Where: http://www.purl.org/net/hobbs/tcl/script/widget/widget-0.9.tar.gz
 Description: Tk 8.x megawidget capability.
        While tested thru Tk 8.0b2, some problems still remained
        under Windows with Tk 8.
        Megawidgets included in this package are combobox, console,
        hierarchy list display, progressbar, tabnotebook, validating
        entry widget, and scrolledtext.  Also, support for balloon help
        and paned window management are included.
 Updated: 03/2001
 Contact: mailto:[email protected]
 What: Miscellaneous Tcl procs (Corey)
 Where: http://www.kencorey.com/tcl/answers.html
 Description: Examples of how to do things like provide balloon help over menu
        items, do background processing, eat events while a program is busy,
        do combobox widgets, scroll two text widgets with one scrollbar,
        scroll to currently focused canvas item, moving graphs, move
        the nodes of a polygon around dynamically, track what procedures
        are called (with what arguments), scrolling a grid managed frame in
        a canvas, using fileevent on a pipe, simple spreadsheet using
        grid, and a simple listbox inside a text widget.
        The contact isn't currently updating this page.
 Updated: 08/1998
 Contact: mailto:[email protected] (Ken Corey)
 What: tkballoon
 Where: http://www.multimania.com/droche/tkballoon/
 Description: Pure Tcl/Tk implementation of balloon help.
 Updated: 07/1999
 Contact: mailto:[email protected] (Daniel Roche)
  • ]Win32 Tcl and Tk patches (jessikat)]
 What: Win32 Tcl and Tk patches (jessikat)
 Where: http://www.jessikat.demon.co.uk/
 Description: A variety of patches to Tcl and Tk for Win32s.
        There are patches for wm activate bug, memory debug support,
        listbox justify, cursor, panics, and tkCanvWind.  Also on this
        page are patches and ports of a variety of extensions and
        applications such as DDE, tclStruct, BLT, otcl and a clock
        application.  Tiled widgets problematic, bgexec/busy not
        working, drag&drop ok with dde.  Also a small balloonHelp (blnhlp)
        package is available here as well.  Rotating text didn't make
        it, nor did drag and drop.  Also find a general dll
        caller for the Intel win32 platform which creates a namespace
        called dll containing the dll routines that can be called.
        Contact tested with VC++ 6.0 and Tcl 8.0.4.  It relies on the
        way MSC 4.0.  Site also has a crypt dll.
 Updated: 04/1998
 Contact: mailto:[email protected]

 What: pTk Rezic widget collection
 Where: http://user.cs.tu-berlin.de/%7Eeserte/src/perl/
        http://www.cpan.org/
 Description: Tk::HistEntry provides an Entry widget with a history.
        Tk::Date is a date widget in development.
        On CPAN, you can find Tk::Getopt (Tk-Options?), which is a
        GUI interface for Perl/Tk with interface to Getopt::Long.
        From the user, you may be able to get the following.
        Tk::UnderlineAll adds accellerators
        to menu buttons, entries and notebook pages. Tk::WListbox
        adds enhanced keybindings for selecting entries.
        Tk::ContextHelp provides context sensitive help in Perl/Tk.
        Tk::CanvasBalloon is a module for attaching help balloons to
        canvas items or tags.
        Also available are Tk::PNG and Tk::TIFF, to add support
        for those image formats.
        Tk::FBox is a perl version of the standard Tk filebox.
        Tie-Listbox is an experimental module using ties to Tk listboxes.
        FlatCheckbox is a canvas based checkbox.
 Updated: 05/1999
 Contact: mailto:[email protected] (Slaven Rezic)

Weedesk

Larry Smith: weedesk has a simple balloon help system. The code:

label .help -bd 1 -fg black -bg lightyellow -font fixed -text "default help"

set btn3 0
proc popballoon {} {
    global btn3
    if { !$btn3 } { place forget .help }
}

proc help {w help} {
    bind $w <Any-Enter> "after 1000 balloon %W $help; after 3000 popballoon"
    bind $w <Any-Leave> "popballoon"
    bind $w <ButtonPress-3> "set btn3 1; balloon %W $help"
    bind $w <ButtonRelease-3> "set btn3 0; popballoon"
}

proc balloon { w args } {
    .help configure -text $args
    regexp {^\.[A-Za-z0-9]*} $w parent
    if { [ catch {
        set x [ expr [ winfo x $w ] + [ winfo x $parent ] + 10 ] } ] == 0 } {

        set y [ expr [ winfo y $w ] + [ winfo y $parent ] - 10 ]
        place .help -x $x -y $y
        raise .help
    }
}

To install a tooltip on a particular widget:

help $button_name $helptext

When the mouse enters the widget the tooltip will be displayed about 1 second later and remain up for two seconds (these values are easily adjusted in the first line of the "help" proc). You can also use btn3 to display the tip as long as you like, it will disappear when you release btn3.

A Tooltip Implementation

Here is one tooltips implementation that I use, which was originally written by someone else and then modified by me. It´s only been tested on Windows. - [RJ 03/16/2006 I tested on Puppy Linux and Solaris 2.8 - works like a charm!]

[stabbingfinger: This is superbly simple. Fixed three problems: 1) toplevel window flashed when tooltip is displayed; 2) tooltip artifacts resulted when flying through a UI too quickly; 3) "wm attributes" assumes Windows. Additions are commented. Thanks for the code!]

[Christian Rapp: This code is great, use it very often. Fixed one thing: a.) The tooltip is not entirely visible when $pointerX + $width is greater than [winfo screenwidth .]. Placed a comment to my changes in the code.]

[Chris Edwards: Modified so that the tooltip is displayed above the pointer when in the bottom half of the screen, to avoid tooltips going offscreen when near the bottom edge (changes labelled b.). Also now has the tooltips centred horizontally on the pointer rather than being left-aligned (changes labelled c.).]

proc setTooltip {widget text} { 
        if { $text != "" } { 
                # 2) Adjusted timings and added key and button bindings. These seem to
                # make artifacts tolerably rare.
                bind $widget <Any-Enter>    [list after 500 [list showTooltip %W $text]] 
                bind $widget <Any-Leave>    [list after 500 [list destroy %W.tooltip]] 
                bind $widget <Any-KeyPress> [list after 500 [list destroy %W.tooltip]] 
                bind $widget <Any-Button>   [list after 500 [list destroy %W.tooltip]] 
        } 
} 
proc showTooltip {widget text} {
        global tcl_platform
        if { [string match $widget* [winfo containing  [winfo pointerx .] [winfo pointery .]] ] == 0  } { 
                return 
        } 


        catch { destroy $widget.tooltip } 


        set scrh [winfo screenheight $widget]    ; # 1) flashing window fix 
        set scrw [winfo screenwidth $widget]     ; # 1) flashing window fix 
        set tooltip [toplevel $widget.tooltip -bd 1 -bg black] 
        wm geometry $tooltip +$scrh+$scrw        ; # 1) flashing window fix
        wm overrideredirect $tooltip 1 

        if {$tcl_platform(platform) == {windows}} { ; # 3) wm attributes...
                wm attributes $tooltip -topmost 1   ; # 3) assumes...
        }                                           ; # 3) Windows
        pack [label $tooltip.label -bg lightyellow -fg black -text $text -justify left] 


        set width [winfo reqwidth $tooltip.label] 
        set height [winfo reqheight $tooltip.label] 

        set pointer_below_midline [expr [winfo pointery .] > [expr [winfo screenheight .] / 2.0]]                ; # b.) Is the pointer in the bottom half of the screen?

        set positionX [expr [winfo pointerx .] - round($width / 2.0)]    ; # c.) Tooltip is centred horizontally on pointer.
        set positionY [expr [winfo pointery .] + 35 * ($pointer_below_midline * -2 + 1) - round($height / 2.0)]  ; # b.) Tooltip is displayed above or below depending on pointer Y position.

        # a.) Ad-hockery: Set positionX so the entire tooltip widget will be displayed.
        # c.) Simplified slightly and modified to handle horizontally-centred tooltips and the left screen edge.
        if  {[expr $positionX + $width] > [winfo screenwidth .]} {
                set positionX [expr [winfo screenwidth .] - $width]
        } elseif {$positionX < 0} {
                set positionX 0
        }

        wm geometry $tooltip [join  "$width x $height + $positionX + $positionY" {}] 
        raise $tooltip 

        # 2) Kludge: defeat rare artifact by passing mouse over a tooltip to destroy it.
        bind $widget.tooltip <Any-Enter> {destroy %W} 
        bind $widget.tooltip <Any-Leave> {destroy %W} 
} 


pack [button .b -text hello] 
setTooltip .b "Hello World!" 

Balloon Help, Minimalist Version

This was from the bag of Tk algorithms:

proc balloon {w help} {
    bind $w <Any-Enter> "after 1000 [list balloon:show %W [list $help]]"
    bind $w <Any-Leave> "destroy %W.balloon"
}

proc balloon:show {w arg} {
    if {[eval winfo containing  [winfo pointerxy .]]!=$w} {return}
    set top $w.balloon
    catch {destroy $top}
    toplevel $top -bd 1 -bg black
    wm overrideredirect $top 1
    if {[string equal [tk windowingsystem] aqua]}  {
        ::tk::unsupported::MacWindowStyle style $top help none
    }   
    pack [message $top.txt -aspect 10000 -bg lightyellow \
        -font fixed -text $arg]
    set wmx [winfo rootx $w]
    set wmy [expr [winfo rooty $w]+[winfo height $w]]
    wm geometry $top [winfo reqwidth $top.txt]x[
        winfo reqheight $top.txt]+$wmx+$wmy
    raise $top
}

# Example:
button  .b -text Exit -command exit
balloon .b "Push me if you're done with this"
pack    .b

DAS: Added an 'unsupported1' command to make this work on macs as well, otherwise raising the balloon window would immediately post a Leave event leading to the destruction of the balloon... The 'unsupported1' command makes the balloon window into a floating window which does not put the underlying window into the background and thus avoids the problem. (BTW, for this to work, appearance manager needs to be present, but that shouldn't be a problem for all except very old macs, otherwise you can try using the older 'unsupported1 style $top floatSideProc' although I had problems with it)

George Peter Staplin: That balloon help has a minor flaw. If the help has something like "rate is %90" the % will cause an error with bind. One way I've solved that in the past with a similar bunch of code is [string map {"%" "%%"} $msg]. However I've been told it's better to use a global array and pass a key into that array. To each his own I guess. Note: the %W usage above will also fail if the widget has a space in its pathname. I'm not sure if spaces should be valid, however Jeff Hobbs has gone through BWidgets and fixed bugs involving spaces in pathnames.

This might work better:

bind $w <Enter> [list after 1000 [list balloon_aux %W [string map {"%" "%%"} $msg]]] ;#GPS

I would rather do it using a global variable to store the help text. Generally I avoid having text in after or callback scripts. More, using a global can be useful for debugging or translating.

I modified the balloons script above. Move the help/ folder in directory lindex $tcl_pkgPath 0

# you can replace 'help' with 'balloon' # i keep the balloon for my quick black dog jumping over lazy foxes

help/pkgIndex.tcl:

package ifneeded help 1.0 [list source [file join $dir help.tcl]]

help/help.tcl:

namespace eval ::help {
    namespace export set
    variable delay 1000
}

proc help::set {widget txt} {
    variable help
    ::set help($widget) $txt
    bind $widget <Enter> {after $help::delay [list help::show %W]}
    bind $widget <Leave> {destroy %W.help}
}

proc help::show {widget} {
    variable help
  
    if {[eval winfo containing [winfo pointerxy .]]!=$widget} {return}
  
    ::set w $widget.help
    catch {destroy $w}
    toplevel $w -bd 1 -bg black
    wm overrideredirect $w 1
    if {[string equal [tk windowingsystem] aqua]}  {
        ::tk::unsupported::MacWindowStyle style $top help none
    }
  
    pack [message $w.txt -aspect 10000 -bg lightyellow -font fixed \
        -text $help($widget)]

    ::set wmx [winfo rootx $widget]
    ::set wmy [expr [winfo rooty $widget]+[winfo height $widget]]
    wm geometry $w [winfo reqwidth $w.txt]x[winfo reqheight $w.txt]+$wmx+$wmy
    #useless ?
    raise $w
}
package provide help 1.0

help/test.tcl:

package require help
interp alias {} help {} help::set

button .b
pack .b
help .b "hey \[you\] }{ )( $ %"

EKB: I made a couple of modest changes to the minimalist code (without the fixes for embedding %s and other characters). (And then later on I made modest changes to the modest changes. But when I came here to post the changes, I saw MG's nicer version below. So now I have a dilemma -- use my existing code, or switch to the nicer version? :-)

The main changes:

  • Created a namespace, "balloon" (The proc "set_balloon" is outside the namespace for my own purposes -- this way I keep the same interface in my existing programs.)
  • The "balloon delay" is adjusted so that the balloon pops up quickly if the user is scanning across sibling windows (e.g., scanning across a toolbar), and more slowly initially.
  • Adding a "+" to the start of the binding procs so that other actions that should take place as the widget is entered and exited can also take place.
namespace eval balloon {
    variable long_delay 750
    variable short_delay 50
    variable delay $long_delay
    variable family {}
}

bind . <Enter> {
    if {$balloon::family != ""} {
        if {[lsearch -exact $balloon::family %W] == -1} {
            set balloon::family {}    
            set balloon::delay $balloon::long_delay
        }
    }
}

proc set_balloon {w help} {
    bind $w <Enter> "+after \$balloon::delay [list balloon::show %W [list $help]]; \
        set balloon::delay  $balloon::short_delay; set balloon::family \[balloon::getwfamily %W\]"
    bind $w <Leave> "+destroy %W.balloon"
}

# Add these to the namespace
proc balloon::getwfamily {w} {
    return [winfo children [winfo parent $w]]
}

proc balloon::show {w arg} {
    if {[eval winfo containing  [winfo pointerxy .]]!=$w} {return}
    set top $w.balloon
    catch {destroy $top}
    toplevel $top -bd 1 -bg black
    wm overrideredirect $top 1
    if {[string equal [tk windowingsystem] aqua]}  {
        ::tk::unsupported::MacWindowStyle style $top help none
    }
    pack [message $top.txt -aspect 10000 -bg lightyellow -padx 1 -pady 0 \
        -text $arg]
    set wmx [expr [winfo rootx $w]+5]
    set wmy [expr [winfo rooty $w]+[winfo height $w]+7]
    wm geometry $top [winfo reqwidth $top.txt]x[
        winfo reqheight $top.txt]+$wmx+$wmy
    raise $top
}

MG offers a slightly modified version of the above (the actual balloon code is basically identical). A few changes are:

  • The balloon code is all moved into a namespace, removing the global variables.
  • The bindings are no longer made on the widget itself - instead, they're made on a new class (if that's the right word), "Balloon", and the widget has this added at the start of its [bindtags]. That means broken bindings already set for the widget won't stop the tooltip running.
  • The text to be shown is stored in a variable (array), ::balloon::tips.
  • A few names (procs/variables) shortened, as the namespace should prevent their being overwritten by something else. The 'delay' proc is also laid out a little differently, to shorten it down.

To clear the balloon text for any widget, just set it blank (i.e., balloon $widget ""). When a widget is destroyed, its balloon text is automatically cleared from the variable via the trace command, which means if you create a new widget with the same name, it won't be carried over by mistake.

Here's the code, with a brief example script:

namespace eval balloon {set last 0 ; namespace export balloon}

proc ::balloon::balloon {args} {
    variable last
    variable tips
  
    set numArgs [llength $args]
    if { $numArgs < 1 || $numArgs > 2 } {
        return -code error "wrong # args: should be \"balloon widget ?text?\"";
    }
  
    set w [lindex $args 0]
    if { ![winfo exists $w] } {
        return -code error "bad window path name \"$w\""
    }
  
    if { [winfo class $w] == "Toplevel" } {
        return -code error "cannot create tooltip for toplevel windows";
    }
  
    if { $numArgs == "1" } {
        if { [info exists tips($w)] } {
            return $tips($w);
        } else {
            return "";
        }
    }
  
    set text [lindex $args 1]
  
    if { $text == "" } {
        # turn off tooltip
        if { [set x [lsearch [bindtags $w] "Balloon"]] >= 0 } {
            bindtags $w [lreplace [bindtags $w] $x $x]
        }
        unset -nocomplain tips($w)
        trace remove command $w delete ::balloon::autoclear
        return;
     }
 
    # OK, set up a (new?) tooltip
 
    if { [lsearch [bindtags $w] "Balloon"] < 0 } {
        bindtags $w [linsert [bindtags $w] 0 "Balloon"]
    }
 
    if { [lsearch [trace info command $w] {delete ::balloon::autoclear}] < 0 } {
        trace add command $w delete ::balloon::autoclear
    }
 
    set tips($w) $text
 
};# balloon::balloon

proc ::balloon::show {w} {
    variable tips
    if { ![info exists tips($w)] } {return}
    if {[eval winfo containing [winfo pointerxy .]]!=$w} {return}
    set top "$w.balloon"
    catch {destroy $top}
    toplevel $top -bd 1 -bg black
    wm overrideredirect $top 1
    if {[string equal [tk windowingsystem] aqua]}  {
        ::tk::unsupported::MacWindowStyle style $top help none
    }
    pack [message $top.txt -aspect 10000 -bg lightyellow \
        -text $tips($w)]
    set wmx [winfo rootx $w]
    set wmy [expr [winfo rooty $w]+[winfo height $w]]
    wm geometry $top [winfo reqwidth $top.txt]x[
        winfo reqheight $top.txt]+$wmx+$wmy
    raise $top
};# balloon::show

proc ::balloon::show8.5 {w} {
    variable tips
    if { ![info exists tips($w)] } {return}
    if {[winfo containing {*}[winfo pointerxy .]]!=$w} {return}
    set top "$w.balloon"
    catch {destroy $top}
    toplevel $top -bd 1 -bg black
    bind $top <Button-1> [list destroy $top]
    wm overrideredirect $top 1
    if {[string equal [tk windowingsystem] aqua]}  {
        ::tk::unsupported::MacWindowStyle style $top help none
    }
    pack [message $top.txt -aspect 10000 -bg lightyellow \
        -text $tips($w)]
    set wmx [winfo rootx $w]
    set wmy [expr [winfo rooty $w]+[winfo height $w]]
    wm geometry $top \
      [winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy
    raise $top
};# balloon::show8.5

if { [package vcompare [package require Tcl] 8.5] >= 0 } {
    rename ::balloon::show8.5 ::balloon::show
} else {
    rename ::balloon::show8.5 {}
}

proc ::balloon::delay {} {
    variable last
 
    set then $last
    set last [clock seconds]
    if { [expr {$last - $then}] < 3} {
        return 50
    } else {
        return 1000
    }
 
};# balloon::delay

proc ::balloon::autoclear {old new op} {
   variable tips

   unset -nocomplain tips([namespace tail $old]);

};# balloon::autoclear

namespace import ::balloon::balloon
bind Balloon <Enter> {after [::balloon::delay] [list ::balloon::show %W]}
bind Balloon <Leave> {destroy %W.balloon}

 
console show
 
##############
# test script
##############
button .b1 -text "First"  ; balloon .b1 "1st"
button .b2 -text "Second" ; balloon .b2 "2nd"
button .b3 -text "Third"  ; balloon .b3 "3rd"
button .b4 -text "No tip"
 
pack .b1 .b2 .b3 .b4 -side left -padx 4
 
# uncomment below to clear the tooltip for "Third" button
# balloon .b3 ""

MG Made a few modifications to the above code. You can now call it with one arg, balloon $widget, and it will return the current balloon text for that widget (or an empty string if none is set). Also, it no longer lets you set balloon text for toplevel windows, because when you do so it doesn't play nice, and gets itself into an infinite loop, which Tcl kindly catches, but still looks ugly. (I suspect that a 'break' in the <Leave> binding might sort this, but haven't bothered to check it - IMHO, not being able to tooltip a toplevel is a shame, but not being able to run custom <Leave> bindings for one is unacceptable, so it's better this way.)

Kevin Walzer 2005-12-13: Changed tclplatform/macintosh bits to tk_windowingsystem/aqua (the "Macintosh" platform, which refers to Mac OS <= 9, is now obsolete).


http://img684.imageshack.us/img684/6190/image64p.gifgold added pix

Tooltip in Itcl

Barry Skidmore:

I was quite bored so decided to try my hand at an extensible tooltip system for Tcl using iTcl. It may not be the best, but certainly worth a look. This was my first iTcl code ever. So be kind :)

The Object:

#===== ITcl Class ToolTip ==================================#
# Initialize a Tool Tip object.  (Creates window if needed) #
# Usage: ToolTip objName widgetName tipMessage              #
# Configuration Options:                                    #
#   tipMessage: Message to display in tooltip window        #
#   tipDelay: Time to wait before showing/hiding tip        #
#       Default value is 400                                #
#   xOffset: X coordinate offset for the tootip window      #
#   yOffset: Y coordinate offset for the tooltip window     #
#       Default value is 20                                 #
#===========================================================#
itcl::class ToolTip {
    public variable widgetName ""
    public variable tipMessage ""
    public variable xOffset 20
    public variable yOffset 20
    public variable tipDelay 400
    
    constructor { name msg } {
        set widgetName $name
        set tipMessage $msg
        bind $name <Enter> {foreach itclTip [itcl::find objects -isa ToolTip] {if {[$itclTip cget -widgetName] == "%W"} {$itclTip show}}}
        bind $name <Leave> {foreach itclTip [itcl::find objects -isa ToolTip] {if {[$itclTip cget -widgetName] == "%W"} {$itclTip hide}}}
    }

    method show {} {
        if {![catch {toplevel .tipWindowItclClass -bg black -bd 1 -height 1 -width 1 -relief solid} blah]} {
            label .tipWindowItclClass.text -bg lightyellow -justify left -text "$tipMessage"
            grid .tipWindowItclClass.text -row 0 -column 0 -sticky w
            wm overrideredirect .tipWindowItclClass 1
            wm withdraw .tipWindowItclClass
        }
        .tipWindowItclClass.text configure -text " $tipMessage "
        wm geometry .tipWindowItclClass +[expr [winfo pointerx .] + $xOffset]+[expr [winfo pointery .] + $yOffset]
        after $tipDelay {
            wm deiconify .tipWindowItclClass
            raise .tipWindowItclClass
        }
    }

    method hide {} {
        after $tipDelay {
            wm withdraw .tipWindowItclClass
        }
    }

    destructor {
        destroy .tipWindowItclClass
    }
}

The Sample:

frame .top -relief flat -bd 0
label .atext -relief flat -bd 0 -text "blah0"
label .btext -relief flat -bd 0 -text "blah1"
label .ctext -relief flat -bd 0 -text "blah2"
label .dtext -relief flat -bd 0 -text "blah3"
pack .atext -in .top -fill both
pack .btext -in .top -fill both
pack .ctext -in .top -fill both
pack .dtext -in .top -fill both
pack .top -fill both
ToolTip #auto .atext "This is a Test"
ToolTip #auto .btext "This too"
ToolTip #auto .ctext "Yup again"
ToolTip #auto .dtext "It's over now"