* Program:  MemoUtil.PRG
* Author.:  John Kaster
* Date...:  3/26/1987
* Notice..: Placed in the public domain by John Kaster.
* Notes...: Since I wrote these functions and procedures for my own use, any
*           confusing abbreviations or code without comments is because I hate
*           documenting things already completed.  If any coding is unclear,
*           you may direct questions to me on EXEC-PC BBS in Milwaukee at
*           414/964-5160 (9600 baud capable, N, 8, 1; Kermit, Ymodem and Xmodem
*           support), or ACUMEN at 703-321-7441 (2400 baud).
*
*           These functions require MEMO.LIB to be linked into your application
*

FUNC STRIP10
* Syntax:  Strip10( <MemoField> )
* Notes.:  Strips out the line feed character [chr(10)] from a memo or
*          character field
PARA RetText
DO WHIL AT(chr(10),RetText)#0
  p=at(chr(10),RetText)
  RetText=left(RetText,p-1)+right(RetText,LEN(RetText)-p)
ENDDO
RETURN ( RetText )

PROC MemoScreen
* Syntax:  DO MemoScreen WITH <Title>
* Notes.:  Display screen for editing memo with description of editing keys
*          Variable  Type  Description if necessary
*          ========  ====  ========================
*          T          C    Title of editing screen
*          Top        N    Top position of window
*          Left       N    Left position of window
*          Bottom     N    Bottom position of window
*          Right      N    Right position of window
*
PARA T,Top,Left,Bottom,Right
IF PCOUNT()<1
  T='Editing a memo field'
ENDIF
IF PCOUNT()<5
  Top=3
  Left=0
  Bottom=24
  Right=52
ENDIF
DO MCOL1
@ 0,0 CLEA
DO MTITLE WITH T
DO MBOXIT WITH Top,Left,Bottom,Right,5
@  3,55 SAY '"^" = [Ctrl key]'
@  4,55 SAY 'KEY    PURPOSE'
@  6,55 SAY '^E,'+chr(24)+'  '+chr(24)+' a Line'
@  6,55 SAY '^X,'+chr(25)+'  '+chr(25)+' a Line'
@  7,55 SAY '^S,'+chr(27)+'  '+chr(27)+' a Char'
@  8,55 SAY '^D,'+chr(26)+'  '+chr(26)+' a Char'
@  9,55 SAY '^A,^'+chr(27)+' '+chr(27)+' a Word'
@  9,55 SAY '^F,^'+chr(26)+' '+chr(26)+' a Word'
@ 10,55 SAY 'Home  Beginning of Line'
@ 11,55 SAY 'End   End of Line'
@ 12,55 SAY '^Home Beginning of Memo'
@ 13,55 SAY '^End  End of Memo'
@ 14,55 SAY 'PgUp  '+chr(24)+' a Screen'
@ 15,55 SAY 'PgDn  '+chr(25)+' a Screen'
@ 16,55 SAY '^PgUp Beginning of Screen'
@ 17,55 SAY '^PgDn End of Screen'
@ 19,55 SAY '^W    Quit and Save'
@ 20,55 SAY 'Esc   Abort edit'
@ 21,55 SAY '^Y    Delete current line'
@ 22,55 SAY '^T    Delete right word'
@ 23,55 SAY '^B    Reformat memo'
RETU

FUNC MemoCheck
* Syntax:  MemoCheck ( <Edit?>, <MemoFieldName>, <Title>, <Lines> )
* Notes.:  Allows editing of a memo field by changing a GET logical variable
*          to true and passing it as the <Edit?> parameter
*          Variable  Type  Description if necessary
*          ========  ====  ========================
*          EditIt     L
*          Field      C    NAME of memo field
*          Title      C    Title for editing
*          Lines      N    Number of lines in display of memo field
*
PARA EditIt,Field,Title,Lines
PRIVATE Top,Left,Bottom,Right
IF PCOUNT()<3
  Title='Editing '+alltrim(Field)+' memo field'
ENDIF
IF PCOUNT()<4
  Lines=19
ENDIF
Top=4
Left=0
Bottom=5+Lines
Right=52
IF EditIt
  SAVE SCREEN TO SAVED
  DO MemoScreen WITH Title,Top,Left,Bottom,Right
  REPL &Field WITH MemoEdit(&Field,5,1,4+Lines,51)
  RESTORE SCREEN FROM SAVED
  STOR .F. TO Memo1,Memo2,Memo3,Memo4,Memo5,Memo6,Memo7,Memo8,Memo9,Memo10
ENDIF
RETURN ( .T. )

FUNC MEMOREPL
* Syntax:  MemoRepl( <MemoField>, <Target>, <Replacement> )
* Notes.:  Replaces <Target> in <MemoField> with <Replacement>
*          Variable  Type  Description if necessary
*          ========  ====  ========================
*          PM         M,C  Passed memo field
*          T           C   Target string to replace
*          R           C   Replacement string
*
PARA PM,T,R
PRIV S,S1,Startat,StopAt,LeftOver
IF PCOUNT()<3
  RETURN ( PM )
