This is a slightly modified application of the function with gradient and
colour blocks for easy switching.
REBOL [
Title: "Custom Gradients"
Author: "James Marsden"
Version: 0.1.1
Date: 27-Mar-2002
Comment: {
this release allows you to perform standard X / Y gradient fills
similar to the gradient tools in photoshop / gimp / paintshop pro
'n' degree free gradients will have to wait for a new view release
due to constraints on rotate
}
]
multigrad: func [colours [block!] Pc [block!] LxL [pair!] Sz [pair!] /local
l c][
if (length? colours) = (length? Pc) [
l: join "layout [ origin 0x0 space 0x0 " either LxL/x <> 0 ["across
^/"]["below ^/"]
for c 1 (length? colours) - 1 1 [
either LxL/x <> 0 [
l: join l ["box " to-integer ((pick Pc c + 1) - (pick Pc c))
* (Sz/x / 100) "x" Sz/y]
][
l: join l ["box " Sz/x "x" to-integer ((pick Pc c + 1) -
(pick Pc c)) * (Sz/y / 100)]
]
l: join l [" effect [gradient " LxL " " (pick colours c) " "
(pick colours c + 1) "]^/" ]
]
do l: join l "]"
]
]
mycol: [
[135.0.0 255.0.0 255.133.64 255.255.0]
[255.0.0 255.64.0 255.128.0 255.196.0 255.255.0 196.255.0]
[196.255.0 128.255.0 64.255.0 0.255.0 0.255.64 0.255.128]
[0.255.128 0.255.196 0.255.255 0.196.255 0.128.255 0.64.255]
[0.64.255 0.0.255 64.0.255 128.0.255 196.0.255 255.0.255]
[255.0.196 255.0.128 255.0.64 255.0.0 255.64.0 255.128.0]
]
mygrad: [
[0 32 66 100]
[0 20 40 60 80 100]
]
; show the screen
view desktop: layout/size/offset [
backcolor black
at 0x0 image to-image (multigrad mycol/1 mygrad/1 1x0
system/view/screen-face/size * 1x0 + 0x20) edge [size: 1x1 color: black]
"Custom Gradients - Click to close" [unview desktop]
image to-image multigrad mycol/2 mygrad/2 1x0 400x10
image to-image multigrad mycol/3 mygrad/2 1x0 400x10
image to-image multigrad mycol/4 mygrad/2 1x0 400x10
image to-image multigrad mycol/5 mygrad/2 1x0 400x10
image to-image multigrad mycol/6 mygrad/2 1x0 400x10
] system/view/screen-face/size 0x0
Regards,
James.
--
To unsubscribe from this list, please send an email to
[EMAIL PROTECTED] with "unsubscribe" in the
subject, without the quotes.
