[REBOL] Re: Scroll text area?
From: hijim:pronet at: 6-Jul-2001 22:24
Volker, I got the buttons. It doesn't matter that they scroll slightly less than a page.
That might be an advantage. Perfect!
Jim
rebol [Title: "HTML Tag Editor"]
a-file: ""
put: func [a b] [if text-file <> system/view/focal-face [return]
insert system/view/caret a
system/view/caret: skip system/view/caret b show text-file]
jump: func [x] [system/view/caret: skip system/view/caret x show text-file]
scroll-para: func [tf sf /local tmp] [
if none? tf/para [exit]
tmp: min 0x0 tf/size - (size-text tf) - 0x30
either sf/size/x > sf/size/y [tf/para/scroll/x: sf/data * first tmp] [
tf/para/scroll/y: sf/data * second tmp]
show tf
]
reb-source: [{REBOL [
Title: ""
File:
Date:} now/date {
Author: "Jim Clatfelter"
Purpose: []
]
view/layout [
]
}
]
reb: reform reb-source
<PRE></PRE>
view layout [
backdrop silver across space 0
style but button 72x20 green / 2 font-name font-fixed
style but2 button 36x20 green / 2 font-name font-fixed
style but3 button 72 gold
text-file: area para [] 700x400 a-file silver white font-name font-fixed
my-slider: slider 20x400 silver / 1.5 gold [scroll-para text-file my-slider]
return
pad 0x2
key #"^-" #"" [if text-file <> system/view/focal-face [return]
system/view/caret: skip system/view/caret 0 show text-file] ; disable tab key
but "<P>" #"" [put "<P>" 3]
but "<BR>" #"" [put "<BR>" 4]
but " " #"" [put " " 8]
but "<PRE>" #"" [put "<PRE></PRE>" 5]
but "<UL>" #"" [put
{</UL>
<LI>
</UL>} 10
]
but "<OL>" [put
{</OL>
<LI>
</OL>} 10
]
but "<LI>" #"" [put "<LI>" 4]
but "Link" #"" [put {<A HREF=""> </A>} 9]
but "Image" #"" [put {<IMAGE SRC = ".jpg" ALIGN=left HSPACE=10>} 14]
but "Clear" #"" [put {<BR CLEAR=all>} 15]
return
pad 0x4
but "<CENTER>" #"" [put "<CENTER></CENTER>" 8]
but2 "H1" #"" [put "<H1></H1>" 4]
but2 "H2" #"" [put "<H2></H2>" 4]
but2 "H3" #"" [put "<H3></H3>" 4]
but2 "H4" #"" [put "<H4></H4>" 4]
but "Quote" #"" [put "<BLOCKQUOTE></BLOCKQUOTE>" 12]
but2 "B" #"" [put "<B></B>" 3]
but2 "I" #"" [put "<I></I>" 3]
but2 "U" #"" [put "<U></U>" 3]
but2 "HR" #"" [put "<HR>" 4]
but "<FONT>" #"" [put {<FONT FACE="arial,helvetica"></FONT>} 29]
but2 "+" #"" [put {<FONT SIZE="+1"></FONT>} 16]
but2 "-" #"" [put {<FONT SIZE="-1"></FONT>} 16]
but "line.gif" #"" [put {<IMAGE SRC = "line.gif">} 24]
but "Date" #"" [put to-string now/date length? to-string now/date]
return
pad 0x4
button 72 "Open" #"^o" [
file-path: request-file/title/keep "Open File" "Open"
if file-path <> none [
a-file: read/string to-file file-path system/view/focal-face
text-file/text: a-file file-path
focus text-file
show text-file
top-flag: true
]
]
button 72 "Save" #"^s" [
file-path: request-file/title/keep "Save File" "Save"
if file-path <> none [
write first file-path text-file/text
]
]
button 72 "Print" #"^p" [write %//prn join a-file #"^L"]
button 72 "REBOL" #"" [if text-file <> system/view/focal-face [return]
insert a-file reb show text-file jump 20]
button 72 "HTML" [append a-file {
<IMAGE SRC = "line.gif"> <P>
</BLOCKQUOTE> </BODY> </HTML>
}
insert a-file {
<HTML>
<HEAD> <TITLE></TITLE> </HEAD>
<BODY BGCOLOR="white"><BLOCKQUOTE>
<H1> </H1>
<IMAGE SRC = "line.gif"> <P>
}
focus text-file
show text-file
]
but3 "Home" [my-slider/data: 0
scroll-para text-file my-slider
show [my-slider]]
but3 "PgDn" [my-slider/data: my-slider/data +
(text-file/size/y / second size-text text-file)
scroll-para text-file my-slider
show [my-slider]]
but3 "PgUp" [my-slider/data: my-slider/data -
(text-file/size/y / second size-text text-file)
scroll-para text-file my-slider
show [my-slider]]
but3 "End" [my-slider/data: 1
scroll-para text-file my-slider
show [my-slider]]
button 72 red "Quit" #"^q" [unview/all]
]