ENDIF
S=PM
IF AT(t,S)>0
  startat=at(t,s)-1
  StopAt=startat+len(t)+1
  leftover=len(s)-StopAt+1
  IF startat=0
    s1=r+substr(s,StopAt,leftover)
  ELSE
    * Testing for stripping out code for hard returns from read in file
    * with a space following it.  This will prevent an extra space from
    * being put into the sentence.
    IF T=chr(254).AND.R=' '.AND.substr(s,Stopat,1)#' '
        R=''  && Preventing an extra space
    ENDIF
    s1=substr(s,1,startat)+r+substr(s,StopAt,leftover)
  ENDIF
  s=s1
ENDIF
RETURN ( S )

FUNC MEMOFORM
* Syntax:  MemoForm ( <MemoField> )
* Notes.:  Converts single hard returns to blank spaces and preserves double
*          hard returns.  This was created for reading in an ASCII file as a
*          memo field.
*          Variable  Type  Description if necessary
*          ========  ====  ========================
*          PM         M,C  Passed memo field
PARA PM
PRIV TM,ID,DOUBLE,FIX
IF PCOUNT()<1
  RETURN ( '' )
ENDIF
IF TYPE('PM')#'C'
  RETURN ( '' )
ENDIF
TM=PM
FIX=chr(254)+chr(254)
TM=MEMOTRAN(TM,chr(254))
ID=AT(FIX,TM)
DO WHIL ID>0
  TM=MEMOREPL(TM,FIX,chr(13)+chr(10)+chr(13)+chr(10))
  ID=AT(FIX,TM)
ENDDO
FIX=chr(254)
ID=AT(FIX,TM)
DO WHIL ID>0
  TM=MEMOREPL(TM,FIX," ")
  ID=AT(FIX,TM)
ENDDO
RETURN ( TM )

FUNC MemoTrn2
* Syntax:  MemoTrn2 ( <MemoField> )
* Notes.:  Removes all soft returns from a memo field and replaces them
*          with spaces unless the next character is a space.
*
PARA PM
PRIV S,S1,SR,I
S=PM
SR=chr(141)+chr(10) && Soft carriage return code sequence
DO WHIL SR $ S
  I=AT(SR,S)
  S=LEFT(S,I-1)+Right(S,Len(S)-(I+1)) && Removing soft return codes
ENDDO
RETURN ( S )

FUNC MemoOut
* Syntax:  MemoOut ( <MemoField> [,<LeftMargin>, <Width> [,<Lines>]] )
* Notes.:  Formats <MemoField> with spaces the length of <LeftMargin>,
*          original text <Width> wide, and <Lines> long.  Word wrapping
*          is performed where necessary.
*          Variable  Type  Description if necessary
*          ========  ====  ========================
*          PM         M,C  Passed memo field
*          LM          N   Left Margin
*          Wid         N   Width of text.  LM+Wid = Right margin
*          Lines       N   Limiting # of lines of text
*
PARA PM,LM,Wid,Lines
PRIV S1,S2,S3,I,Temp,HR,Back,HRStripped
DO CASE
CASE PCOUNT()<1
  RETURN ( "" )
CASE PCOUNT()<2
  LM=8
  Wid=68  && Right Margin=72
  Lines=999999
CASE PCOUNT()<3
  Wid=80-LM-10
  Lines=999999
CASE PCOUNT()<4
  Lines=999999
ENDC
S2=Trim(MemoTrn2(PM))                    && Stripping out soft returns
STOR '' TO S1,S3
HR=Chr(13)+Chr(10)
I=1
DO WHIL Len(S2)>0.AND.I<=Lines
  IF Len(S2)>Wid
    S1=Left(S2,Wid)                      && Assigning first part of S2 to S1
  ELSE
    S1=S2
    S2=''
  ENDIF
  Temp=''
  IF Len(S2)>0
    HRStripped=.F.
    IF AT(HR,S1)>0
      Temp=Right(S1,Len(S1)-AT(HR,S1)-1)     && Stripping out extra hard return
      S1=Left(S1,AT(HR,S1)-1)                && and adjusting S1
      HRStripped=.T.
    ENDIF
    IF Len(S2)>Wid
      S2=Right(S2,Len(S2)-Wid)               && Removing S1 from S2
    ENDIF
    S2=Temp+S2                               && Adding temp if needed
    IF Left(S2,Len(S2))=HR                   && Checking for extra hard return
      S2=Right(S2,Len(S2)-2)                 && Stripping out extra hard return
    ELSE                                     && Test for word wrap
      IF Right(S1,1)#' '.AND.Left(S2,1)#' '.AND.! HRStripped
        Back=Len(S1)-1                       && Word is broken
        DO WHIL Substr(S1,Back,1)#' '.AND.Back>=len(S1)/2
          Back=Back-1
        ENDDO
        IF Back<Len(S1)/2                    && Adding a hyphen because
          Temp=Right(S1,1)                   && the word must remain broken
          S1=Left(S1,Len(S1)-1)+'-'          && and I'm not writing a
          S2=Temp+S2                         && hyphenation algorithm
        ELSE
          Temp=RIGHT(S1,Len(S1)-Back)
          S1=Left(S1,Back)                   && Removing broken word
          S2=Temp+S2                         && Putting word back together
        ENDIF
        Temp=''
      ENDIF                                  && Word wrap
    ENDIF
  ENDIF
  S1=IIF(Len(LTrim(S1))=Len(S1)-1,ltrim(S1),S1)
  S3=S3+space(LM)+S1+HR                      && Adding S1 to return field+HR
  I=I+1
