class Balloonwidget {
inherit itk::Widget
itk_option define -balloonhelp balloonHelp BalloonHelp ""
private variable balloon_queue ""
private variable destroy_queue ""
public method enter
public method leave
public method balloon
constructor { args } {
bind $itk_component(hull) <Enter> [code $this enter]
bind $itk_component(hull) <Leave> [code $this leave]
eval itk_initialize $args }
}
body Balloonwidget::enter { } {
if {$balloon_queue != ""} {
after cancel $balloon_queue
}
if {$itk_option(-balloonhelp) != ""} {
set balloon_queue [after 750 [code $this balloon]]
}
}
body Balloonwidget::leave { } {
if {$balloon_queue != ""} {
after cancel $balloon_queue
}
set destroy_queue [after 100 {catch {destroy .balloon_help}}]
}
body Balloonwidget::balloon { } {
set t .balloon_help
catch {destroy $t}
toplevel $t
wm overrideredirect $t 1
if {[tk windowingsystem] == "aqua"} {
#unsupported1 style $itk_component(hull) floating sideTitlebar
::tk::unsupported::MacWindowStyle style $t help none
}
label $t.l \
-text " $itk_option(-balloonhelp) " \
-relief solid \
-bd 2 \
-bg gold \
-fg #000000 \
-font font_b
pack $t.l -fill both
set x [expr [winfo pointerx $itk_component(hull)] + 8]
set y [expr [winfo pointery $itk_component(hull)] + 20]
if {[expr $x + [winfo reqwidth $t.l]] > [winfo screenwidth $t.l]} {
set x [expr [winfo screenwidth $t.l] - [winfo reqwidth $t.l] - 2]
}
if {[expr $y + [winfo reqheight $t.l]] > [winfo screenheight $t.l]} {
set y [expr $y - 20 - [winfo reqheight $t.l] - 2]
}
wm geometry $t +$x\+$y
#bind $t <Enter> [list [after cancel $destroy_queue]]
#bind $t <Leave> "catch {destroy .balloon_help}"
}
class Activity {
inherit Balloonwidget
#inherit itk::Widget
private variable current_image_list {}
private variable busy_list {::img::activity_blue_N16x16 ::img::activity_blue_NE16x16 ::img::activity_blue_E16x16 ::img::activity_blue_SE16x16 ::img::activity_blue_S16x16 ::img::activity_blue_SW16x16 ::img::activity_blue_W16x16 ::img::activity_blue_NW16x16}
private variable warn_list {::img::activity_error_N16x16 ::img::activity_error_N16x16 ::img::activity_error_blank16x16}
private variable pause_list {::img::activity_blue_N16x16 ::img::activity_blue_N16x16 ::img::activity_blue_blank16x16 }
private variable idle_list {::img::activity_idle16x16 }
private variable queue ""
public method busy
public method idle
public method pause
public method warn
private method animate
private method stop
private method loopImages
constructor { args } { }
}
body Activity::constructor { args } {
itk_component add label {
label $itk_interior.l
}
pack $itk_component(label)
eval itk_initialize $args
}
body Activity::busy { {a_message ""} } {
configure -balloonhelp $a_message
animate $busy_list
}
body Activity::idle { } {
configure -balloonhelp "Idle"
animate $idle_list
}
body Activity::pause { } {
configure -balloonhelp "Paused"
animate $pause_list 200
}
body Activity::warn { {a_message "Error"} } {
configure -balloonhelp $a_message
animate $warn_list 200
}
body Activity::animate { a_list { a_interval "125" } } {
stop
set current_image_list $a_list
if {[llength $current_image_list] <= 1} {
$itk_component(label) configure \
-image [lindex $current_image_list 0]
} else {
loopImages 0 $a_interval
}
}
body Activity::stop { } {
if {$queue != ""} {
after cancel $queue
}
}
body Activity::loopImages { a_index a_interval } {
if {$a_index >= [llength $current_image_list]} {
set a_index 0
}
$itk_component(label) configure \
-image [lindex $current_image_list $a_index]
incr a_index
set queue [after $a_interval [code $this loopImages $a_index $a_interval]]
}
usual Activity { }
class test {
# inherit itk::Widget
public method mes
public method queryte
constructor { args } { }
}
body test::constructor { args } {
Activity .al
.al busy
pack .al
}
body test::queryte { } {
}
body test::mes { } {
}
test .ck
#pack .ck