REBOL [Title: "Button for Petr!"] foreach [w f][ saltire %saltire.png misc %green.png tartan %back-tartan.png metal %bg-metal.png ][ set w load-image join http://www.ross-gill.com/r/ f ] ;--- Wash Effect --- make-wash-table: func [col /local blk col-s col-b][ blk: make block! 256 col: rgb-to-hsv col col-s: col/2 col-b: col/3 repeat v 256 [ col/2: to-integer col-s - (v * col-s / 255) col/3: to-integer col-b + ((255 - col-b) * (v - 1 / 255)) insert tail blk hsv-to-rgb col ] blk ] wash: func [img col /local table][ img: copy/part img img/size table: make-wash-table col repeat pix length? img [poke img pix pick table 1 + max max img/:pix/1 img/:pix/2 img/:pix/3] return img ] ;--- BTN Images --- imgs: load-thru http://www.ross-gill.com/r/button.r pekr-up: make image! [5x5 #{ 000000000000000000000000000000000000222222EEEEEE222222000000 000000EEEEEEDDDDDDCCCCCC000000000000222222CCCCCC222222000000 000000000000000000000000000000 } #{ FF990099FF990000009900000000009900000099FF990099FF }] pekr-dn: make image! [5x5 #{ 000000000000000000000000000000000000222222BBBBBB222222000000 000000BBBBBBCCCCCCEEEEEE000000000000222222EEEEEE222222000000 000000000000000000000000000000 } #{ FF990099FF9900000099 00000000009900000099 FF990099FF }] ;--- Chris's BTN Style --- stylize/master [ PEKR: FACE -1x22 with [ ; version 0.1.2 color: image: none edge: none effects: none font: [color: black colors: none style: none size: 11 shadow: none align: 'center valign: 'middle offset: 14x0] saved-area: true ; 'look supercedes 'images, 'effects, 'colors, 'texts, etc. Provides ; action-based face manipulation in tandem with the feel/display function. look: reduce [ 'default load imgs/button-default 'down load imgs/button-down 'hover [luma 5 contrast 5] ] feel: make svvf/button [ hover?: off ; none turns hover off altogether over: func [face over? offset][ if hover? <> none [hover?: either over? [on][off] show face hover?: off] ] redraw: func [face act pos /local state] [ display face either face/state ['down][either hover? ['hover]['default]] ] ; Function used to manipulate face display: func [face action][ either action = 'hover [ insert tail face/effect face/look/hover ][ remove/part find/last face/effect 'luma 4 face/image: any [select face/look action face/image] ] ] ] colors: color: none init: [ if size/x = -1 [ either text [ size/x: 1000 state: size-text self size/x: either state [state/x + font/offset/x][50] state: none ][size/x: 50] ] effect: join [extend] either effect [effect][make block! 10] ;-- In the absence of a 'wash effect (Rebug #366), this does it manually if all [colors colors/2 image? look/default image? look/down][ look/default: wash look/default colors/1 look/down: wash look/down colors/2 ] if all [color not colors image? look/default image? look/down][ look/default: wash look/default color look/down: wash look/down color ] ;-- End 'wash effect color: none ] ] RBTN: BTN with [ images: reduce [ load imgs/button-default load imgs/button-down load imgs/button-halo ] init: [ if size/x = -1 [ either text [ size/x: 1000 state: size-text self size/x: either state [state/x + font/offset/x] [50] state: none ] [ size/x: 50 ] ] if font/colors [font/color: first font/colors] if not images [ images: reduce [btn-up.png btn-dn.png] ] if images [image: images/1] if colors [color: colors/1] ;-- In the absence of a 'wash effect (Rebug #366), this does it manually if all [colors images colors/2 images/2][ change images wash images/1 colors/1 change next images wash images/2 colors/2 ] if all [color not colors images/2][ change images wash first images color change next images wash second images color ] ;-- End 'wash effect if not effect [effect: [extend]] color: none ] ] ] ;--- Test --- view center-face layout [ origin 0 space 0 panel [ origin 10 space 10 backdrop saltire effect 'fit rbtn "View" 100 51.68.102 pekr "Pekr" 100 51.68.102 ] panel [ origin 10 space 10 backdrop misc effect 'fit rbtn "View" 100 51.85.36 pekr "Pekr" 100 51.87.36 ] return panel [ origin 10x28 space 20 backdrop tartan effect 'tile rbtn "View" 140x36 36.68.17 pekr "Pekr" 140x36 36.68.17 ] across return guide panel [ origin 10 space 10 backdrop metal effect [tile-view luma -20] rbtn "View" 120 gray - 70 pekr "Pekr" 120 gray - 70 ] panel [ origin 10 space 10 backdrop metal effect 'tile-view rbtn "View" 120 gray pekr "Pekr" 120 gray return ] ]