|
|
|
Form Designer - Source CodeDesign and run simple forms with a WYSIWYG editor. |
|
REBOL [
Title: "RebForms"
Author: "Ashley Truter <ashley@dobeash.com>"
Purpose: "REBOL/View Form Designer."
Date: 26-Mar-2004
Version: 1.0
Copyright: "©2004 Dobeash Investments Pty Ltd"
Licence: "Free for both commercial and non-commercial use."
]
; ----------------------------------------
; VID Patches
; ----------------------------------------
; colour of text-list/picked
; http://www.rebol.org/cgi-bin/cgiwrap/rebol/ml-display-thread.r?m=rmlNJXK
svvc/field-select: sky
; [view] changing window title. -- vid 1.3 --
; http://www.rebol.org/cgi-bin/cgiwrap/rebol/ml-display-thread.r?m=rmlQGLQ
set-title: func [
"Sets title bar of window"
face [object!] "Window dialog face"
title [string!] "Window bar title"
][
face/text: title
face/changes: 'text
show face
]
; Area bug?
; http://www.rebol.org/cgi-bin/cgiwrap/rebol/ml-display-thread.r?m=rmlMZJJ
stylize/master [
area: area wrap with [insert tail init [para: make para []]]
field: field middle with [insert tail init [para: make para []]]
info: info middle with [feel: none]
label: label middle with [feel: none]
text: text middle with [feel: none]
]
; simple dialog wrapper for view, center-face, layout
dialog: function [
"Displays a window face with a pane built from style description dialect."
title [string!] "Window bar title"
specs [block!] "Dialect block of styles, attributes, and layouts"
][
face
][
either empty? system/view/screen-face/pane [
view/new/title center-face layout specs title
][
face: last system/view/screen-face/pane
view/new/title/options/offset layout specs title compose [
parent (first system/view/screen-face/pane)
] face/offset + 0x28
]
]
; ----------------------------------------
; Styles
; ----------------------------------------
svsf: system/view/screen-face
to-width: func [x [integer!]] [
GUI/element/x + GUI/spacing/x * x - GUI/spacing/x
]
to-size: func [size [pair!]] [
as-pair GUI/element/x + GUI/spacing/x * size/x - GUI/spacing/x GUI/element/y + GUI/spacing/y * size/y - GUI/spacing/y
]
stylize/master [
field: field edge [size: 1x1 color: black effect: none] [trim face/text show face]
label: label black font [shadow: none]
title: txt font [valign: 'middle align: 'center]
check: face with [
size: 24x24
color: white
font: [name: "Wingdings" align: 'center valign: 'bottom style: 'bold shadow: none colors: reduce [leaf leaf]]
image: effects: para: none
edge: [size: 1x1 color: black effect: none]
feel: make svvf/toggle [
redraw: func [face act pos] [
face/text: either face/state [face/texts/2] [face/texts/1]
]
]
flags: [toggle]
init: [
edge: make edge []
font: make font []
font/size: to integer! size/y * .75
font/color: first font/colors
texts: copy ["" "ü"]
]
]
; file: %dropdown.r
; date: 20-Feb-2004
; title: "VID Dropdown"
; author: "Ammon Johnson"
drop-down: face with [
size: 100x24
color: white
get-selected: lay-options: options: unview-options: none
words: [
data [new/data: first next args next args]
]
resize: func [new /arrow arr-size] [
size: new
if arrow [pane/2/size/x: arr-size]
pane/1/size: new - as-pair pane/2/size/x 0
pane/2/size/y: new/y
pane/2/offset: new - pane/2/size
options/size/x: size/x
options/sub-area/size/x: pane/1/size/x
options/sld/size/x: pane/2/size/x + pane/2/edge/size/x
options/sld/offset/x: pane/1/size/x
lay-options/size/x: size/x
options/data: data ; to work with VID 1.3
]
init: [
lay-options: layout [
origin 0x0
options: text-list #"^(ESC)" (size + 0x150 )[
if not empty? options/picked [
pane/1/text: copy first options/picked ; added ESC and copy
]
show pane/1
unview/only lay-options
remove-event-func :unview-options
action pane/1 pane/1/text
]
]
lay-options/options: reduce ['no-border 'no-title 'parent self]
unview-options: func [f "face" e "event"] [
if all [e/type = 'inactive e/face = lay-options] [
unview/only lay-options
remove-event-func :unview-options
]
e
]
get-selected: does[
options/lines: data
options/update
lay-options/offset: (screen-offset? pane/1) + as-pair 0 size/y
insert-event-func :unview-options
view/new lay-options
]
pane: reduce [
; added color support
make-face/spec 'field compose/deep [
color: (color)
colors: [(color) (color)]
edge: none
]
make-face/spec 'arrow [
size: 16x16
data: 'down
action: [get-selected]
]
]
if text [pane/1/text: text]
if none? data [data: texts]
if none? data [data: copy []]
; if not found? find data text [insert data text text: none]
resize size
]
]
]
set-styles: does [
; Element sizes
stylize/master [
; Standard
btn: btn to-size 1x1 font-size to-integer GUI/fontsize
sbtn: btn GUI/element / 2x1 font-size to-integer GUI/fontsize
bar: bar to-width 1
field: field to-size 1x1 font-size GUI/fontsize GUI/Backcolor GUI/Backcolor
info: info to-size 1x1 font-size GUI/fontsize
label: label to-size 1x1 font-size GUI/fontsize
text: text to-size 1x1 font-size GUI/fontsize
title: title to-size 1x1 font-size GUI/fontsize navy pewter bold
tog: tog to-size 1x1 font-size to-integer GUI/fontsize
stog: tog GUI/element / 2x1 font-size to-integer GUI/fontsize
; Base action buttons
btn-yes: btn "Yes"
btn-no: btn "No" [unview/only face/parent-face/self]
btn-ok: btn "OK"
btn-cancel: btn "Cancel" [unview/only face/parent-face/self]
btn-close: btn "Close" [unview/only face/parent-face/self]
btn-exit: btn "Exit" [quit]
; Special
area: area to-size 2x2 font-size GUI/fontsize GUI/Backcolor GUI/Backcolor
check-line: check-line to-size 1x1
radio-line: radio-line to-size 1x1
check: check as-pair GUI/element/y GUI/element/y
radio: radio as-pair GUI/element/y GUI/element/y
txt: txt font-size GUI/fontsize
]
]
GUI: context [
backcolor: white
fontsize: none
element: none
spacing: 8x8
margin: 20x20
imagesize: none
x1: x2: x3: x4: x5: x6: x7: x8: none
get-text-size: has [t][
layout [t: txt font-size fontsize "MMMMMMMM"]
size-text t
]
set-fontsize: func [size [integer!]][
if size <> fontsize [
if odd? size [size: size - 1]
fontsize: max 12 min size 36
; Set element size to an even pair
element: 8x4 + get-text-size
element/y: to-integer element/y * 1.2 ; 20% vertical margin
element/y: max element/y 22 ; minimum y of 22 (btn bitmap height)
if odd? element/x [element/x: element/x + 1]
if odd? element/y [element/y: element/y + 1]
; set rest
spacing: as-pair fontsize / 2 fontsize / 2
margin: as-pair fontsize fontsize
x1: to-size 1x1
x2: to-size 2x1
x3: to-size 3x1
x4: to-size 4x1
x5: to-size 5x1
x6: to-size 6x1
x7: to-size 7x1
x8: to-size 8x1
set-styles
]
]
]
GUI/set-fontsize 12 ;to integer! svsf/size/x / 64
; ----------------------------------------
; Main Program Code
; ----------------------------------------
designer: context [
main-out: none
; align
radio-align: 'lm
; cell size
cell-size: 16x16
; pointer to current object
nub-obj: none
; active object
nub-face: make face [
offset: 0x0 size: 0x0
edge: make edge [color: 255.0.0 effect: 'nubs size: 4x4]
text: color: font: para: data: none
feel: make feel [
engage: func [f a e] [
if all [empty? p/move-list data][data/feel/engage data a e]
]
]
]
; update after move / resize
update-nubs: func [f] [
nub-face/offset: f/offset ; - 3x3
nub-face/size: f/size ;+ 6x6
]
; default feel for designer objects
nub-feel: [
engage: func [f a e][
if find [over away] a [
either f/data [
f/offset: f/offset + e/offset - f/data
f/offset: min max 0x0 f/offset / cell-size * cell-size cell-size * 23x31
f/offset: confine f/offset f/size 0x0 cell-size * 24x32
][
f/size: (cell-size / 2) + e/offset / cell-size * cell-size
if f/size/x < cell-size/x [f/size/x: cell-size/x]
if f/size/y < cell-size/y [f/size/y: cell-size/y]
if (f/offset/x + f/size/x) > (cell-size/x * 24) [f/size/x: (cell-size/x * 24) - f/offset/x]
if (f/offset/y + f/size/y) > (cell-size/y * 32) [f/size/y: (cell-size/y * 32) - f/offset/y]
]
update-nubs f
show [f nub-face]
]
if find [down alt-down] a [
nub-obj: f
f/data: e/offset - (cell-size / 2)
update-nubs f
nub-face/data: f
show f/parent-face
; set properties
cell-type/text: form f/var
cell-name/text: form f/text
cell-link/text: form f/text
cell-edge/data: either zero? f/edge/size [false][true]
cell-color/data: either f/color = silver [true][false]
hide b
switch/default f/var [
Field [
hide [cell-name cell-edge cell-color lt ct rt lm cm rm lb cb rb]
show [cell-type cell-link cell-edge cell-color]
]
Check [
hide [cell-link cell-name cell-edge cell-color lt ct rt lm cm rm lb cb rb]
show cell-type
]
Diagram [
hide [cell-name cell-edge cell-color lt ct rt lm cm rm lb cb rb]
show [cell-type cell-link]
]
][
; hide previous radio selection
designer/:radio-align/data: false
; show current radio selection
radio-align: to-word join first form f/font/align first form f/font/valign
designer/:radio-align/data: true
; Heading / Label
hide cell-link
show [cell-type cell-name cell-edge cell-color lt ct rt lm cm rm lb cb rb]
]
; don't allow resize on check / diagram
if all [a = 'alt-down not find [Check Diagram] f/var][f/data: none]
]
]
]
get-offset: has [offset][
offset: negate cell-size/y
foreach obj next p/pane [
offset: max offset obj/offset/y
]
offset: min offset 30 * cell-size/y
as-pair 0 (offset + cell-size/y) / cell-size/y
]
make-heading: func [/load blk [block!]][
if not load [
blk: copy []
insert blk reduce [
get-offset
4x1
"Heading"
silver
0x0
'left
'middle
]
]
make face [
offset: blk/1 * cell-size
size: blk/2 * cell-size
text: blk/3
color: blk/4
edge: make edge [size: blk/5 color: black]
font: make font [align: blk/6 valign: blk/7 size: cell-size/x - 4 style: 'bold]
para: none
feel: make feel nub-feel
var: 'Heading
]
]
make-label: func [/load blk [block!]][
if not load [
blk: copy []
insert blk reduce [
get-offset
3x1
"Label"
white
1x1
'left
'middle
]
]
make face [
offset: blk/1 * cell-size
size: blk/2 * cell-size
text: blk/3
color: blk/4
edge: make edge [size: blk/5 color: black]
font: make font [align: blk/6 valign: blk/7 size: cell-size/x - 6]
para: none
feel: make feel nub-feel
var: 'Label
]
]
make-field: func [/load blk [block!]][
if not load [
blk: copy []
insert blk reduce [
get-offset
3x1
""
white
1x1
'center
'middle
]
]
make face [
offset: blk/1 * cell-size
size: blk/2 * cell-size
text: blk/3
color: blk/4
edge: make edge [size: blk/5 color: black]
font: make font [align: blk/6 valign: blk/7 size: 10 color: blue style: 'underline]
para: none
feel: make feel nub-feel
var: 'Field
]
]
make-check: func [/load blk [block!]][
if not load [
blk: copy []
insert blk reduce [
get-offset
1x1
"ü"
white
1x1
'center
'bottom
]
]
make face [
offset: blk/1 * cell-size
size: blk/2 * cell-size
text: blk/3
color: blk/4
edge: make edge [size: blk/5 color: black]
font: make font [align: blk/6 valign: blk/7 size: cell-size/x - 4 color: leaf name: "Wingdings" style: 'bold]
para: none
feel: make feel nub-feel
var: 'Check
]
]
make-diagram: func [/load blk [block!]][
if not load [
blk: copy []
insert blk reduce [
get-offset
2x1
""
white
0x0
'center
'middle
]
]
make face [
offset: blk/1 * cell-size
size: blk/2 * cell-size
text: blk/3
color: blk/4
edge: make edge [size: blk/5 color: black]
font: make font [align: blk/6 valign: blk/7 size: 10 color: blue style: 'underline]
para: none
feel: make feel nub-feel
var: 'Diagram
image: btn-up.png
effect: compose [extend 22 colorize 255.205.40]
]
]
lt: ct: rt: lm: cm: rm: lb: cb: rb: none
b: p: cell-type: cell-name: cell-link: cell-color: cell-edge: none
hide-nub: does [
nub-face/offset: nub-face/size: 0x0
show [b p]
]
show-request-file: function [type [string!]][file][
if file: switch type [
"Open" [request-file/title/filter/keep/only "Open Form" "" "*.frm"]
"New" [request-file/title/filter/keep/only/file "New Form" "" "*.frm" "new.frm"]
"Save" [request-file/title/filter/keep/only/file/save "Save Form" "" "*.frm" "new.frm"]
][
if %.frm <> suffix? file [file: join file %.frm]
set-title main-out rejoin ["Designer [" to-local-file file "]"]
]
file
]
run-form: function [file][to-size page type offset size text color edge align valign][
page: copy [origin 16 space 0 backcolor white]
to-size: func [size][
8x8 + cell-size * size - 4x4
]
foreach blk load/all file [
set [type offset size text color edge align valign] blk
insert tail page compose [at (8x8 + cell-size * offset + 16x16)]
insert tail page switch type [
Heading [compose/deep [label (to-size size) (text) black (color) (align) (valign) edge [size: (edge) color: black]]]
Label [compose/deep [text (to-size size) (text) black (color) (align) (valign) edge [size: (edge) color: black]]]
Field [
either size/y > 1 [
compose/deep [area (to-size size) (color) (color) edge [size: (edge) color: black]]
][
either empty? text [
compose/deep [field (to-size size) (color) (color) edge [size: (edge) color: black]]
][
compose/deep [drop-down (to-size size) (color) edge [size: (edge) color: black effect: none] data [(read/lines to-file text)]]
]
]
]
Check ['check]
Diagram [
either empty? text [
compose [btn (to-size size) "-"]
][
compose/deep [
btn (to-size size) (text) [dialog (text) [origin 0 space 0 image (to-file text)]]
]
]
]
]
]
dialog "Run" page
]
show-form: has [col row here file blk save-btn][
file: none
main-out: dialog "Designer" [
across origin 8x8
; actions
sbtn "New" [
if file: show-request-file face/text [
insert clear p/pane nub-face
hide-nub
]
]
sbtn "Open" [
file: show-request-file face/text
if all [file exists? file][
insert clear p/pane nub-face
; back tail ensures nub-face is last (on top)
; next blk ensures var is not passed
foreach blk load/all file [
switch first blk [
Heading [insert back tail p/pane make-heading/load next blk]
Label [insert back tail p/pane make-label/load next blk]
Field [insert back tail p/pane make-field/load next blk]
Check [insert back tail p/pane make-check/load next blk]
Diagram [insert back tail p/pane make-diagram/load next blk]
]
]
hide-nub
]
]
col: at save-btn: sbtn "Save" [
if (length? p/pane) = 1 [
alert rejoin ["Nothing to " lowercase face/text "."]
return
]
if all [not file not file: show-request-file face/text][
alert "Form not saved."
return
]
blk: copy []
; skip first object (nub)
foreach obj p/pane [
; type
; offset
; size
; text
; color
; edge
; align
; valign
if obj/text [
insert/only tail blk reduce [
obj/var
obj/offset / cell-size
obj/size / cell-size
obj/text
obj/color
obj/edge/size
obj/font/align
obj/font/valign
]
]
]
; can't use save as lines indent
write file trim/lines mold/only blk
]
sbtn "Undo" [
if (length? p/pane) > 1 [
remove back back tail p/pane
hide-nub
]
]
sbtn "Run" [
save-btn/action face 0
if all [(length? p/pane) > 1 file exists? file][
run-form file
]
]
sbtn "Help" [
dialog "Help" [
image svv/image-stock/help
label GUI/x6 "Introduction"
txt to-width 6 "This script, extracted from a larger commercial application, allows you to create, save and run simple forms without actually doing anything with the data."
label GUI/x6 "Placing / sizing form elements"
txt to-width 6 "Clicking a sky colored button will place the corresponding element on the form. Move the element by left-mouse dragging it, or resize by right-mouse drag."
label GUI/x6 "Moving a group of elements"
txt to-width 6 "Right-mouse drag on the grid to select a number of elements to group. Left-mouse drag outside the grouped elements to move them."
label GUI/x6 "Element properties"
txt to-width 6 "Clicking a form element displays its modifiable properties to the left of the main grid. The top label indicates the type of element, while a field below this (for Heading / Label elements) allows the element text to be changed. Field / Image elements have a button instead that allows you to assign a list of values (for a Field) or an image (for an Image)."
label GUI/x6 "Running your form"
txt to-width 6 "Clicking 'Run' will run your form, allowing you to enter data into fields and enabling a pick-list if a list of values was specified. Clicking a check box will toggle its state, while clicking a diagram will display the associated image, if any."
txt ""
txt to-width 6 "©2004 Dobeash Investments Pty Ltd"
bar to-width 6
btn-close
]
]
sbtn sky "Head" [insert back tail p/pane make-heading show p]
sbtn sky "Label" [insert back tail p/pane make-label show p]
sbtn sky "Field" [insert back tail p/pane make-field show p]
sbtn sky "Check" [insert back tail p/pane make-check show p]
sbtn sky "Image" [insert back tail p/pane make-diagram show p]
below
; properties
row: at cell-type: text "Heading" bold
bar
here: at cell-name: field [
nub-obj/text: copy face/text
show nub-obj
]
at here cell-link: btn white [
if face/data: either nub-obj/var = 'Field [
request-file/title/filter/keep/only "Text List" "" "*.txt"
][
request-file/title/filter/keep/only "Image File" "" ["*.png" "*.jpg" "*.bmp" "*.gif"]
][
face/text: form last split-path face/data
nub-obj/text: copy face/text
show nub-obj
]
]
cell-edge: check-line "Border" [
nub-obj/edge/size: either zero? nub-obj/edge/size [1x1][0x0]
show nub-obj
]
cell-color: check-line "Fill" [
nub-obj/color: either nub-obj/color = white [silver][white]
show nub-obj
]
bar
across
space 0x0
pad 12
lt: radio [radio-align: face/var nub-obj/font/align: 'left nub-obj/font/valign: 'top show nub-obj]
ct: radio [radio-align: face/var nub-obj/font/align: 'center nub-obj/font/valign: 'top show nub-obj]
rt: radio [radio-align: face/var nub-obj/font/align: 'right nub-obj/font/valign: 'top show nub-obj]
return
pad 12
lm: radio [radio-align: face/var nub-obj/font/align: 'left nub-obj/font/valign: 'middle show nub-obj]
cm: radio [radio-align: face/var nub-obj/font/align: 'center nub-obj/font/valign: 'middle show nub-obj]
rm: radio [radio-align: face/var nub-obj/font/align: 'right nub-obj/font/valign: 'middle show nub-obj]
return
pad 12
lb: radio [radio-align: face/var nub-obj/font/align: 'left nub-obj/font/valign: 'bottom show nub-obj]
cb: radio [radio-align: face/var nub-obj/font/align: 'center nub-obj/font/valign: 'bottom show nub-obj]
rb: radio [radio-align: face/var nub-obj/font/align: 'right nub-obj/font/valign: 'bottom show nub-obj]
; quick hide
at row b: box svv/vid-face/color to-size 1x8
; page
at as-pair first col second row
image as-pair cell-size/y * 2 cell-size/y * 34 + 1 make image! layout [
backdrop effect [gradient 1x0 20.20.20 250.240.230 luma 60]
]
; main form design grid with rubber-band feel
p: box edge [size: cell-size color: white] cell-size * 26x34 + 1x1 white effect compose [grid (cell-size) (cell-size) (sky)] with [
move-list: copy []
old-offset: none
event-offset: none
pane: copy []
feel: make feel [
engage: func [f a e][
if find [over away] a [
event-offset: (e/offset + (cell-size / 2)) / cell-size * cell-size
either empty? move-list [
nub-face/size: max cell-size absolute event-offset - nub-face/data
nub-face/offset: min nub-face/data event-offset
][
old-offset: nub-face/offset
nub-face/offset: nub-face/offset + event-offset - nub-face/data
nub-face/offset: confine nub-face/offset nub-face/size 0x0 cell-size * 24x32
; skip rubber-band
foreach pos move-list [
pane/:pos/offset: pane/:pos/offset + nub-face/offset - old-offset
]
nub-face/data: event-offset
]
show p
]
if a = 'alt-down [
clear move-list
nub-face/offset: nub-face/data: e/offset / cell-size * cell-size
nub-face/size: cell-size
show p
]
if a = 'down [
nub-face/data: e/offset / cell-size * cell-size
if empty? move-list [nub-face/offset: nub-face/data]
show p
]
if a = 'alt-up [
clear move-list
repeat pos (length? p/pane) - 1 [
if all [
inside? nub-face/offset + nub-face/size pane/:pos/offset
inside? nub-face/offset + nub-face/size + 1x1 pane/:pos/offset + pane/:pos/size
inside? pane/:pos/offset + 1x1 nub-face/offset
][insert tail move-list pos]
]
if empty? move-list [hide-nub]
]
if a = 'up [clear move-list hide-nub]
]
]
]
do [insert p/pane nub-face]
]
]
]
designer/show-form
do-events
quit |
