Hi!
I just finished two new styles for VID. The first one is a
scroller, which is a generalization of the "slider" style found in
VID. The second one is a replacement for VID's slider.
The SLIDER style is almost backward compatible with VID's slider;
only a minor change to your layouts should be needed if you add these
styles to them: the current value of the slider is SLIDER/CURRENT
instead of SLIDER/DATA.
Its behaviour is different from that of VID's slider,
hopefully better; the look is the same anyway.
This style offers more functionality wrt VID's. It is possible
to set the minimum as well as the maximum value for the slider.
Examples:
...
do %scroller-styles.r
...
view layout [
styles scrollers
...
slider ; as for VID's (from 1 to size)
slider 310 ; range from 1 to 310
slider minimum 5 maximum 20 ; range from 5 to 20
...
]
...
(SLIDER is implemented as a special case of SCROLLER, so it has
all of its features; the difference between the two is only in
default values.)
The SCROLLER style is very similar to the one found in my previous
script CID-Utils.r. It is designed to be used to scroll areas.
Other than the obvious minimum and maximum value parameters, it
has a VISIBLE parameter that is used to specify how much of the
area is visible.
So, VISIBLE is the size of the visible area; MINIMUM is the
value the scroller should have when the top of the area is
visible; MAXIMUM is the value the scroller should have when the
bottom of the area is visible.
By default, the scroller comes with two arrows. It is possible
to choose their position; by default they are as I like them, on
both sides of the scroller. (I know some of you DON'T like them
this way, but I repeat that this is just the default.) Pressing an
arrow will increase/decrease the scroller's value by 5 (this can
be changed too).
Some examples:
...
do %scroller-styles.r
...
view layout [
styles scrollers
...
scroller ; just a vertical scroller with arrows, going from 0
; to 150, visible 50
scroller minimum 10 maximum 100 visible 30 ; you can guess
scroller options [without arrows] ; no arrows
scroller options [with arrows together] ; both arrows on the
; same side
scroller options [with arrows skipping 10]
; pressing an arrow will skip 10
...
]
...
For those of you who like having the arrows together, I'd suggest
defining your own style:
...
styles scrollers
style my-scroller scroller options [with arrows together]
...
my-scroller ...
...
Ok, enough for now. I hope to put up a REB site soon with
documentation ad examples.
See ya,
Gabriele.
--
Gabriele Santilli <[EMAIL PROTECTED]> - Amigan - REBOL programmer
Amiga Group Italia sez. L'Aquila -- http://www.amyresource.it/AGI/
REBOL [
Title: "Scroller and slider styles for VID"
Author: "Gabriele Santilli"
File: %scroller-styles.r
Date: 13-Jun-2000
Version: 1.3.0 ; majorv.minorv.status
; status: 0: alpha; 1: beta; 2: gamma
History: [
11-Jun-2000 1.1.0 "First version"
13-Jun-2000 1.2.0 "Finished writing it, now going to test it..."
13-Jun-2000 1.3.0 "(Hopefully) fixed all noticed bugs"
]
]
scroller-feels: make object! [
knob-feel: make face/feel [
engage: func [
face action event
] [
if zero? face/knob-span [exit]
if action = 'down [face/mouse-start: event/offset exit]
if find [over away] action [
face/offset: min max face/zero-offset face/offset +
((event/offset - face/mouse-start) * face/way) face/max-offset
do face/action
show face
]
]
]
arrow-feel: make face/feel [
engage: func [
face action event
] [
switch action [
time [
if face/clicked [
either face/delay = 0 [do face/action] [face/delay: face/delay
- 1]
]
]
down [
face/clicked: yes
face/edge/effect: 'ibevel
face/rate: 15
face/delay: 3
show face
do face/action
]
up [
if face/clicked [
face/rate: none
face/clicked: no
face/edge/effect: 'bevel
show face
]
]
over [
if not face/clicked [
face/clicked: yes
face/edge/effect: 'ibevel
face/rate: 15
face/delay: 0
show face
]
]
away [
if face/clicked [
face/clicked: no
face/edge/effect: 'bevel
face/rate: none
show face
]
]
]
]
]
slider-feel: make face/feel [
engage: func [
face action event
/local ofst scroller
] [
if action = 'down [
scroller: face/parent-face
either ((event/offset + face/offset) * scroller/way) <
(scroller/knob/offset * scroller/way) [
sc-set-current/do-action scroller
scroller/current - scroller/visible
] [
sc-set-current/do-action scroller
scroller/current + scroller/visible
]
]
]
]
]
scrollers: stylize [
scroller face [
color: image: effect: none
edge: [color: image: effect: none]
size: 17x200
area-size:
vis-ratio:
space:
invisible:
way: none
minimum: 0
maximum: 100
visible: 50
current: 0
pane: [slider knob arrow-up arrow-down]
slider:
arrow-up: arrow-down: none
knob: make face [
max-offset:
zero-offset:
way:
boundaries:
knob-span:
mouse-start: none
edge: make edge [size: 1x1 color: 128.128.128 effect: 'bevel]
feel: scroller-feels/knob-feel
action: none
]
with-arrows?: yes
arrows-together?: no
arrow-skip: 5
words: compose [
minimum maximum visible (func [new args] [
if integer? second args [set in new first args second
args]
next args
])
options (func [new args /local val] [
if not block? second args [next args]
parse second args [
any [
'without 'arrows (new/with-arrows?: no)
| 'with 'arrows (new/with-arrows?: yes)
opt ['together (new/arrows-together?:
yes)]
opt [
'skipping args: (
set [val args] do/next args
if integer? :val [new/arrow-skip: val]
)
:args
]
| 'horizontal (new/way: 1x0)
| 'vertical (new/way: 0x1)
]
]
next args
])
]
init: [
if not way [way: pick [1x0 0x1] size/x > size/y]
if not maximum [maximum: any [data pick size way = 1x0]]
slider: make face [
color: 100.100.100
image: effect: none
edge: make edge [color: 128.128.128 effect: 'ibevel]
feel: scroller-feels/slider-feel
]
slider/size: size
if with-arrows? [
arrow-up: make get-style 'arrow [clicked: no delay: 5]
arrow-down: make arrow-up []
arrow-up/data: select [1x0 left 0x1 up] way
do arrow-up/init
arrow-down/data: select [1x0 right 0x1 down] way
do arrow-down/init
arrow-up/size: size * reverse way
arrow-up/size: arrow-up/size + reverse arrow-up/size
arrow-down/size: arrow-up/size
slider/size: slider/size - (arrow-up/size * 2 * way)
slider/offset: either arrows-together? [0x0]
[arrow-up/size * way]
arrow-down/feel: arrow-up/feel:
scroller-feels/arrow-feel
arrow-up/action: [sc-set-current/do-action self
current - arrow-skip]
arrow-down/action: [sc-set-current/do-action self
current + arrow-skip]
arrow-up/offset: either arrows-together? [way *
slider/size] [0x0]
arrow-down/offset: way * (slider/size + arrow-up/size)
]
space: (slider/size - (slider/edge/size * 2)) * way
space: space/x + space/y
knob: make knob []
knob/way: way
knob/zero-offset: slider/offset + slider/edge/size
knob/action: [
data: (invisible * (knob/offset - knob/zero-offset)) /
knob/knob-span
sc-set-current/do-action/don't-update self minimum +
data/x + data/y
]
sc-set-parameters self minimum maximum visible
]
]
slider scroller [
minimum: 1
maximum: none
visible: 1
with-arrows?: no
]
]
sc-set-parameters: func [
"Set scroller parameters"
face [object!] "Scroller face"
minval [integer!] "Minimum value"
maxval [integer!] "Maximum value"
visible-area [integer!] "Size of the visible area"
] [
do bind [
minimum: minval
maximum: maxval
invisible: maximum - minimum
current: minimum
visible: visible-area
area-size: visible + invisible
vis-ratio: visible / area-size
knob/offset: knob/zero-offset
knob/size: size * reverse way
knob/size: knob/size + reverse knob/size
knob/size: max knob/size (way * to-integer vis-ratio * space) + (size
* reverse way)
knob/size: knob/size - (slider/edge/size * 2)
knob/max-offset: (knob/zero-offset + (space * way)) - (knob/size * way)
knob/knob-span: (knob/max-offset - knob/zero-offset) * way
knob/knob-span: knob/knob-span/x + knob/knob-span/y
] in face 'self
]
sc-set-current: func [
"Set a scroller's current value"
face [object!] "Scroller face"
value [integer!]
/don't-update "Do not update knob position"
/do-action "Do user specified action"
] [
value: max min value face/maximum face/minimum
if value <> face/current [
face/current: value
if all [not don't-update not zero? face/knob/knob-span] bind [
knob/offset: knob/zero-offset + ((way * (value - minimum) *
knob/knob-span) / invisible)
show knob
] in face 'self
if do-action [do face/action]
]
]
