Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

[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 "&nbsp" #"" [put " &nbsp; " 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] ]