Simtel MSDOS 1992 December/simtel1292_SIMTEL_1292_Walnut_Creek.iso/msdos/clipper/nannws13.arc/ROUTINES.PRG

Text File | 1987-02-24 | 6KB | 176 lines

FUNCTION ROUNDER
* Syntax:       ROUNDER(value,decimals)
* Notes:    rounds value to specified number of decimal
*               places. Workaround for ROUND() anomaly.
PRIVATE in_num,places,rounded
PARAMETERS in_num,places
SET DECIMALS TO places
rounded = (INT(in_num*10^places+.5))/10^places
RETURN(rounded)


FUNCTION CENTER
* Syntax....:CENTER(<expC>,<expN>)
* Notes.....:Returns the expC centered in the width expN by
*           padding leading blanks.
PRIVATE string, width
PARAMETERS string, width
IF LEN(string) >= width         && Too long to center
   RETURN (string)
ENDIF
RETURN (SPACE(INT(width/2) -  INT(LEN(string)/2)) + string)


FUNCTION GETSTR
* Syntax....:GETSTR()
* Notes.....:Returns and displays a string entered at the current
*           cursor position.  Return terminates input. Unlike
*           GET/READ does not clear previously pending GETs
PRIVATE char, string
STORE "" TO char, string     && initialize to null
DO WHILE .T.
   char = INKEY(0)
   DO CASE
      CASE char = 13                    && Return terminates
         EXIT
      CASE char > 31 .AND. char < 127   && Printable character
         string = string + CHR(char)
         @ ROW(),COL() SAY CHR(char)
      CASE char = 8 .AND. LEN(string) > 0     && Backspace
         @ ROW(),COL()-1 SAY " "
         @ ROW(),COL()-1 SAY ""
         string = SUBSTR(string,1,LEN(string)-1)
   ENDCASE
ENDDO
RETURN (string)


PROCEDURE MULTI_FORM
*
*  Author:   Ira Emus
*  Date      December 1986
*
*  Notes:    Break your dBASE FMT file into separate files
*              that correspond to the individual screen pages
*              in the multi-page file.
*            Remove the READ statements that demarcate pages.
*            Give the files a common name, enumerated, e.g.,
*              T_SCR1.PRG, T_SCR2.PRG, ... ,T_SCR99.PRG.
*            The filenames must have the extension PRG.
*            Compile each file separately.
*            Link the format files explicitly with your program,
*              e.g., PLINK FI MYPROG,T_SCR1,T_SCR2,...
*            Remove the SET FORMAT TO from your calling program
*              and replace it with the following:
*
*              DO multi_form WITH <file name>,<number of pages>
*
*  Clipper does not support format files in the same fashion
*  that dBASE  does.  The main difference is that dBASE allows
*  multi page format files while Clipper only allows single
*  page format files.  Multi page format files may be simulated
*  in Clipper by the use of the following code.
*
PARAMETER scrn,maxpage              && pass name and number of files
pg_count =  1                        && set format file to start with

DO WHILE .T.
  form_no = ltrim(STR(pg_count))    && convert pg_count to form that
  CLEAR    && works in macros.
  SET FORMAT TO &scrn&form_no        && Set format to current form
  READ    && count and then read.
  DO CASE
    CASE LASTKEY() = 27              && if the last key hit was ESCAPE
      EXIT    && then exit loop
    CASE LASTKEY() = 18              && if the last key hit was PgUp then
      IF pg_count > 1                && test for first page and exit,
        pg_count=pg_count - 1        && otherwise decrememt page counter
      ELSE
        EXIT
      ENDIF
    OTHERWISE                        && any other exit key causes the page
     IF pg_count < maxpage          && counter to be incremented until the
        pg_count=pg_count + 1        && last page has been reached at which
      ELSE                          && time the loop is exited
        EXIT
      ENDIF
  ENDCASE
ENDDO
RETURN



FUNCTION MARGPRNT
*
* Author:  Steve Hillbourne
* Date:    January, 1987
*
* Syntax:  MARGPRNT( HARDCR(<expC>) )
*          where <expC> is the string to be wrapped,
*          typically a memofield or output of
*          MEMOEDIT().
*
* Returns: nothing
*
* Notes:   preset margin as desired with SET MARGIN TO,
*          this function then does the printing.
*
PARAMETERS memo
length = LEN(memo)
position = 1
offset = 1
DO WHILE position < length
   * search for carriage return
   IF SUBSTR(memo,position,1) = CHR(13)
      * print line at a time
      ? SUBSTR(memo, offset, position - offset)
      * skip CR/LF and start new line
      offset = position + 2
      position = position + 1
    ENDIF
    position = position + 1
ENDDO
?  SUBSTR(memo, offset)     && print last line
RETURN ''


FUNCTION MARGVAR
*
* Author:  Steve Hillbourne
* Date:    January, 1987
*
* Syntax:  MARGVAR( HARDCR(<expC>) , <expN> )
*          where <expN> is the desired indent
*          and <expC> is the string to be wrapped,
*          typically a memofield or output of
*          MEMOEDIT().
*
* Returns: original text with built-in blanks for "indent",
*          hard CRs (8Dh's), soft CRs (0Dh's), LFs (0Ah's)
*          stripped out
*
* Notes:   SET MARGIN TO 0 before using
*
PARAMETERS memo,margin
length = len(memo)
position = 1
offset = 1
newmemo = ""
DO WHILE position < length
   * search for carriage return
   IF SUBSTR(memo,position,1) = CHR(13)
      * add margin within memofield
      newmemo = newmemo + SPACE(margin) +;
         SUBSTR(memo,offset,position+2-offset)
      * skip CR/LF and move pointer
      offset = position + 2
      position = position + 1
    ENDIF
    position = position + 1
ENDDO
* add last line
newmemo = newmemo + SPACE(margin) + SUBSTR(memo,offset)
RETURN newmemo