Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : ADVSTR.ZIP
Filename : RJUST1.PRG

 
Output of file : RJUST1.PRG contained in archive : ADVSTR.ZIP

* Program ....: Rjust1.PRG
* Author .....: Chuck Litzell
* Date .......: February 1, 1988
* Version ....: dBASE III PLUS, versions 1.0 and 1.1.
* Notes ......: Walks through a database, right-justifying the
* strings in a field by inserting blanks between
* words. Blanks at the left of the string are not
* expanded; so, left indents will be unaltered.
*
* A string must be at least 75% full to be justified.
* You can change this rule by resetting the constant
* "threshold" below.
*
* Rjust1 is a dBASE-only implementation. (Rjust2 uses
* the same algorithm, but calls Pos.BIN to find spaces
* faster.)
*
* Syntax:
*
* DO Rjust1 WITH , ,
*
* database := name of the database
* field := name of the field to justify
* width := width of justified strings
*
PARAMETERS dbffile, fieldname, width

SET TALK OFF

* ---Program constants.
blank = " "
dirflag = .T.
threshold = .75

* ---Set verbose to .F. to suppress display while the program works.
verbose = .T.

USE &dbffile
GO TOP
DO WHILE .NOT. EOF()
string = &fieldname

* ---Avoid justifying very short lines.
IF LEN(TRIM(string)) < threshold * width
IF verbose
? TRIM(string)
ENDIF
SKIP
LOOP
ENDIF

* ---Toggle dirflag.
dirflag = IIF(dirflag, .F., .T.)

* ---Prepare string by removing spaces from the right. Spaces on the
* ---left are removed, too, but they are remembered and put back
* ---after the rest of the string is justified.
indent = LEN(string) - LEN(LTRIM(string))
string = LTRIM(TRIM(string))

* ---Count the number of spaces in the string.
nblanks = 0
tmp = string
DO WHILE blank $ tmp
nblanks = nblanks + 1
tmp = STUFF(tmp, 1, AT(blank, tmp), "")
ENDDO

* ---Number of spaces that need to be distributed.
ntoput = width - indent - LEN(string)

* ---How many blanks to add at a shot?
atashot = INT(ntoput / nblanks)
remainder = MOD(ntoput, nblanks)

* ---Point to the end of the string we'll begin with.
cptr = IIF(dirflag, 1, LEN(string))

DO WHILE ntoput > 0

* ---Advance (or back up) to the next space.
DO WHILE SUBSTR(string, cptr, 1) <> " "
cptr = cptr + IIF(dirflag, 1, -1)
ENDDO

* ---Number of spaces to insert is atashot+1 if
* ---the remainder hasn't been exhausted.
nsp = atashot
IF remainder > 0
nsp = nsp + 1
remainder = remainder - 1
ENDIF

* ---Insert the spaces.
string = STUFF(string, cptr, 0, SPACE(nsp))

* ---Adjust the pointer to look past the last blank found
* ---and the ones inserted.
cptr = cptr + IIF(dirflag, nsp + 1, -1)
ntoput = ntoput - nsp
ENDDO

* ---Put the string back in the field.
REPLACE &fieldname WITH SPACE(indent) + string
IF verbose
? TRIM(&fieldname)
ENDIF
SKIP
ENDDO
* EOP: Rjust1.PRG