Script Library: 1179 scripts
 

toolt4vid.r

REBOL [ 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" ] ] ]
halt ;; to terminate script if DO'ne from webpage