[REBOL] [Styles] A number Style
From: philb::upnaway::com at: 20-Jun-2004 18:29
Hi,
An update to the number style I posted on Friday .... this is getting a bit complex but
hopefully you can
use it and not worry about the details. (Note : Doesnt allow scientific notation ie 12.34e5.)
my-styles: stylize [
rfield: field
feel [engage: func[face action event /local pass] [
; print event/type
pass: does[ctx-text/edit/engage face action event]
if event/type = 'key [
ch: event/key
if ch = 'left [pass exit]
if ch = 'right [pass exit]
if ch = 'home [pass exit]
if ch = 'end [pass exit]
if find face/single-chars ch [if find face/data ch [exit]]
if find "^A^C^H^X^~^-" ch [pass exit]
if all [(face/max-len > 0) (length? face/text) >= face/max-len] [exit]
if all [(face/allow-chars <> "") not find face/allow-chars ch] [exit]
]
pass
]
]
with [allow-chars: "" single-chars: "" max-len: 0]
; a number , may have leading "-" & decimal places
nfield: field
feel [engage: func[face action event /local pass ch cch dp tx itx iex len] [
; print event/type
pass: does[ctx-text/edit/engage face action event]
if event/type = 'key [
ch: event/key
if ch = 'left [pass exit]
if ch = 'right [pass exit]
if ch = 'home [pass exit]
if ch = 'end [pass exit]
if find "^A^C^H^X^~^-" ch [pass exit]
cch: (length? face/text) - (length? system/view/caret) + 1
if ch = #"-" [either cch = 1 [either face/neg [pass exit][exit]][exit]]
if ch = #"." [
either not face/dec
[exit]
[
dp: find face/data ch
either dp = none [idp: length? face/text][exit]
either face/text = ""
[icar: 1]
[
icar: index? system/view/caret
if #"-" = first face/text [icar: icar -1]
]
either any [idp - icar >= face/dpts]
[exit]
[pass exit]
]
]
if all [(face/allow-chars <> "") not find face/allow-chars ch] [exit]
; check no of decimal places
if all [face/dec face/dpts <> 0 not any [ch = #"e" ch = "E"]] [
tx: find face/text "."
either tx = none [itx: 0][itx: index? tx]
iex: length? face/text
if all [
itx > 0
face/dpts = (iex - itx)
(index? system/view/caret) - 1 <= iex
(index? system/view/caret) > itx
] [exit]
]
; check no of digits
if all [face/text <> "" face/dig > 0] [
either face/dec
[
; decimal digts
tx: find face/text "."
either tx = none
[len: length? face/text]
[
either (index? system/view/caret) > index? tx
[len: 0]
[len: (index? tx) - 1]
]
if #"-" = first face/text [len: len - 1]
if face/dig <= len [exit]
]
[
; integer digits
either #"-" = first face/text
[if face/dig + 1 <= length? face/text [exit]]
[if face/dig <= length? face/text [exit]]
]
]
]
pass
]
]
with [allow-chars: "0123456789" dec: false dig: 0 dpts: 2 neg: true]
; note - set dec: true & dpts: 0 for no limits of the number of decimal places
; field with fixed font
ff-rfield: rfield font [name: font-fixed]
ff-nfield: nfield font [name: font-fixed]
; decimal field
dfield: ff-nfield with [dec: true]
udfield: ff-nfield with [dec: true neg: false]
; integer field
ifield: ff-nfield
uifield: ff-nfield with [neg: false]
;hexadecimal field
hfield: ff-rfield with [allow-chars: "0123456789ABCDEF#" single-chars: "#"]
; date field
date-field: ff-rfield with [allow-chars: "0123456789/" single-chars: ""]
]
;
; Test fields
;
tx: 1
view layout [
styles my-styles
style lab label 160 right
backdrop 0.150.0
across
lab "Signed Decimal 2dp"
dfield
return
lab "Unsigned Decimal 2dp"
udfield
return
lab "Signed Decimal 10dp"
dfield with [dpts: 10]
return
lab "Unsigned Decimal 10dp"
udfield with [dpts: 10]
return
lab "Signed Decimal"
dfield with [dpts: 0]
return
lab "Unsigned Decimal"
udfield with [dpts: 0]
return
lab "Signed Integer"
ifield
return
lab "Unsigned Integer"
uifield
return
lab "Signed Decimal 8 dig 4dp"
dfield with [dig: 8 dpts: 4]
return
lab "Signed Integer 8 dig"
ifield with [dig: 8]
return
lab "Hex field"
hfield
return
lab "Date (99/99/9999)"
date-field
return
lab "Just ABCDEFGWI"
rfield with [allow-chars: "ABCDEFGWI" single-chars: ""]
return
lab "Max Length 6"
rfield with [max-len: 6]
]
Cheers Phil
