Recipe 68414 revision 2

# poToolhelp.tcl
# Simple package to implement a toolhelp widget.
# Paul Obermeier, 2001.

package provide poToolhelp 1.0

namespace eval ::poToolhelp {
    namespace export AddBinding
    namespace export Init

    variable topWidget
}

proc ::poToolhelp::Init { w { bgColor lightyellow } { fgColor black } } {
    variable topWidget

    # Create Toolbar help window with a simple label in it.
    if { [winfo exists $w] } {
	destroy $w
    }
    toplevel $w
    set topWidget $w
    label $w.l -text "This is toolhelp" -bg $bgColor -fg $fgColor -relief ridge
    pack $w.l
    wm overrideredirect $w true
    wm geometry $w [format "+%d+%d" -100 -100]
}

proc ::poToolhelp::ShowToolhelp { x y str } {
    variable topWidget

    $topWidget.l configure -text $str
    raise $topWidget
    wm geometry $topWidget [format "+%d+%d" $x [expr $y +10]]
}

proc ::poToolhelp::HideToolhelp {} {
    variable topWidget

    wm geometry $topWidget [format "+%d+%d" -100 -100]
}

proc ::poToolhelp::AddBinding { w str } {
    variable topWidget

    if { ![info exists topWidget]} {
	Init .poToolhelp
    }
    bind $w <Enter>  "::poToolhelp::ShowToolhelp %X %Y [list $str]"
    bind $w <Leave>  "::poToolhelp::HideToolhelp"
    bind $w <Button> "::poToolhelp::HideToolhelp"
}

catch {puts "Loaded Package poToolhelp (File [info script])"}

# Demo code. Uncomment for testing.

# package require poToolhelp

# pack [button .b -text "This is a button"] -fill x -expand 1
# ::poToolhelp::AddBinding .b "Toolhelp for a button"
# pack [label .l -text "This is a label"] -fill x -expand 1
# ::poToolhelp::AddBinding .l "Toolhelp for a label"
# set eVar "This is a entry"
# pack [entry .e -textvariable eVar] -fill x -expand 1
# ::poToolhelp::AddBinding .e "Toolhelp for a entry"
# pack [button .q -text "Quit" -command exit] -fill x -expand 1
# ::poToolhelp::AddBinding .q "Really want to quit this fabulous program ?"

• « Back to Recipe 68414

History

• revision 2 (22 years ago)
• previous revisions are not available