[REBOL] Re: resizing a layout
From: pa:russo:perd at: 28-Apr-2001 10:57
>How does one make a layout resizeable, or add scroll bars?
>
>I see that the Rebol view desktop can do this ...
>
>--
>Graham Chiu
>--
>To unsubscribe from this list, please send an email to
>[rebol-request--rebol--com] with "unsubscribe" in the
>subject, without the quotes.
I think this still-in-alpha script could help you. I started from
Carl's conference.r. This script will not run because I can't send
you its archive and I have no time to clean it, but you can
back-engineer the resizing algorithm quite easily. Fix your attention
on functions "resize", "make-scroll-pane" and "scroll-msg". Remember
this is an alpha version: it works, nothing more.
HTH
--
Paolo Russo
REBOL [
Title: "G.A.I.A."
Author: "Paolo Russo"
Version: 0.0.13
Date: 15-Apr-2001
Project: 'SUAP
Type: 'plug-in
History: [
"Paolo" 0.0.0 15-Apr-2001 "Start"
"Paolo" 0.0.1 15-Apr-2001 "First static layout;
scrolling added"
"Paolo" 0.0.2 15-Apr-2001 "Loads data; prev-next
navigation added"
"Paolo" 0.0.3 19-Apr-2001 "scrolling engine revisited"
"Paolo" 0.0.4 20-Apr-2001 "basic resizing added"
"Paolo" 0.0.5 21-Apr-2001 "multiple layout management added"
"Paolo" 0.0.6 21-Apr-2001 "First graphic revision. Drag added."
"Paolo" 0.0.7 21-Apr-2001 "Choice management revised"
"Paolo" 0.0.8 21-Apr-2001 "Main graphic revision"
"Paolo" 0.0.9 21-Apr-2001 "delete-card function added"
"Paolo" 0.0.10 21-Apr-2001 "bureaus'list reading added"
"Paolo" 0.0.11 21-Apr-2001 "code display modified"
"Paolo" 0.0.12 21-Apr-2001 "generate-id function added"
"Paolo" 0.0.13 21-Apr-2001 "working on new-card function"
]
Purpose: {Manage the database of SUAP's cards about hearings.}
things-to-fix: [
{Event management has to become plug-in independent. }
{Graphics}
{Security settings}
]
]
gaia: context [
;Inizializza suap-styles. Probabilmente da rimuovere dopo la
trasformazione in plug-in.
do %suap-styles.r
title-line: reform ["Gestione Archivio Iter Atti - alpha "
system/script/header/version]
ws-box: ws-slider: current-layout: none
cards: []
; ================================
; === LAYOUTS
; ================================
gaia-layout: layout [
styles suap-styles
backdrop mint
origin 0x0 space 0 across
gaia-logo: image %gaia/uncem24x.gif
gaia-title: text 352x24 bold white mint middle title-line with [
feel: make feel [
engage: func [f a e] [ ;intercepts target face events
if find [over away] a [
gaia-layout/offset: confine
gaia-layout/offset + e/offset - gaia-layout/data gaia-layout/size 0x0
either none? gaia-layout/parent-face
[system/view/screen-face/size][gaia-layout/parent-face/size]
show gaia-layout
]
if a = 'down [ gaia-layout/data: e/offset]
]
]
]
prev-arrow: arrow 24x24 snow mint left [previous-card]
mode-choice: choice 120x24 orange mint "Visualizza"
------------------
"Aggiungi scheda" "Elimina scheda"
------------------
"Chiudi" [
switch index? mode-choice/data [
1 [set-view-card-mode]
3 [set-new-card-mode]
4 [delete-card]
6 [close-gaia]
]
]
next-arrow: arrow 24x24 snow mint right [next-card]
return
ws-box: box 620x300 edge [size: 2x2 color: coal]
ws-slider: slider 16x300 [scroll-msg/only value] snow mint
]
readonly-layout: [
styles suap-styles
origin 0x0 across
backdrop %gaia/cadore3.jpg mint
vf-codice: vh4 right 40 (current-card/codice)
vf-descrizione: vh2 wrap left 520 top (current-card/istruttoria) return
tabs (current-field-indent)
logmul-vh3 "Domanda" (current-field-indent +
current-field-width) return
label "tipo" tab vf-tipodomanda: wgmulm12-txt
(current-field-width) (current-card/domanda/modalita-richiesta) return
label "requisiti richiedente" tab
vf-requisitirichiedente: wgmulm12-txt
(current-card/domanda/requisiti-richiedente) (current-field-width)
return
label "documenti da allegare" tab
vf-documenti-da-allegare:
wgmulm12-txt(current-card/domanda/allegati/documenti)(current-field-width)
return
label "ricevute da allegare" tab
vf-ricevute-da-allegare: wgmulm12-txt
(current-card/domanda/allegati/ricevute)(current-field-width) return
label "spese" tab
vf-spese: wgmulm12-txt
(current-card/domanda/spese-richiedente)(current-field-width) return
label "atto finale" tab
vf-attofinale: wgmulm12-txt (current-card/tipologia-atto-finale)
(current-field-width) return
label "Uffici competenti" tab
vf-uffici: wgmulm12-txt as-is (display-enti-istruttori)
(current-field-width) return
logmul-vh3 "Tempistica" (current-field-indent + current-field-width) return
label "iter" tab label "VIA" tab label "no VIA" return
label "proc. semplificato" tab vf-tps-via: info right 45 tab
vf-tps-novia: info right 45 return
label "autocertificazione" tab vf-ta-via: info
(current-card/tempistica/durata-con-via) right 45 tab vf-ta-novia:
info (current-card/tempistica/durata-senza-via) right 45 return
logmul-vh3 "Altre informazioni" (current-field-indent +
current-field-width) return
label "normativa" tab
vf-normativa: wgmulm12-txt
(current-card/info/normativa-di-riferimento) (current-field-width)
return
label "Flusso procedurale" tab
vf-flusso: wgmulm12-txt
(current-card/info/flusso-procedurale)(current-field-width) return
]
new-card-lay: [
styles suap-styles
origin 0x0 across
backdrop %gaia/cadore3.jpg mint
vf-codice: vh4 right 40 (generate-id current-suap-seed)
;(current-card/codice)
vf-descrizione: field wrap left 520 top return;(current-card/istruttoria)
tabs (current-field-indent)
logmul-vh3 "Domanda" (current-field-indent +
current-field-width) return
label "tipo" tab vf-tipodomanda: field wrap
(current-field-width - 8) return
;(current-card/domanda/modalita-richiesta)
label "requisiti richiedente" tab
vf-requisitirichiedente: wgmulm12-txt
(current-card/domanda/requisiti-richiedente) (current-field-width)
return
label "documenti da allegare" tab
vf-documenti-da-allegare:
wgmulm12-txt(current-card/domanda/allegati/documenti)(current-field-width)
return
label "ricevute da allegare" tab
vf-ricevute-da-allegare: wgmulm12-txt
(current-card/domanda/allegati/ricevute)(current-field-width) return
label "spese" tab
vf-spese: wgmulm12-txt
(current-card/domanda/spese-richiedente)(current-field-width) return
label "atto finale" tab
vf-attofinale: wgmulm12-txt (current-card/tipologia-atto-finale)
(current-field-width) return
label "Uffici competenti" tab
vf-uffici: wgmulm12-txt as-is (display-enti-istruttori)
(current-field-width) return
logmul-vh3 "Tempistica" (current-field-indent + current-field-width) return
label "iter" tab label "VIA" tab label "no VIA" return
label "proc. semplificato" tab vf-tps-via: info right 45 tab
vf-tps-novia: info right 45 return
label "autocertificazione" tab vf-ta-via: info
(current-card/tempistica/durata-con-via) right 45 tab vf-ta-novia:
info (current-card/tempistica/durata-senza-via) right 45 return
logmul-vh3 "Altre informazioni" (current-field-indent +
current-field-width) return
label "normativa" tab
vf-normativa: wgmulm12-txt
(current-card/info/normativa-di-riferimento) (current-field-width)
return
label "Flusso procedurale" tab
vf-flusso: wgmulm12-txt
(current-card/info/flusso-procedurale)(current-field-width) return
]
update-layout: [
styles suap-styles
origin 0x0 vh2 "Prova layout update" return
text wrap (current-field-width) (current-card/istruttoria)
]
; ================================
; === FUNCTIONS
; ================================
as-pair: func [x y] [to-pair reduce [x y]]
read-cards: has [raw-data cards][
cards: copy []
if error? try [raw-data: load/markup
%../database/schede-istruttorie.dat ][request/ok "Errore 01: Archivio
schede istruttorie non accessibile." quit]
raw-data: next raw-data
forskip raw-data 2 [append cards first raw-data]
return cards
]
view-card: func [layout-template [block!] /local card-layout][
card-layout: layout/offset layout-template 0x0
return make-scroll-pane card-layout
]
make-scroll-pane: func [layout-to-scroll /local scroll-pane] [
scroll-pane: make-face 'box
scroll-pane/color: either find first scroll-pane 'changes [coal] [none]
scroll-pane/size/x: ws-box/size/x - 4
scroll-pane/size/y: layout-to-scroll/size/y
scroll-pane/offset: 0x0
scroll-pane/pane: layout-to-scroll
return scroll-pane
]
scroll-msg: func [val /only /local m] [
if zero? current-layout/size/y [exit]
m: max 2 current-layout/size/y - ws-box/size/y + 2
current-layout/offset/y: negate min m to-integer val * m
ws-slider/state: none
if only [current-layout/changes: 'offset]
show [current-layout ws-slider]
]
rescroll: does [
ws-slider/redrag ws-slider/size/y / max 1 current-layout/size/y
if ws-slider/data = 1.0 [scroll-msg 1 ws-slider/data: 1.0]
show ws-slider
]
page-msg: func [dir][
ws-slider/data: min 1 max 0 (dir / (max 1
current-layout/size/y) + ws-slider/data)
scroll-msg/only ws-slider/data
]
resize: has [w h] [
w: first gaia-layout/size
h: second gaia-layout/size
next-arrow/offset/x: w - next-arrow/size/x
mode-choice/offset/x: w - ( mode-choice/size/x + next-arrow/size/x)
prev-arrow/offset/x: w - ( mode-choice/size/x +
next-arrow/size/x + prev-arrow/size/x )
gaia-title/size/x: prev-arrow/offset/x - gaia-logo/size/x
ws-box/size: as-pair w - ws-slider/size/x h - ws-box/offset/y - 1
ws-slider/offset/x: ws-box/size/x
current-field-width: define-field-width
ws-box/pane: current-layout: view-card compose current-layout-type
ws-slider/size/y: ws-box/size/y
ws-slider/redrag ws-slider/size/y / max 1 current-layout/size/y
scroll-msg ws-slider/data: 0.0
show gaia-layout
]
previous-card: does [
if not head? cards [
cards: back cards
current-card: to-block first cards
ws-box/pane: current-layout: view-card compose current-layout-type
scroll-msg ws-slider/data: 0
show ws-box
]
]
next-card: does [
if not tail? cards: next cards [
current-card: to-block first cards
ws-box/pane: current-layout: view-card compose current-layout-type
scroll-msg ws-slider/data: 0
show ws-box
]
]
define-field-width: does [
return ws-box/size/x - current-field-indent
]
set-view-card-mode: does [
current-layout-type: readonly-layout
resize
]
set-new-card-mode: does [
current-layout-type: new-card-lay
resize
]
format-cards: has [formatted-cards][
formatted-cards: copy []
foreach cards-item head cards [
append formatted-cards join "<SCHEDA/>" cards-item
]
return formatted-cards
]
delete-card: does [
if request/confirm/texts "Sei sicuro di voler cancellare questa
scheda?" ["Si" "No" "Annulla"][
remove cards
try [write %gaia/schede-istruttorie.bck read
%../database/schede-istruttorie.dat]
either error? try [write %../database/schede-istruttorie.dat
format-cards][
request/ok {Errore nell'aggiornamento dell'archivio
schede. Nel caso il file si fosse corrotto, sostituirlo
immediatamente con la copia di backup eviterý qualsiasi perdita di
dati.}
][
current-card: to-block first cards
resize
]
]
]
display-enti-istruttori: has [bureaus] [
bureaus: copy ""
foreach bureau sort current-card/enti-istruttori [
append bureaus rejoin [bureau newline]
]
return bureaus
]
generate-id: func [id-seed /local codes progr][
codes: copy []
foreach card cards [
card: to-block card
append codes card/codice
]
progr: (to-integer second parse last sort codes " ") + 1
return join id-seed [" " remove/part "000" length? (to-string progr) progr]
]
close-gaia: does [
unview/only gaia-layout
]
request: func [
"Requests an answer to a simple question.(with language management)"
str [string! block! object! none!]
/offset xy
/ok
/only
/confirm
/timeout time
/texts yncancel [block!]
/local lay result msg y n c t
][
lay: either all [object? str in str 'type str/type = 'face] [str] [
if none? str [str: "Cosa scegli?"]
either all [texts 3 = length? yncancel] [
foreach t yncancel [replace yncancel t form t]
set [y n c] yncancel
][
set [y n c] ["Yes" "No" "Cancel"]
]
if confirm [c: none]
if ok [y: "OK" n: c: none]
if only [y: n: c: none]
if block? str [
str: reduce str
set [str y n c] str
foreach n [str y n c] [
if all [found? get n not string? get n] [set n form get n]
]
]
result: copy [
style bt button with [size/y: 24]
across
msg: vtext bold copy str 320x-1 return
]
if y [append result [bt y #"Y" [result: yes hide-popup]]]
if n [append result [bt n #"N" [result: no hide-popup]]]
if c [append result [bt c #"^[" [result: none hide-popup]]]
layout result
]
result: none
either offset [inform/offset/timeout lay xy time] [inform/timeout lay time]
result
]
; ================================
; === EVENTS
; ================================
evt-custom: func [face event][
switch event/type [
resize [
resize
return true
]
offset [
return true
]
key [
switch event/key [
#"^Q" [quit]
page-up [page-msg negate
ws-box/size/y]
page-down [page-msg ws-box/size/y]
]
]
scroll-line [page-msg event/offset/y * 32]
scroll-page [page-msg event/offset/y * ws-box/size/y]
'close [quit]
]
event
]
; ================================
; === START
; ================================
insert-event-func :evt-custom
current-suap-seed: "D201"
current-field-indent: 150
current-field-width: define-field-width
current-layout-type: readonly-layout
cards: read-cards
current-card: to-block first cards
ws-box/pane: current-layout: view-card compose current-layout-type
resize
view/options gaia-layout [no-title resize]
]
----------------------------------------
REBOL [
Title: "SUAP Styles"
Author: "Paolo Russo"
Version: 0.0.0
Date: 15-Apr-2001
Project: 'SUAP
Type: 'plug-in
History: [
"Paolo" 0.0.0 15-Apr-2001 "Creazione SUAP Styles"
]
Purpose: {Define standard styles for SUAP application and plug-ins.}
]
suap-styles: stylize [
wgmulm12-txt: text white effect [gradmul 128.128.128 mint] para
[margin: 12x12] wrap
logmul-vh3: vh3 left orange effect [gradmul 128.128.128 mint]
]
--
Paolo Russo
[pa--russo--perd--com]
_________________
PERD s.r.l.
Virtual Technologies for Real Solutions
http://www.perd.com
