home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
01e
/
memoutil.zip
/
MEMOUTIL.PRG
< prev
Wrap
Text File
|
1987-04-01
|
11KB
|
376 lines
* 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