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

 
Output of file : ARRAYS.PRG contained in archive : JBV1_2.ZIP
* Program: ARRAYS -----------------------------------------------------------
* Author.: Joseph D. Booth
* Purpose: A library of additional ARRAY() manipulation functions
*
* aavg( , ) - average of array
* adec( @,, ) - fill array with decreasing
* numbers
* ainc( @,, ) - fill array with increasing
* numbers
* amax( ) - return highest numeric value
* amin( ) - return lowest numeric value
* atot( ) - total of array
*
* ---------------------------------------------------------------------------
FUNCTION aavg
* Purpose: What is the average value in the array
* Returns: The numeric average
* Syntax.: aavg( [,] ) - Where expC is the array name and
* - expL means include zero's in calculation
PARAMETER whatarray,zeros_too
PRIVATE totnum,k,ctr
IF TYPE("zeros_too") <> "L" && Make sure paramter is passed & valid
zeros_too = .F.
ENDIF
STORE 0 TO totnum,ctr
FOR k=1 TO LEN(whatarray)
totnum = totnum + whatarray[k]
IF whatarray[k] > 0 .OR. zeros_too
ctr = ctr +1
ENDIF
NEXT
RETURN iif( ctr>0, totnum/ctr, 0 )
* ---------------------------------------------------------------------------
FUNCTION adec
* Purpose: Fill an array with decreasing numbers
* Returns: Filled array
* Syntax.: adec( @[,,] ) - where expC is array name
* expN1 is starting value
* expN2 is decrement
PARAMETER whatarray,start_at,decrement
PRIVATE k,j
IF TYPE("start_at") <> "N"
start_at = LEN(whatarray)
ENDIF
IF TYPE("decrement") <> "N"
decrement = 1
ENDIF
FOR k=LEN(whatarray) TO 1 STEP -1
j = LEN(whatarray) -k +1
whatarray[j]=start_at
start_at = start_at - decrement
NEXT
RETURN ""
* ---------------------------------------------------------------------------
FUNCTION ainc
* Purpose: Fill an array with increasing numbers
* Returns: Filled array
* Syntax.: adec( @[,,] ) - where expC is array name
* expN1 is starting value
* expN2 is increment
PARAMETER whatarray,start_at,increment
PRIVATE k
IF TYPE("start_at") <> "N"
start_at = 1
ENDIF
IF TYPE("increment") <> "N"
increment = 1
ENDIF
FOR k=1TO LEN(whatarray)
whatarray[k] = start_at
start_at = start_at + increment
NEXT
RETURN ""
* ---------------------------------------------------------------------------
FUNCTION amax
* Purpose: What is the highest number in an array
* Returns: The value of the maximum element
* Syntax.: amax( ) - Where expC is the array name
PARAMETER whatarray
PRIVATE maxnum,k
maxnum = 0
FOR k=1 TO LEN(whatarray)
maxnum = iif( maxnum < whatarray[k],whatarray[k], maxnum )
NEXT
RETURN maxnum
* ---------------------------------------------------------------------------
FUNCTION amin
* Purpose: What is the lowest number in an array
* Returns: The value of the minimum element
* Syntax.: amax( ) - Where expC is the array name
PARAMETER whatarray
PRIVATE minnum,k
minnum = 999999999999
FOR k=1 TO LEN(whatarray)
minnum = iif( minnum > whatarray[k],whatarray[k], minnum )
NEXT
RETURN minnum
* ---------------------------------------------------------------------------
FUNCTION atot
* Purpose: What is the total value of the array
* Returns: The total value of the array
* Syntax.: aavg( ) - Where expC is the array name
PARAMETER whatarray
PRIVATE totnum,k
totnum = 0
FOR k=1 TO LEN(whatarray)
totnum = totnum + whatarray[k]
NEXT
RETURN totnum
* ---------------------------------------------------------------------------


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : JBV1_2.ZIP
Filename : ARRAYS.PRG
”

  1. Daniel says:
    January 27, 2013 at 3:59 pm

    Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. Joshie says:
    March 18, 2014 at 4:57 pm

    This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. DiskingRound says:
    January 14, 2015 at 10:57 pm

    But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/