View in color | License | Download script | History | Other scripts by: shadwolf |
30-Apr 11:25 UTC
[0.045] 12.778k
[0.045] 12.778k
toolt4vid.rREBOL [
Library: [
level: 'intermediate
platform: 'all
type: [tool]
domain: [vid]
tested-under: "win2k"
support: "shadwolf/france groupe on altme"
license: 'public-domain
see-also: none
]
Title: "tooltipVid.r"
File: %toolt4vid.r
Author: "Shadwolf, Boss, DideC, Volker"
Date: 3-Feb-2006
Version: 1.0
Purpose: "Tooltip for VID (less bugged than previous version. This work is the mixing of 2 different ways to handle tooltips in vid not using style package anymore"
]
; cut here until end and add it to your own REBOL/View script can be externalise too
tip-face: none
untip: has [win p] [
if all [ tip-face win: find-window tip-face p: find win/pane tip-face ] [
remove p hide tip-face tip-face: none
]
]
tip: func [face offset act te /local win] [
untip
if act [
win: find-window face
layout/tight [
tip-face: text (te) gold black rate 0:0:3
feel [ engage: func [face action event][
if action = 'time [ if face/show? [hide face] ] ] ]
]
tip-face/offset: either face/offset/x > ((face/parent-face/size/x / 4) * 3)
[ as-pair (offset/x - tip-face/size/x ) offset/y ] [offset - 20x0 ]
append win/pane tip-face show win
]
]
tip-over: make block! [if all[in f 'tooltip f/tooltip (length? f/tooltip) > 0] [ tip f e a f/tooltip ]]
effect-face: func [
{Permet d'ajouter du code dans le gestionnaire d'événements d'une facet.
Le code ajouté peut faire usage des variables f a e (la face, l'action et l'événement courants)}
face [object!] ; objet de type face (facet)
fu [word!] ; au choix 'engage 'detect 'over 'redraw
code ; block contenant le code ŕ ajouter
][
set in face/feel :fu func [f a e] bind append compose [
(get in face/feel :fu) f a e ; ancien code avant ajout de la gestion du tooltip
] code in face/feel :fu
]
Add-tooltip-2-style: func [ { Allow to add the tooltip support to all widgets passed in parameter}
style-lst [block! ] "Contains the listing of Vid widgets to patch"
style-root "Countain the path of the root-styles to patch"
][
foreach style style-lst [
if find style-root style [ ; Teste si le style existe pour la compatibilité avec les versions antérieures de view
effect-face style-root/:style 'over tip-over
]
]
]
; here is the list of widget affected by the tooltip ability
vid-styles: [image btn backtile box sensor key base-text vtext text body txt banner vh1 vh2 vh3 vh4
title h1 h2 h3 h4 h5 tt code button check radio check-line radio-line led
arrow toggle rotary choice drop-down icon field info area slider scroller progress
anim btn-enter btn-cancel btn-help logo-bar tog]
Add-tooltip-2-style vid-styles system/view/vid/vid-styles
; end of cut
; HOWTO USE IT CODE CODE;
view win: layout [
area "another face" with [tooltip: "an area"]
panel [across
button "test" with [tooltip: "the first button" ]
button "test2" with [tooltip: "the second button" ]
]
] |