ENDDO
RETURN (S3)

FUNCTION MEMOLINES
* Syntax:  Memolines ( <Memo Field> )
* Notes.:  Returns the number of lines in <memo field>
*          KNT() is from my EXTENDB2.PRG
PARA PM
IF PCOUNT()<1
  RETURN (0)
ENDIF
RETURN ( KNT(HARDCR(PM),chr(13)+chr(10)) )


PROC MBOXCOL
* Syntax:  DO MBOXCOL
* Notes.:  Sets the box color for color or monochrome systems
IF ISCOLOR()
  SET COLO TO GR/N
ELSE
  SET COLO TO W/N
ENDIF
RETU

PROC MCOL1
* Syntax:  DO MCOL1
* Notes.:  Sets the normal screen for color or monochrome systems
IF ISCOLOR()
  SET COLO TO GR+/N,W+/B,,,W/B
ELSE
  SET COLO TO W+/N,N/W,,,B/N
ENDIF
RETU

PROC MCOL2
* Syntax:  DO MCOL2
* Notes.:  Sets the inverse (GET field) screen for color or monochrome systems
IF ISCOLOR()
  SET COLO TO W/B
ELSE
  SET COLO TO B/N
ENDIF
RETU

PROC MBOXIT
* Syntax.: DO MBOXIT WITH <Top>, <Left>, <Bottom>, <Right>, <Border>, <Clear>
* Notes..: Creates a box at the above locations with <Border>
*
PARAMETERS Top,Left,Bottom,Right,Border,Clear
IF TYPE("Border")#"N"
  Border=1
ENDIF
IF TYPE("Right")#"N".OR.TYPE("Left")#"N".OR.TYPE("Top")#"N".OR.TYPE("Bottom")#"N"
  RETURN
ENDIF
DO CASE
CASE Border=0
  Bframe = "        "
CASE Border=2
  BFrame = "ÉÍ»º¼ÍȺ"
CASE Border=3
  BFrame = "Õ͸³¾ÍÔ³"
CASE Border=4
  BFrame = "ÖÄ·º½ÄÓº"
CASE Border=5
  BFrame = "ÜÜÜÛßßßÛ"
CASE Border=6
  BFrame = "ÜÜÜÞßßßÝ"
CASE Border=7
  BFrame = "ÛÛÛÛÛÛÛÛ"
CASE Border=8
  BFrame = "²²²²²²²²"
CASE Border=9
  BFrame = "±±±±±±±±"
CASE Border=10
  BFrame = "°°°°°°°°"
CASE Border=11
  BFrame = "Ú ¿³¾ÍÔ³"
OTHE
  Bframe = "ÚÄ¿³ÙÄÀ³"
ENDC
IF TYPE("Clear")="C"
  Bframe=Bframe+Clear
ENDIF
DO MBOXCOL
@ Top,left CLEA TO Bottom,Right
IF Border#0
  @ Top,left,bottom,right BOX Bframe
ENDIF
DO MCOL1
RETU
* EOP: Procedure MBOXIT

PROCEDURE MTITLE
* Syntax.: DO MTITLE WITH <Title>, [<starting line>]
* Notes..: Clears line 1 and 2 and centers <Title> on line 1
*
PARAMETER Ttl,start
IF TYPE('Start')<>'N'
  Start=1
ENDIF
@ Start,0
@ Start+1,0
BFrame = 'Ú ¿³¾ÍÔ³'
Cent=INT(len(Ttl)/2)
BotLine=INT(FCOUNT()/6+5)
IF ISCOLOR()
  SET COLOR TO RB/N
ELSE
  SET COLOR TO W/N
ENDIF
@ Start,40-cent-2,Start+1,40+cent+IF(LEN(Ttl)/2=INT(len(Ttl)/2),1,2) BOX Bframe
SET COLO TO W+/N
@ Start,40-cent-1 SAY ' '+Ttl+' '
DO MCOL1
RETU