A simple tooltip for buttons, field, etc.

tooltip.red

Red [ title: "A simple tooltip for buttons, field, etc." ]

__tooltip: context [
get-absolute-offset: function [face][
	offset-adjust: [ 6x6 8x31 6x26 8x51 ]
	adjust-index: 1
	adjustment: 0
	results: face/offset
	target: face/parent
	until [
		results: results + target/offset
		if target/type = 'window [
			if not find target/flags 'no-title [ adjust-index: adjust-index + 1 ]
			if not none? target/menu [ adjust-index: adjust-index + 2 ]
			adjustment: (pick offset-adjust adjust-index)
		]
		target: target/parent
		(target/type = 'screen)
	]
	return (results + adjustment)
]
_tooltip: none
set 'tooltip func [ btn [object!] evt [event!] tip [string!] ][
	either evt/away? [
		if face? _tooltip [
			unview/only _tooltip
			_tooltip: none
		]
	][
		unless face? _tooltip [
			view/no-wait/flags/options _tooltip: layout/tight [
				backdrop 255.255.200 pad 3x0 text tip font-size 9 pad 3x0 text 0 "" 
			][ popup no-title ][
				offset: (get-absolute-offset btn) + as-pair 0 (btn/size/y + 4)
			]
		]
	]
]
]

; test
comment [
view [
	text "Name:" 30 nm: field 200 "" on-over [tooltip face event "Enter your name"]
	return
	button "Left"	on-over [tooltip face event "Press the button!"] [alert face/text]
	button "Right"	on-over [tooltip face event "Press the button!"] [alert face/text]
	button "Up"		on-over [tooltip face event "Press the button!"] [alert face/text]
	button "Down"	on-over [tooltip face event "Press the button!"] [alert face/text]
]
]