REBOL[ Library: [ level: 'intermediate platform: 'all type: [tutorial tool] domain: [ftp game] tested-under: none support: 'yes license: none see-also: none ] Title: "Style Scrollable scroll-pane & table avec gestion de la roullette" File: %style-scrollable.r Author: "Claude RAMIER" Email: %ram--cla--laposte--net Date: 14-05-2004 Purpose: { Essai de gestion des scrolls & de tables } Comment: { **** SCROLL-PANE **** **** TABLE **** La table permet: - le tri de ses éléments avec le bouton de droit de la sourie - la modification de champ s'il le style du champ est modifiable - le renvoie de la ligne selectionnée - de cacher des données (qui n'apparaise pas lors de la visualisation) mais qui sont renvoyé par la selection - de changer la longueur des colonnes avec un drag & drop sur l'entête des colonnes. - de gerer les styles suivants : ° TEXT ° FIELD ° IMAGE ° CHECK ° INFO * description => la description de la table doit être un block de la forme suivante: [set name word! set title string! set length integer! set style_vid word! set choice-texts block! set custom-layout block!] exemple : des: [ [image "Image" 100 image] [nom "Nom" 200 field] [date-creation "Creation" 100 text] [date-modification "Modification" 100 text] [data-chk "Check data" 100 check] ] * data => Les données doivent être un block d'objet : exemple : donnee: reduce [ make object! [ image: %./images/dossier.gif nom: "employé sans titre" date-creation: 01-Nov-2003 date-modification: 16-Nov-2003 data-chk: 1 ] ] ou donnee: reduce[ context [ image: %./images/dossier.gif nom: "employé sans titre" date-creation: 01-Nov-2003 date-modification: 16-Nov-2003 data-chk: 1 ] ] * Heigth => hauteur de la ligne détail * action-selection => permet d'indiquer l'action à faire lors de la selection exemple : action-selection [ result-text-area/text: mold record-selected show result-text-area ] * table-colors => permet d'indiquer 3 couleurs : 1: couleur ligne impaire 2: couleur ligne paire 3: couleur de selection si les couleurs sont a none alors la face devient transparente * table-field-edge => permet d'indiquer le edge de chaque field du detail } Version: 0.0.0.1 History: [ 0.0.0.1 {Toujours en construction} ] ] ;fonction pour capter le scroll-line a partir de screen-face evt-scroll: func [ face event /local face-x ][ either (event/type == 'scroll-line) [ if not empty? face-waiting-scroll-line[ face-x: first face-waiting-scroll-line if (face-x/scroll/y == 1)[ face-x/sld-ver/data: face-x/sld-ver/data + (event/offset/y * 0.01) if (face-x/sld-ver/data < 0) [face-x/sld-ver/data: 0] if (face-x/sld-ver/data > 1) [face-x/sld-ver/data: 1] show face-x/sld-ver face-x/scroll-ver show face-x ] ] event ][ ; allow other events to pass through event ] ] evt-resize: func [ face event ][ ; print event/type either event/type = 'resize [ ;print event/offset event ][ ; allow other events to pass through event ] ] insert-event-func :evt-resize ;insertion de la fonction dans le feel/detect de screen-face insert-event-func :evt-scroll ;initialisation du block contenant la face à "scroller" face-waiting-scroll-line: copy [] ;styles contenant divers outils pour le scrolling style-scrollable: stylize [ ; scroll-pane avec le possibilité de scroller en X ou Y ou les deux suivant parametre scroll scroll-pane: face with [ init: copy [] scroll: none sld-ver: none sld-hor: none old-resize: none sub-area: none sub-color: none center: false words: [ ; nouveaux mots pour VID data [new/data: second args next args] ; fournir le block d'un layout scroll [new/scroll: second args next args] ; indique si le panel est scrollable et x et/ou y center [new/center: second args next args] ; indique s'il faut center le tout ] feel/detect: func [face event] [ if event/type = 'down [ if (face/type == 'scroll-pane) [ face-waiting-scroll-line: copy [] append face-waiting-scroll-line face ] ] return event ] append init [ sub-color: color size: any [size 200x200] old-resize: size scroll: any [scroll 1x1] pane-block: copy [] append pane-block [ origin 0x0 space 0x0 sub-area: box (size - (0x16 * scroll/x) - (16x0 * scroll/y)) with [color: sub-color] ] if (scroll/y == 1)[ append pane-block [ at (size * 1x0 - 16x0) sld-ver: scroller ((size - (0x16 * scroll/x)) * 0x1 + 16x0) [scroll-ver] with [show?: false] ] ] if (scroll/x == 1)[ append pane-block [ at (size * 0x1 - 0x16) sld-hor: scroller ((size - (16x0 * scroll/y)) * 1x0 + 0x16) [scroll-hor] with [show?: false] ] ] type: 'scrollable pane: layout/size pane-block size if (not none? data) [ sub-area/pane: layout data sub-area/pane/color: none recenter ] pane/offset: 0x0 pane/color: none color: none update-scroll ] scroll-ver: func[][ scroll-panel-ver sub-area sld-ver ] scroll-hor: func[][ scroll-panel-hor sub-area sld-hor ] update-scroll: func [][ either (none? sub-area/pane) [ if (scroll/y == 1)[sld-ver/redrag 1 sld-ver/show?: false] if (scroll/x == 1)[sld-hor/redrag 1 sld-hor/show?: false] ][ if (scroll/y == 1)[ either (sub-area/pane/size/y == 0) [ sld-ver/redrag 1 sld-ver/show?: false ][ sld-ver/redrag sub-area/size/y / sub-area/pane/size/y either (sub-area/size/y < sub-area/pane/size/y) [ sld-ver/show?: true ][ sld-ver/show?: false ] ] ] if (scroll/x == 1)[ either (sub-area/pane/size/x == 0) [ sld-hor/redrag 1 sld-hor/show?: false ][ sld-hor/redrag sub-area/size/x / sub-area/pane/size/x either (sub-area/size/x < sub-area/pane/size/x) [ sld-hor/show?: true ][ sld-hor/show?: false ] ] ] ] ] scroll-panel-ver: func [sub-area sld-ver][ if not none? sub-area/pane [ sub-area/pane/offset/y: negate sld-ver/data * (max 0 sub-area/pane/size/y - sub-area/size/y) ] show sub-area ] scroll-panel-hor: func [sub-area sld-hor][ if not none? sub-area/pane [ sub-area/pane/offset/x: negate sld-hor/data * (max 0 sub-area/pane/size/x - sub-area/size/x) ] show sub-area ] recenter: func [][ if not empty? data [ sub-area/pane/offset: 0x0 if center [ if (sub-area/size/x > sub-area/pane/size/x)[ sub-area/pane/offset/x: (sub-area/size/x - sub-area/pane/size/x) / 2 ] if (sub-area/size/y > sub-area/pane/size/y)[ sub-area/pane/offset/y: (sub-area/size/y - sub-area/pane/size/y) / 2 ] ] ] ] resize: func [offset-delta [pair! none!]] [ print "coucou" reset if offset-delta [size: size + offset-delta] size: min size 32x24 show ignore ] ] ; styles qui affiche une table table: face with [ ; Initialisation des variables temporaire utilisé init: copy [] record-selected: none scroll: none pane-block: none table-header-area: none table-detail-area: none sld-ver: none sld-hor: none table-header-area-field-start: none table-header-area-field-oldpos: none table-detail-field-edge: none table-detail-color: none table-detail-colors: none ; Initialisation des nouveau mots du style header-description: none detail-data: none line-detail-heigth: none action-selection: [] words: [ ; nouveaux mots pour VID description [new/header-description: second args next args] ; description de l'entête de la table data [new/detail-data: second args next args] ; donnée pour remplir la table heigth [new/line-detail-heigth: second args next args] ; hauteur de ligne du detail action-selection [new/action-selection: second args next args] ;action lors de la selection d'un ligne table-colors [new/table-detail-colors: second args next args] ;colors utilisés 1,2 pour les interlignes 3 pour la selection table-field-edge [new/table-detail-field-edge: second args next args] ; modification du edge des champs ] feel/detect: func [face event] [ if event/type = 'down [ if (face/type == 'scrollable) [ face-waiting-scroll-line: copy [] append face-waiting-scroll-line face ] ] return event ] append init [ table-detail-color: color if none? table-detail-colors [ table-detail-colors: copy [] append table-detail-colors table-detail-color append table-detail-colors table-detail-color append table-detail-colors cyan ] do build ] build: func[][ line-detail-heigth: any [line-detail-heigth 20] size: any [size 200x200] scroll: 1x1 pane-block: copy [] append pane-block [ styles style-scrollable origin 0x0 space 0x0 table-header-area: table-header (size * 1x0 + 0x20 - 16x0) description header-description with [color: none] table-detail-area: table-detail (size - 0x20 - 16x16) description header-description data detail-data heigth line-detail-heigth detail-colors table-detail-colors field-edge table-detail-field-edge with [color: table-detail-color] ] if (scroll/y == 1)[ append pane-block [ at (size * 1x0 - 16x0 + 0x20) sld-ver: scroller ((size - (0x16 * scroll/x) - 0x20) * 0x1 + 16x0) [scroll-ver show ignore] ] ] if (scroll/x == 1)[ append pane-block [ at (size * 0x1 - 0x16) sld-hor: scroller ((size - (16x0 * scroll/y)) * 1x0 + 0x16) [scroll-hor show ignore] ] ] type: 'scrollable pane: none pane: layout/size pane-block size pane/offset: 0x0 ;pane: pane/pane update-scroll color: none pane/color: none ] rebuild-detail: func[new-data][ detail-data: new-data table-detail-area/data: detail-data table-detail-area/build ] new-data: func[new-data][ detail-data: new-data do build ] scroll-ver: func[][ scroll-panel-ver table-detail-area sld-ver ] scroll-hor: func[][ scroll-panel-hor table-header-area table-detail-area sld-hor ] update-scroll: func[][ either (none? table-detail-area/pane) [ if (scroll/y == 1)[sld-ver/redrag 1 sld-ver/show?: false] if (scroll/x == 1)[sld-hor/redrag 1 sld-hor/show?: false] ][ if (scroll/y == 1)[ either (table-detail-area/pane/size/y == 0) [ sld-ver/redrag 1 sld-ver/show?: false ][ sld-ver/redrag table-detail-area/size/y / table-detail-area/pane/size/y either (table-detail-area/size/y < table-detail-area/pane/size/y) [ sld-hor/show?: true ][ sld-hor/show?: false ] ] ] if (scroll/x == 1)[ either (table-header-area/pane/size/x == 0) [ sld-hor/redrag 1 sld-hor/show?: false ][ sld-hor/redrag table-header-area/size/x / table-header-area/pane/size/x either (table-header-area/size/x < table-header-area/pane/size/x) [ sld-hor/show?: true ][ sld-hor/show?: false ] ] ] ] ] scroll-panel-ver: func [tda ver][ if not none? tda/pane [ tda/pane/offset/y: negate ver/data * (max 0 tda/pane/size/y - tda/size/y) ] ] scroll-panel-hor: func [tha tda hor][ tda/pane/offset/x: negate hor/data * (max 0 tda/pane/size/x - tda/size/x) tha/pane/offset/x: negate hor/data * (max 0 tha/pane/size/x - tha/size/x) ] get-num-sel: func[field-offset /local numsel][ numsel: (field-offset/y / (line-detail-heigth + 1)) + 1 ] set-record-selected: func[field-offset /local numsel][ numsel: get-num-sel field-offset record-selected: table-detail-area/data/:numsel if not empty? action-selection [ do bind action-selection 'record-selected ] ] ] ; sous style de table table-header: face with [ init: copy [] ; Initialisation des variables temporaire utilisé head-layout: none ; Initialisation des nouveau mots du style description: none words: [ description [new/description: second args next args] ] append init [ head-layout: copy [] append head-layout [styles style-scrollable origin 0x0 space 1x0 across] foreach [des] description [ parse des [set name word! set title string! set length integer! set look word! set choice-texts block! set custom-layout block!] append head-layout compose/deep[ th-btn (length) (title) field-word (load join "'" name) ] ] ;append head-layout [return] pane: layout head-layout ;pane: pane/pane pane/offset: 0x0 pane/color: none color: none ] ] th-btn: button 195.167.255 with [ notri: false status: none field-word: none words: [ field-word [new/field-word: second args next args] ] feel: make feel [engage: func [face action event /local delta newpos table-face field-word status new-data] [ table-face: face/parent-face/parent-face/parent-face/parent-face if action = 'down [ face/notri: true table-face/table-header-area-field-start: event/offset table-face/table-header-area-field-oldpos: 0 ] if face/notri [ if action = 'up [ table-face/table-header-area-field-oldpos: 0 ] if (find [over away] action) [ newpos: event/offset/x - table-face/table-header-area-field-start/x delta: newpos - table-face/table-header-area-field-oldpos if ((face/size/x + delta) < 20)[ newpos: table-face/table-header-area-field-oldpos delta: newpos - table-face/table-header-area-field-oldpos ] foreach obj face/parent-face/pane [ either (obj/offset/x == face/offset/x) [ obj/size/x: obj/size/x + delta ][ if (obj/offset/x > face/offset/x) [ obj/offset/x: obj/offset/x + delta ] ] ] foreach obj table-face/table-detail-area/pane/pane [ either (obj/offset/x == face/offset/x) [ ;obj/size/x: obj/size/x + delta obj/resize to-pair reduce [delta 0] ][ if (obj/offset/x > face/offset/x) [ obj/offset/x: obj/offset/x + delta ] ] ] foreach des table-face/header-description [ if (des/1 == face/field-word) [ des/3: des/3 + delta ] ] table-face/table-detail-area/description: table-face/header-description table-face/table-header-area-field-oldpos: newpos table-face/table-header-area/pane/size/x: table-face/table-header-area/pane/size/x + delta table-face/table-detail-area/pane/size/x: table-face/table-detail-area/pane/size/x + delta table-face/update-scroll show table-face ] ] if action = 'alt-down [ face/notri: false status: face/status if none? status [status: true] field-word: face/field-word new-data: copy [] either status [ status: false new-data: sort/compare table-face/table-detail-area/data func [a b] [ if a/:field-word = b/:field-word [return 0] either a/:field-word > b/:field-word [1][-1] ] ][ status: true new-data: sort/compare table-face/table-detail-area/data func [a b] [ if a/:field-word = b/:field-word [return 0] either a/:field-word < b/:field-word [1][-1] ] ] table-face/show?: false current-pos-sld-ver: table-face/sld-ver/data current-pos-sld-hor: table-face/sld-hor/data table-face/rebuild-detail table-face/detail-data face/status: status table-face/sld-ver/data: current-pos-sld-ver table-face/sld-hor/data: current-pos-sld-hor table-face/scroll-ver table-face/scroll-hor table-face/show?: true show table-face ] ] ] resize: func [offset-delta [pair! none!]] [ reset if offset-delta [size: size + offset-delta] size: max size 20x20 ] ] ; sous style de table table-detail: face with [ init: copy [] ; Initialisation des variables temporaire utilisé detail-layout: none check-block: none detail-color: none ; Initialisation des nouveau mots du style description: none heigth: none detail-colors: copy [] detail-field-edge: none words: [ description [new/description: second args next args] data [new/data: second args next args] heigth [new/heigth: second args next args] detail-colors [new/detail-colors: second args next args] field-edge [new/detail-field-edge: second args next args] ] append init [ detail-color: color do build ] build: func[ /local y x][ detail-layout: copy [] append detail-layout [styles style-scrollable origin 0x0 space 1x1 across] y: 0 if not none? data[ foreach rcd data [ y: y + 1 x: 0 foreach [des] description [ parse des [set name word! set title string! set length integer! set look word! set choice-texts block! set custom-layout block!] x: x + 1 append detail-layout compose/deep [ styles style-scrollable table-detail-field (to-pair reduce[length heigth]) ] switch/default look [ image [ use [image-img image-size-coef image-img-size][ image-img: to-image load rcd/:name image-size-coef: heigth / image-img/size/y image-img-size: image-img/size * image-size-coef append detail-layout compose/deep [ data [ origin 0x0 space 0x0 image (image-img) with [ size: image-img-size ] ] ] ] ] check [ append detail-layout compose/deep [ data [ origin 0x0 space 0x0 check (to-logic rcd/:name) [ use [table-face nbr sel-data toto new-data][ table-face: face/parent-face/parent-face/parent-face/parent-face/parent-face/parent-face nbr: (y) sel-data: table-face/table-detail-area/data/:nbr toto: to-set-path [sel-data (name)] new-data: to-integer face/data reduce reduce [toto new-data] ] ] ] ] ] field [ append detail-layout compose/deep [ data [ origin 0x0 space 0x0 field (to-string rcd/:name) [ use [table-face nbr sel-data toto][ table-face: face/parent-face/parent-face/parent-face/parent-face/parent-face/parent-face nbr: (y) sel-data: table-face/table-detail-area/data/:nbr toto: to-set-path [sel-data (name)] reduce reduce [toto face/text] ] ] ] ] ] info [ append detail-layout compose/deep [ data [ origin 0x0 space 0x0 info (to-string rcd/:name) ] ] ] ][ append detail-layout compose/deep [ data [ origin 0x0 space 0x0 text (to-string rcd/:name) ] ] ] append detail-layout compose/deep [ edge [(detail-field-edge)] center true with [ face-detail-color: none face-detail-color-sel: (detail-colors/3) append init [ either integer? ((y) / 2 )[ face-detail-color: (detail-colors/1) ][ face-detail-color: (detail-colors/2) ] color: face-detail-color ] ] ] ] append detail-layout [return] ] ] pane: layout detail-layout pane/offset: 0x0 pane/color: detail-color color: none ] ] ; scroll-pane avec le possibilité de scroller en X ou Y ou les deux suivant parametre scroll table-detail-field: box with [ init: copy [] sub-area: none center: false tableau: none field-color: none words: [ ; nouveaux mots pour VID data [new/data: second args next args] center [new/center: second args next args] tableau [new/tableau: second args next args] ] feel/detect: func [face event /local table-face] [ if event/type = 'down [ if (face/type == 'table-detail-field)[ table-face: face/parent-face/parent-face/parent-face/parent-face foreach obj face/parent-face/pane [ either (obj/offset/y == face/offset/y) [ obj/color: obj/face-detail-color-sel table-face/set-record-selected face/offset ][ ;obj/color: face/field-color obj/color: obj/face-detail-color ] ] ;show face show face/parent-face ] ] return event ] append init [ field-color: color size: any [size 200x200] pane-block: copy [] append pane-block [ origin 0x0 space 0x0 sub-area: box (size) with [color: field-color] ] pane: layout/size pane-block size if (not none? data) [ sub-area/pane: layout data sub-area/pane/color: none recenter ] type: 'table-detail-field pane: sub-area/pane ;pane/offset: 0x0 color:none ] recenter: func [][ if not empty? data [ sub-area/pane/offset: 0x0 if center [ if (sub-area/size/x > sub-area/pane/size/x)[ sub-area/pane/offset/x: (sub-area/size/x - sub-area/pane/size/x) / 2 ] if (sub-area/size/y > sub-area/pane/size/y)[ sub-area/pane/offset/y: (sub-area/size/y - sub-area/pane/size/y) / 2 ] ] ] ] resize: func [offset-delta [pair! none!]] [ reset if offset-delta [size: size + offset-delta] size: max size 20x20 sub-area/size: size recenter ] ] ]