9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
-
+
|
# Permission is granted to use this code under the same terms as
# for the Tcl core code.
#
#----------------------------------------------------------------------
# $Revision: 1.1 $
#----------------------------------------------------------------------
package provide psballoon 1.0
package provide psballoon 1.1
namespace eval psballoon {
variable balloon
set balloon(pending) 0
set balloon(created) 0
set balloon(id) ""
|
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
+
+
+
+
+
+
+
+
+
+
+
|
if {$msg == "" && $c != "Listbox" && $c != "Label"} {
error "Missing message to balloon for $W ($c)"
}
set balloon(msg,$W) $msg
bind $W <Enter> {
set ::psballoon::balloon(pending) 1
set ::psballoon::balloon(created) 0
set ::psballoon::balloon(lastX) %X
set ::psballoon::balloon(lastY) %Y
set ::psballoon::balloon(id) [after 500 {psballoon::createBalloon %W %x %y}]
}
bind $W <Button> {
psballoon::killBalloon
}
bind $W <Leave> {
psballoon::killBalloon
}
bind $W <Motion> {
if {$::psballoon::balloon(pending) == 1} {
after cancel $::psballoon::balloon(id)
}
if {$::psballoon::balloon(created) == 1} {
if {$::psballoon::balloon(lastX) == %X && \
$::psballoon::balloon(lastY) == %Y} {
# Sometimes when the balloon is created, a motion event with
# the same coordinates arrive. Ignore that to avoid killing the
# new balloon.
return
}
psballoon::killBalloon
}
set ::psballoon::balloon(lastX) %X
set ::psballoon::balloon(lastY) %Y
set ::psballoon::balloon(id) [after 500 {psballoon::createBalloon %W %x %y}]
set ::psballoon::balloon(pending) 1
}
}
proc psballoon::killBalloon {} {
variable balloon
|