home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
nan_news
/
vol1
/
no3
/
routines.prg
< prev
Wrap
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