home *** CD-ROM | disk | FTP | other *** search
/ Phoenix CD 2.0 / Phoenix_CD.cdr / 01e / memoutil.zip / MEMOUTIL.PRG < prev   
Text File  |  1987-04-01  |  11KB  |  376 lines
  1. * Program:  MemoUtil.PRG
  2. * Author.:  John Kaster
  3. * Date...:  3/26/1987
  4. * Notice..: Placed in the public domain by John Kaster.
  5. * Notes...: Since I wrote these functions and procedures for my own use, any
  6. *           confusing abbreviations or code without comments is because I hate
  7. *           documenting things already completed.  If any coding is unclear,
  8. *           you may direct questions to me on EXEC-PC BBS in Milwaukee at
  9. *           414/964-5160 (9600 baud capable, N, 8, 1; Kermit, Ymodem and Xmodem
  10. *           support), or ACUMEN at 703-321-7441 (2400 baud).
  11. *
  12. *           These functions require MEMO.LIB to be linked into your application
  13. *
  14.  
  15. FUNC STRIP10
  16. * Syntax:  Strip10( <MemoField> )
  17. * Notes.:  Strips out the line feed character [chr(10)] from a memo or
  18. *          character field
  19. PARA RetText
  20. DO WHIL AT(chr(10),RetText)#0
  21.   p=at(chr(10),RetText)
  22.   RetText=left(RetText,p-1)+right(RetText,LEN(RetText)-p)
  23. ENDDO
  24. RETURN ( RetText )
  25.  
  26. PROC MemoScreen
  27. * Syntax:  DO MemoScreen WITH <Title>
  28. * Notes.:  Display screen for editing memo with description of editing keys
  29. *          Variable  Type  Description if necessary
  30. *          ========  ====  ========================
  31. *          T          C    Title of editing screen
  32. *          Top        N    Top position of window
  33. *          Left       N    Left position of window
  34. *          Bottom     N    Bottom position of window
  35. *          Right      N    Right position of window
  36. *
  37. PARA T,Top,Left,Bottom,Right
  38. IF PCOUNT()<1
  39.   T='Editing a memo field'
  40. ENDIF
  41. IF PCOUNT()<5
  42.   Top=3
  43.   Left=0
  44.   Bottom=24
  45.   Right=52
  46. ENDIF
  47. DO MCOL1
  48. @ 0,0 CLEA
  49. DO MTITLE WITH T
  50. DO MBOXIT WITH Top,Left,Bottom,Right,5
  51. @  3,55 SAY '"^" = [Ctrl key]'
  52. @  4,55 SAY 'KEY    PURPOSE'
  53. @  6,55 SAY '^E,'+chr(24)+'  '+chr(24)+' a Line'
  54. @  6,55 SAY '^X,'+chr(25)+'  '+chr(25)+' a Line'
  55. @  7,55 SAY '^S,'+chr(27)+'  '+chr(27)+' a Char'
  56. @  8,55 SAY '^D,'+chr(26)+'  '+chr(26)+' a Char'
  57. @  9,55 SAY '^A,^'+chr(27)+' '+chr(27)+' a Word'
  58. @  9,55 SAY '^F,^'+chr(26)+' '+chr(26)+' a Word'
  59. @ 10,55 SAY 'Home  Beginning of Line'
  60. @ 11,55 SAY 'End   End of Line'
  61. @ 12,55 SAY '^Home Beginning of Memo'
  62. @ 13,55 SAY '^End  End of Memo'
  63. @ 14,55 SAY 'PgUp  '+chr(24)+' a Screen'
  64. @ 15,55 SAY 'PgDn  '+chr(25)+' a Screen'
  65. @ 16,55 SAY '^PgUp Beginning of Screen'
  66. @ 17,55 SAY '^PgDn End of Screen'
  67. @ 19,55 SAY '^W    Quit and Save'
  68. @ 20,55 SAY 'Esc   Abort edit'
  69. @ 21,55 SAY '^Y    Delete current line'
  70. @ 22,55 SAY '^T    Delete right word'
  71. @ 23,55 SAY '^B    Reformat memo'
  72. RETU
  73.  
  74. FUNC MemoCheck
  75. * Syntax:  MemoCheck ( <Edit?>, <MemoFieldName>, <Title>, <Lines> )
  76. * Notes.:  Allows editing of a memo field by changing a GET logical variable
  77. *          to true and passing it as the <Edit?> parameter
  78. *          Variable  Type  Description if necessary
  79. *          ========  ====  ========================
  80. *          EditIt     L
  81. *          Field      C    NAME of memo field
  82. *          Title      C    Title for editing
  83. *          Lines      N    Number of lines in display of memo field
  84. *
  85. PARA EditIt,Field,Title,Lines
  86. PRIVATE Top,Left,Bottom,Right
  87. IF PCOUNT()<3
  88.   Title='Editing '+alltrim(Field)+' memo field'
  89. ENDIF
  90. IF PCOUNT()<4
  91.   Lines=19
  92. ENDIF
  93. Top=4
  94. Left=0
  95. Bottom=5+Lines
  96. Right=52
  97. IF EditIt
  98.   SAVE SCREEN TO SAVED
  99.   DO MemoScreen WITH Title,Top,Left,Bottom,Right
  100.   REPL &Field WITH MemoEdit(&Field,5,1,4+Lines,51)
  101.   RESTORE SCREEN FROM SAVED
  102.   STOR .F. TO Memo1,Memo2,Memo3,Memo4,Memo5,Memo6,Memo7,Memo8,Memo9,Memo10
  103. ENDIF
  104. RETURN ( .T. )
  105.  
  106. FUNC MEMOREPL
  107. * Syntax:  MemoRepl( <MemoField>, <Target>, <Replacement> )
  108. * Notes.:  Replaces <Target> in <MemoField> with <Replacement>
  109. *          Variable  Type  Description if necessary
  110. *          ========  ====  ========================
  111. *          PM         M,C  Passed memo field
  112. *          T           C   Target string to replace
  113. *          R           C   Replacement string
  114. *
  115. PARA PM,T,R
  116. PRIV S,S1,Startat,StopAt,LeftOver
  117. IF PCOUNT()<3
  118.   RETURN ( PM )
  119. ENDIF
  120. S=PM
  121. IF AT(t,S)>0
  122.   startat=at(t,s)-1
  123.   StopAt=startat+len(t)+1
  124.   leftover=len(s)-StopAt+1
  125.   IF startat=0
  126.     s1=r+substr(s,StopAt,leftover)
  127.   ELSE
  128.     * Testing for stripping out code for hard returns from read in file
  129.     * with a space following it.  This will prevent an extra space from
  130.     * being put into the sentence.
  131.     IF T=chr(254).AND.R=' '.AND.substr(s,Stopat,1)#' '
  132.         R=''  && Preventing an extra space
  133.     ENDIF
  134.     s1=substr(s,1,startat)+r+substr(s,StopAt,leftover)
  135.   ENDIF
  136.   s=s1
  137. ENDIF
  138. RETURN ( S )
  139.  
  140. FUNC MEMOFORM
  141. * Syntax:  MemoForm ( <MemoField> )
  142. * Notes.:  Converts single hard returns to blank spaces and preserves double
  143. *          hard returns.  This was created for reading in an ASCII file as a
  144. *          memo field.
  145. *          Variable  Type  Description if necessary
  146. *          ========  ====  ========================
  147. *          PM         M,C  Passed memo field
  148. PARA PM
  149. PRIV TM,ID,DOUBLE,FIX
  150. IF PCOUNT()<1
  151.   RETURN ( '' )
  152. ENDIF
  153. IF TYPE('PM')#'C'
  154.   RETURN ( '' )
  155. ENDIF
  156. TM=PM
  157. FIX=chr(254)+chr(254)
  158. TM=MEMOTRAN(TM,chr(254))
  159. ID=AT(FIX,TM)
  160. DO WHIL ID>0
  161.   TM=MEMOREPL(TM,FIX,chr(13)+chr(10)+chr(13)+chr(10))
  162.   ID=AT(FIX,TM)
  163. ENDDO
  164. FIX=chr(254)
  165. ID=AT(FIX,TM)
  166. DO WHIL ID>0
  167.   TM=MEMOREPL(TM,FIX," ")
  168.   ID=AT(FIX,TM)
  169. ENDDO
  170. RETURN ( TM )
  171.  
  172. FUNC MemoTrn2
  173. * Syntax:  MemoTrn2 ( <MemoField> )
  174. * Notes.:  Removes all soft returns from a memo field and replaces them
  175. *          with spaces unless the next character is a space.
  176. *
  177. PARA PM
  178. PRIV S,S1,SR,I
  179. S=PM
  180. SR=chr(141)+chr(10) && Soft carriage return code sequence
  181. DO WHIL SR $ S
  182.   I=AT(SR,S)
  183.   S=LEFT(S,I-1)+Right(S,Len(S)-(I+1)) && Removing soft return codes
  184. ENDDO
  185. RETURN ( S )
  186.  
  187. FUNC MemoOut
  188. * Syntax:  MemoOut ( <MemoField> [,<LeftMargin>, <Width> [,<Lines>]] )
  189. * Notes.:  Formats <MemoField> with spaces the length of <LeftMargin>,
  190. *          original text <Width> wide, and <Lines> long.  Word wrapping
  191. *          is performed where necessary.
  192. *          Variable  Type  Description if necessary
  193. *          ========  ====  ========================
  194. *          PM         M,C  Passed memo field
  195. *          LM          N   Left Margin
  196. *          Wid         N   Width of text.  LM+Wid = Right margin
  197. *          Lines       N   Limiting # of lines of text
  198. *
  199. PARA PM,LM,Wid,Lines
  200. PRIV S1,S2,S3,I,Temp,HR,Back,HRStripped
  201. DO CASE
  202. CASE PCOUNT()<1
  203.   RETURN ( "" )
  204. CASE PCOUNT()<2
  205.   LM=8
  206.   Wid=68  && Right Margin=72
  207.   Lines=999999
  208. CASE PCOUNT()<3
  209.   Wid=80-LM-10
  210.   Lines=999999
  211. CASE PCOUNT()<4
  212.   Lines=999999
  213. ENDC
  214. S2=Trim(MemoTrn2(PM))                    && Stripping out soft returns
  215. STOR '' TO S1,S3
  216. HR=Chr(13)+Chr(10)
  217. I=1
  218. DO WHIL Len(S2)>0.AND.I<=Lines
  219.   IF Len(S2)>Wid
  220.     S1=Left(S2,Wid)                      && Assigning first part of S2 to S1
  221.   ELSE
  222.     S1=S2
  223.     S2=''
  224.   ENDIF
  225.   Temp=''
  226.   IF Len(S2)>0
  227.     HRStripped=.F.
  228.     IF AT(HR,S1)>0
  229.       Temp=Right(S1,Len(S1)-AT(HR,S1)-1)     && Stripping out extra hard return
  230.       S1=Left(S1,AT(HR,S1)-1)                && and adjusting S1
  231.       HRStripped=.T.
  232.     ENDIF
  233.     IF Len(S2)>Wid
  234.       S2=Right(S2,Len(S2)-Wid)               && Removing S1 from S2
  235.     ENDIF
  236.     S2=Temp+S2                               && Adding temp if needed
  237.     IF Left(S2,Len(S2))=HR                   && Checking for extra hard return
  238.       S2=Right(S2,Len(S2)-2)                 && Stripping out extra hard return
  239.     ELSE                                     && Test for word wrap
  240.       IF Right(S1,1)#' '.AND.Left(S2,1)#' '.AND.! HRStripped
  241.         Back=Len(S1)-1                       && Word is broken
  242.         DO WHIL Substr(S1,Back,1)#' '.AND.Back>=len(S1)/2
  243.           Back=Back-1
  244.         ENDDO
  245.         IF Back<Len(S1)/2                    && Adding a hyphen because
  246.           Temp=Right(S1,1)                   && the word must remain broken
  247.           S1=Left(S1,Len(S1)-1)+'-'          && and I'm not writing a
  248.           S2=Temp+S2                         && hyphenation algorithm
  249.         ELSE
  250.           Temp=RIGHT(S1,Len(S1)-Back)
  251.           S1=Left(S1,Back)                   && Removing broken word
  252.           S2=Temp+S2                         && Putting word back together
  253.         ENDIF
  254.         Temp=''
  255.       ENDIF                                  && Word wrap
  256.     ENDIF
  257.   ENDIF
  258.   S1=IIF(Len(LTrim(S1))=Len(S1)-1,ltrim(S1),S1)
  259.   S3=S3+space(LM)+S1+HR                      && Adding S1 to return field+HR
  260.   I=I+1
  261. ENDDO
  262. RETURN (S3)
  263.  
  264. FUNCTION MEMOLINES
  265. * Syntax:  Memolines ( <Memo Field> )
  266. * Notes.:  Returns the number of lines in <memo field>
  267. *          KNT() is from my EXTENDB2.PRG
  268. PARA PM
  269. IF PCOUNT()<1
  270.   RETURN (0)
  271. ENDIF
  272. RETURN ( KNT(HARDCR(PM),chr(13)+chr(10)) )
  273.  
  274.  
  275. PROC MBOXCOL
  276. * Syntax:  DO MBOXCOL
  277. * Notes.:  Sets the box color for color or monochrome systems
  278. IF ISCOLOR()
  279.   SET COLO TO GR/N
  280. ELSE
  281.   SET COLO TO W/N
  282. ENDIF
  283. RETU
  284.  
  285. PROC MCOL1
  286. * Syntax:  DO MCOL1
  287. * Notes.:  Sets the normal screen for color or monochrome systems
  288. IF ISCOLOR()
  289.   SET COLO TO GR+/N,W+/B,,,W/B
  290. ELSE
  291.   SET COLO TO W+/N,N/W,,,B/N
  292. ENDIF
  293. RETU
  294.  
  295. PROC MCOL2
  296. * Syntax:  DO MCOL2
  297. * Notes.:  Sets the inverse (GET field) screen for color or monochrome systems
  298. IF ISCOLOR()
  299.   SET COLO TO W/B
  300. ELSE
  301.   SET COLO TO B/N
  302. ENDIF
  303. RETU
  304.  
  305. PROC MBOXIT
  306. * Syntax.: DO MBOXIT WITH <Top>, <Left>, <Bottom>, <Right>, <Border>, <Clear>
  307. * Notes..: Creates a box at the above locations with <Border>
  308. *
  309. PARAMETERS Top,Left,Bottom,Right,Border,Clear
  310. IF TYPE("Border")#"N"
  311.   Border=1
  312. ENDIF
  313. IF TYPE("Right")#"N".OR.TYPE("Left")#"N".OR.TYPE("Top")#"N".OR.TYPE("Bottom")#"N"
  314.   RETURN
  315. ENDIF
  316. DO CASE
  317. CASE Border=0
  318.   Bframe = "        "
  319. CASE Border=2
  320.   BFrame = "╔═╗║╝═╚║"
  321. CASE Border=3
  322.   BFrame = "╒═╕│╛═╘│"
  323. CASE Border=4
  324.   BFrame = "╓─╖║╜─╙║"
  325. CASE Border=5
  326.   BFrame = "▄▄▄█▀▀▀█"
  327. CASE Border=6
  328.   BFrame = "▄▄▄▐▀▀▀▌"
  329. CASE Border=7
  330.   BFrame = "████████"
  331. CASE Border=8
  332.   BFrame = "▓▓▓▓▓▓▓▓"
  333. CASE Border=9
  334.   BFrame = "▒▒▒▒▒▒▒▒"
  335. CASE Border=10
  336.   BFrame = "░░░░░░░░"
  337. CASE Border=11
  338.   BFrame = "┌ ┐│╛═╘│"
  339. OTHE
  340.   Bframe = "┌─┐│┘─└│"
  341. ENDC
  342. IF TYPE("Clear")="C"
  343.   Bframe=Bframe+Clear
  344. ENDIF
  345. DO MBOXCOL
  346. @ Top,left CLEA TO Bottom,Right
  347. IF Border#0
  348.   @ Top,left,bottom,right BOX Bframe
  349. ENDIF
  350. DO MCOL1
  351. RETU
  352. * EOP: Procedure MBOXIT
  353.  
  354. PROCEDURE MTITLE
  355. * Syntax.: DO MTITLE WITH <Title>, [<starting line>]
  356. * Notes..: Clears line 1 and 2 and centers <Title> on line 1
  357. *
  358. PARAMETER Ttl,start
  359. IF TYPE('Start')<>'N'
  360.   Start=1
  361. ENDIF
  362. @ Start,0
  363. @ Start+1,0
  364. BFrame = '┌ ┐│╛═╘│'
  365. Cent=INT(len(Ttl)/2)
  366. BotLine=INT(FCOUNT()/6+5)
  367. IF ISCOLOR()
  368.   SET COLOR TO RB/N
  369. ELSE
  370.   SET COLOR TO W/N
  371. ENDIF
  372. @ Start,40-cent-2,Start+1,40+cent+IF(LEN(Ttl)/2=INT(len(Ttl)/2),1,2) BOX Bframe
  373. SET COLO TO W+/N
  374. @ Start,40-cent-1 SAY ' '+Ttl+' '
  375. DO MCOL1
  376. RETU