Sunday, November 04, 2012

gnocl::tooltip trigger

Did a little more to the demo script to show how the "trigger" sub-command actually works.

# test-tooltip.tcl
#! /bin/sh/
#\
exec tclsh "$0" "$@"
package require Gnocl

set lab(1) [gnocl::label -text "TANNOY" ]
set lab(2) [ gnocl::label -text "CAMPER 1" -tooltip "Hi-Di-Hi!!!" ]
set lab(3) [ gnocl::label -text "CAMPER 2" -tooltip "quiet" ]

set box [gnocl::box -orientation  vertical ]
$box add $lab(1) -expand 1 -fill {1 1}
$box add $lab(2) -expand 1 -fill {1 1}
$box add $lab(3) -expand 1 -fill {1 1}

set main [gnocl::window -title "Rise-n-Shine" -child $box -setSize 0.125]

#---------------
# create custom tooltip
#---------------
#
proc myToolTip {} {
   
    # create custom tooltip window
    set lab [gnocl::label -text "Ho-Di-Ho" -xPad 10]
    set im [gnocl::image -image %#About ]
    set box [gnocl::box -borderWidth 1 -shadow in]
   
    $box add $im
    $box add $lab

    # keep copy of component widget ids using -data option
    return [gnocl::window -visible 0 -type popup -child $box -backgroundColor #FBF998 -data "lab $lab im $im box $box" ]
}

set tip [myToolTip]
gnocl::tooltip $lab(3) -window $tip

# extract data and modify
eval [lindex [$tip cget -data] 1] configure -text \"Ho-Di-Ho!!!\"

# demonstrate the use of the trigger sub-command.
set i 0
proc update {} {
    global i
    global lab
        incr i
        $lab(1) configure -tooltip "Good Morning Campers -$i"
        gnocl::tooltip trigger
    after 1000 update
}

update

No comments: