"SfR Fresh" - the SfR Freeware/Shareware Archive 
Member "OpenVerse/lib/Bubble.tcl" of archive OpenVerse-0.8-7.tar.gz:
As a special service "SfR Fresh" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting with prefixed line numbers.
Alternatively you can here view or download the uninterpreted source code file.
That can be also achieved for any archive member file by clicking within an archive contents listing on the first character of the file(path) respectively on the according byte size field.
1 # Changed
2 # ##################################
3 # namespace: Bubble
4 # coded by: Steve Foster
5 # date: 16/1/1998
6 # requires: tcl/tk 8.0(namespace)
7 # desc: Attaches help bubbles
8 # to any existing windows
9 #
10 # Example
11 # # create a window or two
12 # button .b -text Button
13 # label .l -text Label
14 # pack .b .l -side left
15 #
16 # # then assign the help to it
17 # # to start background bubble
18 # Bubble::initBubble .b "Hello This is a button"
19 # Bubble::initBubble .l "Hello This is a label, it think?"
20 #
21 # # to destroy background bubble
22 # # ie remove its binding
23 # Bubble::destroyBubble .b
24 # ##################################
25 namespace eval Bubble {
26 variable win ;# array to hold info
27 variable time 1750 ;# delay before posting help (ms)
28
29 # Help attributes
30 ##################
31 variable bcolor lemonchiffon ;# background color
32 variable fcolor black ;# text color
33 variable just "left" ;# justify text left
34 variable wrapl 2i ;# wrap length
35 variable bd 1 ;# border thickness
36 variable font [font actual "helvetica 12"]
37
38 # Public
39 #########
40 # Command to setup a help bubble binding
41 proc initBubble {w txt} {
42 variable win
43
44 if { ![winfo exists $w] } {
45 tk_messageBox -title "Bubble ERROR" \
46 -message "ERROR: \"$w\" Dosnt exist, Cant attach Help Bubble" \
47 -icon error \
48 -type ok
49 }
50
51 bind $w <Enter> "Bubble::_startBubble $w" ;# entered window
52 bind $w <Leave> "Bubble::_killBubble $w" ;# left window
53 set win($w,TXT) $txt
54 }
55 # Command to destroy a help bubble binding
56 proc destroyBubble w {
57 # delete event bindings
58 bind $w <Enter> ""
59 bind $w <Leave> ""
60 }
61
62
63 # Private
64 ##########
65 # commands used behind the scenes
66 proc _startBubble w {
67 variable win
68 variable time
69 destroy .bubble
70
71 # entered window so start bubble timer
72 set win($w,ID) [after $time "Bubble::_doBubble $w"]
73 }
74 proc _doBubble w {
75 if {![winfo exists $w]} {return}
76 # pop up the help window
77 variable win
78 variable bcolor
79 variable fcolor
80 variable just
81 variable wrapl
82 variable bd
83 variable font
84
85 # get position for bubble window
86 set posx +[winfo pointerx $w]
87 set posy +[winfo pointery $w]
88
89 # create window, remove it from view, remove frame
90 toplevel .bubble
91 wm withdraw .bubble
92 wm overrideredirect .bubble 1
93 wm geometry .bubble $posx$posy
94
95 # set up label with attributes
96 label .bubble.l -text $win($w,TXT) \
97 -bg $bcolor -fg $fcolor \
98 -bd $bd -font $font \
99 -justify $just -wraplength $wrapl \
100 -padx 6 -relief raised -borderwidth 3
101 pack .bubble.l
102
103 # make it visible
104 wm deiconify .bubble
105 }
106 proc _killBubble w {
107 # cancel timers _doBubble will kill the .bubble help
108 variable win
109 after cancel $win($w,ID)
110
111 }
112
113 }