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

 
Output of file : UDFS.PRG contained in archive : UDFS.ZIP
* ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
* º Program.: UDFS º
* º º
* º Author..: Phil Steele - President Phillipps Computer Systems Inc. º
* º º
* º Address.: 52 Hook Mountain Road, Montville NJ 07045 º
* º º
* º Phone...: (201) 575-8575 º
* º º
* º Date....: 03/22/88 º
* º º
* º Notice..: Copyright 1988 Philip Steele, All Rights Reserved º
* º º
* º Version.: CLIPPER AUTUMN 1986 and CLIPPER SUMMER 1987 º
* º º
* º Notes...: A Collection of User Defined Functions º
* º º
* º º
* º These functions are from the book: 64 Clipper User Defined º
* º º
* º Functions - TAB Books written by Phil Steele. º
* º º
* º This collection normally sells for $49.95 or about $0.75 per º
* º º
* º function. º
* º º
* º º
* º I am making these UDFs available to you on a shareware basis. º
* º º
* º º
* º If you find any of these functions useful and wish to change º
* º º
* º them or incorporate tham as-is into your code - feel free to º
* º º
* º do so. Please give me (Phil Steele) credit somewhere in your º
* º º
* º code. º
* º º
* º º
* º Remember these functions are NOT free - however only pay for º
* º º
* º those that you use. If you only like and use ONE function º
* º º
* º send me $0.75, if you like and use two of the 64 functions º
* º º
* º send $1.50, I feel that this is a very fair method of payment. º
* º º
* º º
* º For amounts of $5.00 or more I accept Master card or Visa. º
* º º
* º º
* º If you wish an explanation of how or why the UDFs work as º
* º º
* º they do you can purchase the book. If you can't find the º
* º º
* º book you can order it directly from either TAB books or me. º
* º º
* º º
* º Enjoy these UDFs and good luck. º
* º Phil Steele º
* º º
* ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
*
* Calling code:
* SAMPLE1
* ...
CLEAR
STORE DATE() TO Birthday, StartDay
NDays = 7671 && 21 Years
@ 10,12 GET Birthday
@ 12,12 GET StartDay VALID DifDate(StartDay, BirthDay, NDays)
READ
* ...

FUNCTION DIFDATE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: DIFDATE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function insures that DATE1 is º
*º X days greater than DATE2 º
*º Parameters: DATE1, DATE2 - Dates to be compared º
*º NUMOFDAYS - The number of days º
*º DATE1 must be greater º
*º than DATE2 for a .T. º
*º result. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Date1, Date2, NumOfDays
PRIVATE Date1, Date2, NumOfDays
IF Date1 >= Date2 + NumOfDays
RETURN(.T.)
ELSE
RETURN(.F.)
ENDIF
*END:DIFDATE
************************************************************************
* Calling code:
* SAMPLE2
* ...
Job = " "
ValidJobs = "DRV,HLP,LDR,GUARD,SPVSR,MNGR"
@ 10,12 GET Job VALID MatchStr(Job, ValidJobs)
READ
* ...

FUNCTION MATCHSTR
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: MATCHSTR º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function insures that VAR1 is º
*º contained in STR1 º
*º Parameters: VAR1 - The variable to be compared º
*º STR1 - A group of string variables º
*º separated by "," º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Var1, Str1
PRIVATE Var1, Str1
Str1 = Str1 + ",,"
DO WHILE .T.
Comma = AT(",", Str1)
IF Comma = 0 .OR. LEN(Str1) < 2
RETURN(.F.)
ENDIF
SStr = SUBSTR(Str1, 1, Comma - 1)
Str1 = SUBSTR(Str1, Comma + 1)
IF Var1 = SStr
RETURN(.T.)
ENDIF
ENDDO
*END:MATCHSTR
************************************************************************
* Calling code:
* SAMPLE3
* ...
* GET ...
* GET ...
BDate = DATE()
@ 10,12 GET BDate VALID BirthAge(BDate, 10, 3)
* GET ...
* GET ...
READ
* ...

FUNCTION BIRTHAGE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: BIRTHAGE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function checks for a valid date º
*º and displays the elapsed years. º
*º Parameters: BDATE - The date checked for validity, º
*º and used to compute elapsed years. º
*º X and Y - The coordinated used to º
*º display the elapsed years. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS BDate, X, Y
PRIVATE BDate, X, Y
IF MONTH(BDate) < 1
RETURN(.T.)
ENDIF
EYears = (DATE() - BDate) / 365.25
@ X,Y SAY STR(EYears,2,0)
RETURN(.T.)
*END:BIRTHAGE
************************************************************************
* Calling code:
* SAMPLE4
* ...
CLEAR
STORE 0 TO Number, Total
DO WHILE Number > -1
@ 12,12 GET Number VALID NumSum(Number,22,10)
READ
ENDDO
* ...

FUNCTION NUMSUM
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: NUMSUM º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes a sum of numbersº
*º and displays the total while the data º
*º is being entered. º
*º Parameters: Number - Entered number. º
*º X and Y - The coordinates for the º
*º computed total. º
*º Note......: Total must be defined in the calling º
*º procedure. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Number, X, Y
PRIVATE Number, X, Y
Total = Number + Total
@ X,Y SAY Total PICTURE "99,999.99"
RETURN(.T.)
************************************************************************
* Calling code:
* SAMPLE2
* ...
N = 1
USE EMPLOYEE
INDEX ON NoZero(Ord) TO TEMPORD
DO WHILE .NOT. EOF()
@ N, 1 SAY EmpName
@ N,31 SAY EmpAddress
SKIP
IF N = 23
WAIT
CLEAR
N = 1
ENDIF
ENDDO
* ...

FUNCTION NOZERO
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: NOZERO º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function indexes a database in º
*º ascending order based on the numeric º
*º field Zip. However a zero value will º
*º come after 99999 in the index. º
*º Parameters: Zip - A five position numeric field in º
*º the database. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Zip
IF Zip = 0
RETURN(99999)
ELSE
RETURN(Zip)
ENDIF
*END:NOZERO
************************************************************************
* Calling code:
* SAMPLE2
* ...
SET COLOR TO W+/B,R+/B,B,B
CLEAR
@ 12,38 SAY "I N D E X I N G"
@ 18,10 TO 23,69 DOUBLE
@ 21,11 TO 21,68 DOUBLE
@ 21,10 SAY "Ì"
@ 21,69 SAY "¹"
@ 19,24 SAY "P E R C E N T C O M P L E T E"
@ 20,14 SAY "0 10 20 30 40 50"
@ 20,44 SAY "60 70 80 90 100"
USE TEST
PUBLIC Tot
Tot = RECCOUNT()
SET COLOR TO R+/B,W+/B,B,B
INDEX ON Bar(AA1+AA2+AA3) TO TEMP1
* ...

FUNCTION BAR
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: BAR º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function displays a bar graph º
*º depicting the progress of an index º
*º operation. º
*º Parameters: IFIELD - The field(s) to index on. º
*º º
*º Note1: The function "BAR" must be present every º
*º time you use the index - even if you are º
*º not reindexing the file. º
*º º
*º Note2: The index is increased in size due to the º
*º UDF BAR - take note. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS IField
PRIVATE IField
Pct = IIF(RECNO() @ 22,14 SAY REPLICATE("Û",(Pct/2)+1) && CHR(219)
RETURN(IField)
*END:BAR
************************************************************************
* Calling code:
* SAMPLE2
* ...
@ 12,38 SAY "I N D E X I N G"
USE TEST
INDEX ON Inverse(Empname) TO TEMP1
* ...

FUNCTION INVERSE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: INVERSE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function generates an inverse º
*º alphabetic index. º
*º Parameters: INFIELD - The field(s) to index on. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS InField
PRIVATE InField, NLoop
NewString = " "
FOR NLoop = 1 TO 30
NewChar = UPPER(SUBSTR(InField,NLoop,1))
Num = ASC(NewChar) - 78
Num = IIF(Num>=0, Num+1, Num)
Num = 77 - Num
Num = IIF(Num<=78, Num+1, Num)
NewString = NewString + CHR(Num)
NEXT
NewString = LTRIM(NewString) +;
SPACE(LEN(InField) - LEN(LTRIM(NewString)))
RETURN(NewString)
*END:INVERSE
************************************************************************
* Calling code:
* SAMPLE2
* ...
@ 12,38 SAY "I N D E X I N G"
USE TEST
INDEX ON FastInv(Empname) TO TEMP1
* ...

FUNCTION FASTINV
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: FASTINV º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function generates an inverse º
*º alphabetic index of the first 4 º
*º characters of a string. º
*º Parameters: INFIELD - The field(s) to index on. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS InField
PRIVATE InField, NLoop
NewString = " "
MaxLook = IIF(LEN(TRIM(InField))>4, 4, LEN(TRIM(InField)))
FOR NLoop = 1 TO MaxLook
NewChar = UPPER(SUBSTR(InField,NLoop,1))
Num = ASC(NewChar) - 78
Num = IIF(Num>=0, Num+1, Num)
Num = -Num + 77
Num = IIF(Num<=78, Num+1, Num)
NewString = NewString + CHR(Num)
NEXT
NewString = LTRIM(NewString) + SPACE(LEN(InField) - LEN(LTRIM(NewString)))
RETURN(NewString)
*END:FASTINV
************************************************************************
* Calling code:
* SAMPLE2
* ...
@ 12,38 SAY "I N D E X I N G"
USE TEST
INDEX ON RevNumb(ZIP, 5) TO TEMP1
* ...

FUNCTION REVNUMB
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: REVNUMB º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function indexes numberic fields º
*º decending. º
*º Parameters: INFIELD - The field(s) to index on. º
*º LENNUM - The length of InField. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS InField, LenNum
PRIVATE InField, LenNum
SNines = REPLICATE("9", LenNum)
Nines = VAL(SNines)
RETURN(Nines - InField)
*END:REVNUMB

* Calling code:
* SAMPLE2
* ...
@ 12,38 SAY "I N D E X I N G"
USE TEST
INDEX ON RevDate(EmpDate) TO TEMP1
* ...
************************************************************************
FUNCTION REVDATE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: REVDATE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function indexes dates decending. º
*º Parameters: INDATE - The Date to index on. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS InDate
PRIVATE InDate
NewDate = 99999999 - VAL(DTOS(InDate))
RETURN(NewDate)
* For the Autumn 1986 release of Clipper
* Use the following
* NewDate = YEAR(InDate)* 10000 + MONTH(InDate) * 100 + DAY(InDate)
* NewDate = 99999999 - NewDate
* RETURN(NewDate)
*END:REVDATE
************************************************************************
* Calling code:
* SAMPLE2
* ...
Mess1 = "DO YOU WISH TO"
Mess2 = "DELETE THIS RECORD?"
YNE = " "
SET COLOR TO W+/B,B/W,B,B
CLEAR
YNE = YESORN(Mess1, Mess2)
* ...

FUNCTION YESORN
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: YESORN º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns a box where the º
*º a user can answer the question in the º
*º box with a Y or N - the Y or N is then º
*º returned. º
*º Parameters: Mess1 - The first message line to be º
*º displayed. º
*º Mess2 - The second message line to be º
*º displayed. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Mess1, Mess2
PRIVATE Special,B1,B2,NewColor
NewColor = "W+/R,N/W,B,B,N/W"
Special = CHR(218)+CHR(196)+CHR(183)+CHR(186)+;
CHR(188)+CHR(205)+CHR(212)+CHR(179)+CHR(32)
* ÚÄÄÄ·
* ³ º
* ÔÍÍͼ
DoubleBox = CHR(201)+CHR(205)+CHR(187)+CHR(186)+;
CHR(188)+CHR(205)+CHR(200)+CHR(186)+CHR(32)
* ÉÍÍÍ»
* º º
* ÈÍÍͼ
YorN = 0
B2 = 21
SAVE SCREEN
SET CURSOR OFF
* Autumn 1986 Release Use CALL _setctyp WITH word(0)
SET MESSAGE TO
IF LEN(TRIM(Mess2)) = 0
B1 = LEN(TRIM(Mess1))
B2 = 20 + (41-B1)/2
ENDIF
SET COLOR TO "N/N"
@ 8,62 CLEAR TO 15,63
@ 15,21 CLEAR TO 15,63
SET COLOR TO &NewColor
@ 7,19,14,61 BOX DoubleBox
@ 8,B2 SAY TRIM(Mess1)
@ 9,21 SAY TRIM(Mess2)
@ 11,27,13,33 BOX Special
@ 11,48,13,53 BOX Special
@ 12,28 PROMPT " Yes "
@ 12,49 PROMPT " No "

MENU TO YorN
IF YorN = 1
YNE = "Y"
ELSE
YNE = "N"
ENDIF
RESTORE SCREEN
SET CURSOR ON
* Autumn 1986 Release Use CALL _setctyp WITH word(1)
RETURN(YNE)
*END:YESORN
************************************************************************
* Calling code:
* SAMPLE2
* ...
SET COLOR TO W+/B,N/W,B,B
CLEAR
Ret = .F.
Shadow = .T.
Top = 10
Left = 20
Bot = 14
Right = 60
SD = "D"
BColor = "W+/R"
Ret = BOXES(Top, Left, Bot, Right, Shadow, SD, BColor)
SET COLOR TO W+/B,N/W,B,B
* ...

FUNCTION BOXES
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: BOXES º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns a box with a º
*º drop shadow. º
*º Parameters: Top - The top of the box. º
*º Left - The left corner of the box. º
*º Bot - The bottom of the box. º
*º Right - The right corner of the box. º
*º Shadow - Should a shadow be drawn? º
*º SD - Draw a single "S", or double º
*º "D" box. º
*º BColor - Color of the box. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETER T, L, B, R, S, SD, BC
PRIVATE T, L, B, R, S, SD, BC, Kind
DoubleBox = CHR(201)+CHR(205)+CHR(187)+CHR(186)+;
CHR(188)+CHR(205)+CHR(200)+CHR(186)+CHR(32)
* ÉÍÍÍ»
* º º
* ÈÍÍͼ
SingleBox = CHR(218)+CHR(196)+CHR(191)+CHR(179)+;
CHR(217)+CHR(196)+CHR(192)+CHR(179)+CHR(32)
* ÚÄÄÄ¿
* ³ ³
* ÀÄÄÄÙ
Kind = IIF(SD="S", SingleBox, DoubleBox)
IF S
SET COLOR TO N/N
@ T+1, R+1 CLEAR TO B+1, R+2
@ B+1, L+2 CLEAR TO B+1, R+2
ENDIF
SET COLOR TO &BC
@ T, L, B, R BOX Kind
RETURN(.T.)
*END:BOXES
************************************************************************
* Calling code:
* SAMPLE2
* ...
SET COLOR TO W+/B,N/W,B,B
CLEAR
Message = "This is the message to center"
@ 12, 0 SAY MessCent(Message, 80)
@ 14, 45 SAY MessCent(Message, 30)
* ...

FUNCTION MESSCENT
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: MESSCENT º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns a centered º
*º message. º
*º Parameters: Mess - The message to center. º
*º MaxLen - The maximum length of the º
*º message. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETER Mess, MaxLen
PRIVATE Mess, MaxLen
Mess = LTRIM(TRIM(Mess))
RETURN (REPLICATE(" ", (MaxLen-LEN(Mess))/2) + Mess)
RETURN(.T.)
*END:MESSCENT
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
SET DECIMALS TO 6
DECLARE ArrayN[10]
ArrayN[1] = 87
ArrayN[2] = 79
ArrayN[3] = 97
ArrayN[4] = 83
ArrayN[5] = 90
ArrayN[6] = 85
ArrayN[7] = 51
ArrayN[8] = 98
ArrayN[9] = 99
ArrayN[10] = 88
TheSum = ASum(ArrayN)
? TheSum
* The Sum of the array = 857.0
* ...

FUNCTION ASUM
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: ASUM º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function sums the elements of an º
*º array. º
*º Parameters: ArrayN - The array containing numeric º
*º elements to sum. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS ArrayN
PRIVATE J, N, Tot
STORE 0 TO J, Tot
J = LEN(ArrayN)
FOR N = 1 TO J
Tot = Tot + ArrayN[N]
Next
RETURN(Tot)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
SET DECIMALS TO 6
DECLARE ArrayN[10]
ArrayN[1] = 87
ArrayN[2] = 79
ArrayN[3] = 97
ArrayN[4] = 83
ArrayN[5] = 90
ArrayN[6] = 85
ArrayN[7] = 51
ArrayN[8] = 98
ArrayN[9] = 99
ArrayN[10] = 88
TheAvg = AAvg(ArrayN)
? TheAvg
* The Avg of the array = 85.7
* ...

FUNCTION AAVG
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: AAVG º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the average of º
*º the elements in the array. º
*º Parameters: ArrayN - The array containing numeric º
*º elements to average. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS ArrayN
PRIVATE J, N, Tot, Avg
STORE 0 TO J, Tot, Avg
J = LEN(ArrayN)
FOR N = 1 TO J
Tot = Tot + ArrayN[N]
Next
Avg = Tot / J
RETURN(Avg)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
SET DECIMALS TO 6
DECLARE ArrayN[10]
ArrayN[1] = 87
ArrayN[2] = 79
ArrayN[3] = 97
ArrayN[4] = 83
ArrayN[5] = 90
ArrayN[6] = 85
ArrayN[7] = 51
ArrayN[8] = 98
ArrayN[9] = 99
ArrayN[10] = 88
TheVar = AVar(ArrayN)
? TheVar
* The Variance of the array = 193.122222
* ...

FUNCTION AVAR
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: AVAR º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the variance of º
*º the elements of an array º
*º Parameters: ArrayN - The array containing numeric º
*º elements to compute the º
*º variance of. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS ArrayN
PRIVATE J, N, Tot, SSq, Avg, Var
STORE 0 TO J, Tot, SSq, Avg, Var
J = LEN(ArrayN)
FOR N = 1 TO J
Tot = Tot + ArrayN[N]
SSq = SSq + (ArrayN[N] * ArrayN[N])
Next
Var = (SSq - (Tot * Tot) / J) / (J - 1)
RETURN(Var)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
SET DECIMALS TO 6
DECLARE ArrayN[10]
ArrayN[1] = 87
ArrayN[2] = 79
ArrayN[3] = 97
ArrayN[4] = 83
ArrayN[5] = 90
ArrayN[6] = 85
ArrayN[7] = 51
ArrayN[8] = 98
ArrayN[9] = 99
ArrayN[10] = 88
TheSD = ASD(ArrayN)
? TheSD

* The Std Dev of the array = 13.896842
* ...

FUNCTION ASD
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: ASD º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the standard º
*º deviation of the elements of an array º
*º Parameters: ArrayN - The array containing numeric º
*º elements to compute the º
*º standard deviation of. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS ArrayN
PRIVATE J, N, Tot, SSq, Avg, Var, Std
* Note: If you already have a variance function
* just use the next line without the comment.
* RETURN(AVar(ArrayN)^0.5)
STORE 0 TO J, Tot, SSq, Avg, Var, Std
J = LEN(ArrayN)
FOR N = 1 TO J
Tot = Tot + ArrayN[N]
SSq = SSq + (ArrayN[N] * ArrayN[N])
Next
Var = (SSq - (Tot * Tot) / J) / (J - 1)
Std = Var ^ 0.5
RETURN(Std)
************************************************************************
*Calling code:
* SAMPLE2
* ...
DECLARE ArrayN[9]
ArrayN[1] = "ABC"
ArrayN[2] = "AVD"
ArrayN[3] = "VEF"
ArrayN[4] = "BER"
ArrayN[5] = "AAA"
ArrayN[6] = "XEW"
ArrayN[7] = "EWW"
ArrayN[8] = "A"
ArrayN[9] = "BBG"
First = AMin(ArrayN)
? First

* The minimum value in the array is "A"
* ...

FUNCTION AMIN
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: AMIN º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function finds the element of the º
*º array containing the lowest value, and º
*º returns its value. º
*º Parameters: Array - The array containing elements º
*º which this function will use º
*º to find the lowest. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Array
PRIVATE N, X, J
N = LEN(Array)
X = Array[1]
FOR J = 2 TO N
X = IIF(Array[J] NEXT
RETURN(X)
************************************************************************
*Calling code:
* SAMPLE2
* ...
DECLARE ArrayN[9]
ArrayN[1] = "ABC"
ArrayN[2] = "AVD"
ArrayN[3] = "VEF"
ArrayN[4] = "BER"
ArrayN[5] = "AAA"
ArrayN[6] = "XEW"
ArrayN[7] = "EWW"
ArrayN[8] = "A"
ArrayN[9] = "BBG"
Last = AMax(ArrayN)
? Last

* The maximum value in the array is "XEW"
* ...

FUNCTION AMAX
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: AMAX º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function finds the element of the º
*º array containing the highest value, º
*º and returns its value. º
*º Parameters: Array - The array containing elements º
*º which this function will use º
*º to find the highest. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Array
PRIVATE N, X, J
N = LEN(Array)
X = Array[1]
FOR J = 2 TO N
X = IIF(Array[J]>X, Array[J], X)
NEXT
RETURN(X)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
HexNum = "AAAA"
Dec = DecEquiv(HexNum)
? Dec
* The Decimal equivalent is 43690
* ...

FUNCTION DECEQUIV
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: DECEQUIV º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts a hexadecimal º
*º number (0-FFFF) to a decimal number. º
*º Parameters: HexNum - The hexadecimal number to be º
*º converted into a decimal º
*º number. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS HexN
PRIVATE Ans, AllHex, N1, N2, N3, N4
AllHex = "123456789ABCDEF"
N1 = AT(SUBSTR(HexN,1,1), AllHex)
N2 = AT(SUBSTR(HexN,2,1), AllHex)
N3 = AT(SUBSTR(HexN,3,1), AllHex)
N4 = AT(SUBSTR(HexN,4,1), AllHex)
Ans = (N1 * 4096) + (N2 * 256) + (N3 * 16) + N4
RETURN(Ans)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
DecNum = 43690
Hex = HexEquiv(DecNum)
? Hex
* The Hexadecimal equivalent is AAAA
* ...

FUNCTION HEXEQUIV
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: HEXEQUIV º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts a decimal º
*º number (0-65535) to a hexadecimal º
*º number. º
*º Parameters: DecNum - The decimal number to be º
*º converted into a hexadecimal º
*º number. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS DecN
PRIVATE Ans, N1, N2, N3, N4, M1, M2, M3
N1 = INT(DecN / 4096)
M1 = N1 * 4096
N2 = INT((DecN - M1) / 256)
M2 = N2 * 256
N3 = INT((DecN - M1 - M2) / 16)
M3 = N3 * 16
N4 = INT(DecN - M1 - M2 - M3)
Ans = Let(N1) + Let(N2) + Let(N3) + Let(N4)
RETURN(Ans)


FUNCTION LET
PARAMETER Num
IF Num < 10 .AND. Num > 0
RETURN(STR(Num,1,0))
ENDIF
DO CASE
CASE Num = 0
RETURN("0")
CASE Num = 10
RETURN("A")
CASE Num = 11
RETURN("B")
CASE Num = 12
RETURN("C")
CASE Num = 13

RETURN("D")
CASE Num = 14
RETURN("E")
CASE Num = 15
RETURN("F")
ENDCASE
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
Mat = 27000
Now = 10000
Yrs = 12
NRate = Rate(Mat, Now, Yrs)
? NRate
* NRate Should be .0831 or 8.31%
* ...

FUNCTION RATE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: RATE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the interest º
*º rate an investments earns. º
*º Parameters: Mat - The dollar amount the investment º
*º is worth at maturity. º
*º Now - The dollar amount the investment º
*º is worth at the start. º
*º Yrs - The number of years required for º
*º the investment to go from a º
*º starting value of Now to a final º
*º value of Mat. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Mat, Now, Yrs
PRIVATE N, D, M , R
M = Yrs * 12
N = Mat
D = Now
R = ((N / D) ^ (1 / M)) - 1
RETURN(R*12)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
Int = 10
Mat = 20000
Now = 10000
NMonth = Term(Int, Mat, Now)
? NMonth
* NMonth Should be 83.52
* ...

FUNCTION TERM
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: TERM º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the time º
*º required for an investment to grow º
*º from a value of Now to a value of Mat º
*º at a compound interest rate of Int. º
*º Parameters: Mat - The dollar amount the investment º
*º is worth at maturity. º
*º Now - The dollar amount the investment º
*º is worth at the start. º
*º Int - The compound interest rate which º
*º the investment in invested at. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Int, Mat, Now
PRIVATE N, D, I
I = Int * 0.01 / 12
N = LOG(Mat / Now)
D = LOG(1 + I)
RETURN(N/D)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
Int = 9.5
Mat = 200000
Dep = 2000
NYears = Term2(Dep, Int, Mat)
? NYrs
* NYrs Should be 25.91
* ...

FUNCTION TERM2
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: TERM2 º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the time º
*º required for a periodic investment º
*º to grow to a value of Mat at a º
*º compound interest rate of Int. º
*º Parameters: Mat - The dollar amount the investment º
*º is worth at maturity. º
*º Dep - The dollar amount of the º
*º periodic investment. º
*º Int - The compound interest rate which º
*º the investment in invested at. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Dep, Int, Mat
PRIVATE N, D
IR = Int * 0.01
N = LOG(1 + (Mat * IR / Dep))
D = LOG(1 + IR)
RETURN(N/D)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
Int = 11.5
Prin = 250000
Yrs = 30
MPay = Pmts(Int, Prin, Yrs)
? MPay
* MPay Should be $2,475.73
* ...

FUNCTION PMTS
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: PMTS º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the monthly º
*º payment due on a straight interest º
*º loan such as a mortgage. º
*º Parameters: Int - The loan interest rate. º
*º Prin - The total amount of the loan. º
*º Yrs - The number of years the loan º
*º is for. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Int, Prin, Yrs
PRIVATE N, D, I, Y
Y = Yrs * 12
I = Int * 0.01 / 12
D = 1-(I + 1) ^ -Y
RETURN(Prin*I/D)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
Int = 10
Dep = 2000
Yrs = 20
NFV = FV(Dep, Int, Yrs)
? NFV
* NFV Should be $114,550
* ...

FUNCTION FV
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: FV º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the future º
*º value of a periodic investment at a º
*º constant interest rate. º
*º Parameters: Int - The interest rate. º
*º Dep - The periodic investment amount. º
*º Yrs - The number of years the Dep is º
*º made over. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Dep, Int, Yrs
PRIVATE N, D
D = Int * 0.01
N = ((1 + D) ^ Yrs) - 1
RETURN(N*Dep/D)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
Int = 9.5
Pay = 50000
Yrs = 20
NPV = PV(Int, Pay, Yrs)
? NPV
* NPV Should be $440,619.11
* ...

FUNCTION PV
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: PV º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the present º
*º value of a periodic payment invested º
*º at a constant interest rate. º
*º Parameters: Int - The interest rate. º
*º Pay - The periodic payment amount. º
*º Yrs - The number of years the Pay is º
*º made over. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Int, Pay, Yrs
PRIVATE N, D, I
D = Int * 0.01
N = 1 - ((1 + D) ^ -Yrs)
RETURN(Pay*N/D)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
Cost = 10000
Sal = 2000
Life = 5
Yr = 2
SDep = SL (Cost, Sal, Life)
? SDep
* SDep Should be 1600
* ...

FUNCTION SL
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: SL º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the annual º
*º depreciation of an asset with salvage º
*º value of Sal over a useful life of º
*º Life. º
*º Parameters: Cost - Cost of the asset. º
*º Sal - Salvage value of the asset. º
*º Life - Useful life of the asset. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS C, S, L
PRIVATE C, S
N = (C - S)
RETURN(N/L)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
Cost = 10000
Sal = 2000
Life = 5
Yr = 2
YDep = SYD(Cost, Sal, Life, Yr)
? YDep
* YDep Should be 2133
* ...

FUNCTION SYD
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: SYD º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the yearly (Yr) º
*º depreciation of an asset with salvage º
*º value of Sal over a useful life of º
*º Life. º
*º Parameters: Cost - Cost of the asset. º
*º Sal - Salvage value of the asset. º
*º Life - Useful life of the asset. º
*º Yr - The year you wish to compute º
*º the depreciation for. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS C, S, L, Y
PRIVATE C, S, L, Y
N = (C - S) * (L - Y + 1)
D = (L * (L + 1) / 2)
RETURN(N/D)
************************************************************************
*Calling code:
* SAMPLE2
* ...
CLEAR
Cost = 10000
Sal = 2000
Life = 5
Yr = 2
DDep = DDL(Cost, Sal, Life, Yr)
? DDep
* DDep Should be 2400
* ...

FUNCTION DDL
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: DDL º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the yearly (Yr) º
*º depreciation of an asset with salvage º
*º value of Sal over a useful life of º
*º Life. º
*º Parameters: Cost - Cost of the asset. º
*º Sal - Salvage value of the asset. º
*º Life - Useful life of the asset. º
*º Yr - The year you wish to compute º
*º the depreciation for. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS C, S, L, Y
PRIVATE C, S, L, Y, N, NewTotal, TotDep
CLEAR
DECLARE YrDep[L]
NewTotal = C
TotDep = 0
FOR N = 1 TO Y
YrDep[N] = NewTotal * 2 / L
NewTotal = NewTotal - YrDep[N]
TotDep = IIF(N<=Y, TotDep+YrDep[N], TotDep)
NEXT
RETURN(YrDep[Y])
************************************************************************
*Calling code:
*SAMPLE2
* ...
DECLARE AllFiles[ADIR("*.DBF")]
NumOfFiles = ADIR("*.DBF", ALLFILES)
? NumOfFiles
FOR J = 1 TO NumOfFiles
? AllFiles[J]
NEXT
WAIT
ASORT(AllFiles)
FOR J = 1 TO NumOfFiles
? AllFiles[J]
NEXT
*...

FUNCTION ASORT
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: ASORT º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns an array sorted º
*º in ascending order. º
*º Parameters: AName - The array to sort. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS AName
PRIVATE J, K, C, ALen
ALen = LEN(AName)
FOR J = 1 TO ALen - 1
FOR K = J+1 TO ALen
IF AName[K] < AName[J]
C = AName[K]
AName[K] = AName[J]
AName[J] = C
ENDIF
NEXT
NEXT
RETURN(.T.)
************************************************************************
Calling code:
*SAMPLE2
*...
SELECT A
Rank = ALLTRIM(A->EmpRank)
@ 12, 12 SAY Rank PICTURE "@!"
*...

FUNCTION ALLTRIM
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: ALLTRIM º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns a string with º
*º leading and trialing blanks revoved. º
*º Parameters: Str - The string to trim. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETER Str
RETURN (LTRIM(TRIM(Str)))
*END:ALLTRIM
************************************************************************
* SAMPLE2
* ...
CLEAR
X = " 1 "
Y = " 22"
@ 12,12 SAY X PICTURE "!!!"
@ 12,15 SAY "/"
@ 12,16 SAY Y PICTURE "!!!"

@ 14,12 SAY NTRIM(X,3) PICTURE "!!!"
@ 14,15 SAY "/"
@ 14,16 SAY LTRIM(Y) PICTURE "!!!"
* ...

FUNCTION NTRIM
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: NTRIM º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns a right º
*º justified pseudo-numeric field º
*º Parameters: PNum - The pseudo-numeric variable º
*º PLen - The field length. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS PNum, PLen
RETURN(STR(VAL(PNum),PLen,0))
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
Y = 22
@ 12,12 SAY X PICTURE "9999"
@ 12,16 SAY "/"
@ 12,17 SAY Y PICTURE "9999"

SX = ZFILL(X,4)
SY = ZFILL(Y,4)
@ 14,12 SAY SX PICTURE "!!!!"
@ 14,16 SAY "/"
@ 14,17 SAY SY PICTURE "!!!!"
* ...

FUNCTION ZFILL
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: ZFILL º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function display a numeric field º
*º justified with leading zeros. º
*º Parameters: Num - The numeric field. º
*º Size - The total field length. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Num, Size
PRIVATE NewNum, N
NewNum = LTRIM(STR(Num,19,0))
N = LEN(NewNum)
NewNum = REPLICATE("0", Size - N) + NewNum
RETURN(NewNum)
************************************************************************
* SAMPLE2
* ...
FName = " PHIL"
LName = " STEELE"
Name = LJust(FName) + LJust(LName)
? Name
? Len(Name)
* Len(Name) SHOULD = 18
* ...

FUNCTION LJUST
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: LJUST º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function left justifies a string. º
*º Parameters: InStr - The string to left justify. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS InStr
PRIVATE N, OutStr
N = LEN(InStr)
OutStr = LTRIM(InStr)
OutStr = OutStr + REPLICATE(" ", N-LEN(OutStr))
RETURN(OutStr)
************************************************************************
* SAMPLE2
* ...
Str = "ABCDEFGH"
NewStr = Left(STR,5)
? NewStr
* ...

FUNCTION LEFT
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: LEFT º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns the left Num of º
*º characters. º
*º Parameters: Str - The string to return the left º
*º Num of characters from. º
*º Num - The number of chacters to return º
*º from the left of the string. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Str, Size
PRIVATE NewStr
NewStr = SUBSTR(Str,1,Size)
RETURN(NewStr)
************************************************************************
* SAMPLE2
* ...
Str = "ABCDEFGH"
NewStr = Right(STR,5)
? NewStr
* ...

FUNCTION RIGHT
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: RIGHT º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns the right Num of º
*º characters. º
*º Parameters: Str - The string to return the right º
*º Num of characters from. º
*º Num - The number of chacters to return º
*º from the right of the string. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Str, Size
PRIVATE Start, NewStr
Start = LEN(Str) - Size + 1
NewStr = SUBSTR(Str,Start)
RETURN(NewStr)
************************************************************************
* SAMPLE2
* ...
SET DEVICE TO PRINT
N = 0
Esc = CHR(27)
Start = Esc + "*p0x0Y"
@ N,0 SAY "&Start"
HLine(1,2,6,2,N)
EJECT
SET DEVICE TO SCREEN
* ...

FUNCTION HLINE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: HLINE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function draws a horizontal line º
*º on a laser printer. º
*º Parameters: StartD - The starting position of the º
*º line down from the top of the º
*º page in inches. º
*º StartL - The starting position of the º
*º line in from the left of the º
*º page in inches. º
*º HLen - The length of the horizontal º
*º line in inches. º
*º LWidth - The width of the horizontal º
*º line in 1/300's of an inch. º
*º J - The line current line number º
*º where printing is occurring. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS StartD, StartL, HLen, LWidth, J
PRIVATE CompD, CompL, CLen, J, Esc
Esc = CHR(27)
CompD = 300 * StartD - 150
CompD = IIF(CompD<0, 0, CompD)
CompL = 300 * StartL - 75
CompL = IIF(CompL<0, 0, CompL)
CLen = 300 * HLen
HorLine = Esc + "*p" + STR(CompD,5,0) + "y" + STR(CompL,5,0) + "X" + ;
Esc + "*c" + STR(LWidth,2,0) + "b" + STR(CLen, 5,0) + "a0P"
@ J,0 SAY "&HorLine"
RETURN(.T.)
************************************************************************
* SAMPLE2
* ...
SET DEVICE TO PRINT
N = 0
Esc = CHR(27)
Start = Esc + "*p0x0Y"
@ N,0 SAY "&Start"
VLine(1,2,6,2,N)
EJECT
SET DEVICE TO SCREEN
* ...

FUNCTION VLINE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: VLINE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function draws a horizontal line º
*º on a laser printer. º
*º Parameters: StartD - The starting position of the º
*º line down from the top of the º
*º page in inches. º
*º StartL - The starting position of the º
*º line in from the left of the º
*º page in inches. º
*º HLen - The length of the vertical º
*º line in inches. º
*º LWidth - The width of the vertical º
*º line in 1/300's of an inch. º
*º J - The line current line number º
*º where printing is occurring. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS StartD, StartL, HLen, LWidth, J
PRIVATE CompD, CompL, CLen, J, Esc
Esc = CHR(27)
CompD = 300 * StartD - 150
CompD = IIF(CompD<0, 0, CompD)
CompL = 300 * StartL - 75
CompL = IIF(CompL<0, 0, CompL)
CLen = 300 * VLen
VerLine = Esc + "*p" + STR(CompD,5,0) + "y" + STR(CompL,5,0) + "X" + ;
Esc + "*c" + STR(LWidth,2,0) + "a" + STR(CLen, 5,0) + "b0P"
@ J,0 SAY "&VerLine"
RETURN(.T.)
************************************************************************
* SAMPLE2
* ...
SET DEVICE TO PRINT
N = 0
Esc = CHR(27)
Start = Esc + "*p0x0Y"
@ N,0 SAY "&Start"
HPBox(1,2,5,3,2,N)
EJECT
SET DEVICE TO SCREEN
* ...

FUNCTION HPBOX
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: HPBOX º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function draws a horizontal line º
*º on a laser printer. º
*º Parameters: StartD - The starting position of the º
*º box down from the top of the º
*º top of the page in inches. º
*º StartL - The starting position of the º
*º box in from the left of the º
*º page in inches. º
*º EndD - The ending position of the º
*º box down from the top of the º
*º top of the page in inches. º
*º EndR - The ending position of the º
*º box in from the left of the º
*º page in inches. º
*º LWidth - The width of the vertical º
*º line in 1/300's of an inch. º
*º J - The line current line number º
*º where printing is occurring. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS StartD, StartL, EndD, EndR, LWidth, J
PRIVATE HStart, HLen, VStart, VLen, HStart2, VStart2, Esc
Esc = CHR(27)
HStart = StartD
HLen = EndD - StartD
VStart = StartL
VLen = EndR - StartL
HStart2 = EndD
VStart2 = EndR
HLine(HStart, VStart, VLen, LWidth, J)
VLine(HStart, VStart, HLen, LWidth, J)
HLine(HStart2, VStart, VLen, LWidth, J)
VLine(HStart, VStart2, HLen, LWidth, J)
RETURN(.T.)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 3
Y = 6
Z = DIV(Y,X)
?Z
X = 0
Z = DIV(Y,X)
?Z
X = 3
Y = 0
Z = DIV(Y,X)
?Z
X = 0
Y = 0
Z = DIV(Y,X)
?Z
* ...

FUNCTION DIV
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: DIV º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function checks for division by º
*º zero. º
*º Parameters: X - The numerator. º
*º Y - The denominator. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, Y
PRIVATE X, Y
IF X = 0 .OR. Y = 0
RETURN(0)
ELSE
RETURN (X/Y)
ENDIF
*END:DIV
************************************************************************
* SAMPLE2
* ...
CLEAR
Str = "THIS IS A LONG STRING"
NewStr = REMOVE(Str,11,5)
? NewStr
* ...

FUNCTION REMOVE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: REMOVE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function removes a group of º
*º characters from a string. º
*º Parameters: Str - The string to operate on. º
*º Start - The starting position of the º
*º area to be removed. º
*º RLen - The length of the area to º
*º remove. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Str, Start, RLen
PRIVATE Str, Start, RLen, NewStr
NewStr = SUBSTR(Str,1,Start-1) + SUBSTR(Str,Start+RLen)
RETURN (NewStr)
************************************************************************
* SAMPLE2
* ...
CLEAR
Str1 = "THIS IS A STRING"
Str2 = "LONGER "
NewStr = STUFF(Str1,11,7,Str2)
? NewStr
* ...

FUNCTION STUFF
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: STUFF º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function inserts characters into º
*º a string. º
*º Parameters: Str - The primary string to operate º
*º on. º
*º new string to be inserted º
*º RLen - The length of the area to º
*º added to the primary string. º
*º Rep - The secondary string - the º
*º string to be inserted. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS Str, Start, RLen, Rep
RETURN SUBSTR(Str,1,Start-1)+Rep+SUBSTR(Str,Start+RLen)
************************************************************************
* SAMPLE2
* ...
CLEAR
A = "phil"
B = "PHIL"
X = PROPER(A)
? X
X = PROPER(B)
? X
* ...

FUNCTION PROPER
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: PROPER º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts a string to º
*º lower case and then converts the first º
*º character of the string to upper case. º
*º Parameters: X - The words to convert into "proper" º
*º format. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X
X = UPPER(SUBSTR(X,1,1)) + LOWER(SUBSTR(X,2))
RETURN(X)
************************************************************************
* SAMPLE2
* ...
CLEAR
A = "Phil"
B = "PHIL"
C = "PHILL"
D = "Bill"
X = COMPARE(A,B)
? X
X = COMPARE(A,C)
? X
X = COMPARE(A,D)
? X
* ...

FUNCTION COMPARE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: COMPARE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function draws a horizontal line º
*º on a laser printer. º
*º Parameters: X - The first variable to compare. º
*º Y - The second variable to compare. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, Y
PRIVATE X, Y
IF UPPER(X) == UPPER(Y)
RETURN(.T.)
ELSE
RETURN(.F.)
ENDIF
************************************************************************
* SAMPLE2
* ...
SET COLOR TO W+/B,W/N,B
CLEAR
Test = .F.
IF .NOT. Test
ERR(1)
@ 12,1 SAY ""
ENDIF
* ...

FUNCTION ERR
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: ERR º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function displays an error on lineº
*º 24 in white on red. º
*º Parameters: N - The number of the error to display.º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS N
PRIVATE N, Key, OldColor
OldColor = SETCOLOR()
Key = 0
SAVESCREEN(24,0,24,79)
SET COLOR TO W+/R
@ 24,0 CLEAR TO 24,79
SET CURSOR OFF
DO CASE
CASE N = 1
@ 24,12 SAY CENT("Error Message one")
CASE N = 2
@ 24,12 SAY CENT("Error Message two")
CASE N = 3
@ 24,12 SAY CENT("Error Message three")
CASE N = 4
@ 24,12 SAY CENT("Error Message four")
CASE N = 5
@ 24,12 SAY CENT("Error Message five")
ENDCASE
Key = INKEY(5)
SET COLOR TO (OldColor)
RESTSCREEN(24,0,24,79)
SET CURSOR ON
CLEAR TYPEAHEAD
RETURN(.T.)
************************************************************************
* SAMPLE2
* ...
CLEAR
N = 5
Z = FACT(N)
? Z
* ...

FUNCTION FACT
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: FACT º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the factorial º
*º of a number. º
*º Parameters: N - The number you need the factorial º
*º of. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS N
PRIVATE N, J, K
K = 1
FOR J = 2 TO N
K = K * J
NEXT
RETURN (K)
************************************************************************
* SAMPLE2
* ...
CLEAR
N = 5
Z = 4
? N, Z
DO SWAP WITH N, Z
? N, Z
* ...

PROCEDURE SWAP
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: SWAP º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function swaps the values of two º
*º variables. º
*º Parameters: A - A variable to be swapped. º
*º B - Another variable to be swapped. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS A, B
PRIVATE C
C = A
A = B
B = C
RETURN
************************************************************************
* SAMPLE2
* ...
CLEAR
Choice = 0
@ 10,30 CLEAR TO 20,50
@ 10,30 TO 20,50 DOUBLE
@ 13,31 TO 13,49
@ 11,35 SAY "MASTER MENU"
@ 13,30 SAY "Ç" && CHR(199)
@ 13,50 SAY "¶" && CHR(182)
SET MESSAGE TO 12
@ 14,31 PROMPT "1. Choice A ......." MESSAGE FIX("Message a",30)
@ 15,31 PROMPT "2. Choice B ......." MESSAGE FIX("Message bb",30)
@ 16,31 PROMPT "3. Choice C ......." MESSAGE FIX("Message ccc",30)
@ 17,31 PROMPT "4. Choice D ......." MESSAGE FIX("Message dddd",30)
@ 18,31 PROMPT "5. Choice E ......." MESSAGE FIX("Message eeeee",30)
@ 19,31 PROMPT "6. Choice F ......." MESSAGE FIX("Message ffffff",30)
MENU TO Choice
* ...

FUNCTION FIX
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: FIX º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function places the MENU message º
*º at the proper place on the screen º
*º Parameters: A - A variable to be swapped. º
*º B - Another variable to be swapped. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETER Mess, Start
RETURN(SPACE(Start) + "º" + Mess )
************************************************************************
* SAMPLE2
* ...
CLEAR
SET DECIMALS TO 12
X = PI()
? X
* ...

FUNCTION PI
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: PI º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns the value of PI º
*º to 11 decimal places. º
*º Parameters: No parameters are used. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
RETURN(3.14159265359)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 30
Y = RAD(X)
?Y
* ...

FUNCTION RAD
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: RAD º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This convert from degrees to radians. º
*º Parameters: X - The value in degrees to be º
*º converted to radians. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X
RETURN(3.14159265359 * X / 180)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
Y = DEG(X)
?Y
* ...

FUNCTION DEG
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: DEG º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts radians to º
*º degrees. º
*º Parameters: X - The value in radians to be º
*º converted to degrees. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PRIVATE X
PARAMETERS X
RETURN(180 * X / 3.14159265359)
************************************************************************
* SAMPLE2
* ...
CLEAR
SET DECIMAL TO 15
X=90
?Sine(X)
* ...

FUNCTION SINE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: SINE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the Sine of a º
*º value given in degrees. º
*º Parameters: X - The value in degrees that we want º
*º the Sine of. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X
PRIVATE X, J, Y
X = RAD(X)
Y = X
Sign = 1
FOR J = 3 TO 17 STEP 2
Sign = IIF(Sign<0, 1, -1)
X = X + (Sign * Y^J)/(FACT(J))
NEXT
RETURN(X)
************************************************************************
* SAMPLE2
* ...
CLEAR
SET DECIMAL TO 15
X=60
?Cos(X)
* ...

FUNCTION COS
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: COS º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the Cosine of a º
*º value given in degrees. º
*º Parameters: X - The value in degrees that we want º
*º the Cosine of. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X
PRIVATE X, J, Y
X = RAD(X)
Y = X
X = 1
Sign = 1
FOR J = 2 TO 16 STEP 2
Sign = IIF(Sign<0, 1, -1)
X = X + (Sign * Y^J)/(FACT(J))
NEXT
RETURN(X)
************************************************************************
* SAMPLE2
* ...
CLEAR
SET DECIMAL TO 15
X=45
?Tan(X)
* ...

FUNCTION TAN
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: TAN º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the Tangent of º
*º a value given in degrees. º
*º Parameters: X - The value in degrees that we want º
*º the Tangent of. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PRIVATE X, J, Y
J = SINE(X)
Y = COS(X)
RETURN(J/Y)
************************************************************************
* SAMPLE2
* ...
ARow = 2
ACol = 2
Height = 3
Width = 3
Esc = CHR(27)
DO WHILE ARow <> 0
CLEAR
@ 1,0 GET ARow PICTURE "99"
@ 2,0 GET ACol PICTURE "99"
@ 3,0 GET Height PICTURE "99"
@ 4,0 GET Width PICTURE "99"
READ
IF ARow = 0
EXIT
ENDIF
SET DEVICE TO PRINT
@ 0,0 SAY Esc + "*p0x0Y"
CIRCLE(ARow, ACol, Height, Width)
EJECT
ENDDO
SET DEVICE TO SCREEN

FUNCTION CIRCLE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: CIRCLE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function draws a circle or an º
*º ellipse on a laser printer using HP º
*º laser jet codes. º
*º Parameters: ARow - The row in inches for the º
*º center of the circle. º
*º ACol - The column in inches for the º
*º center of the circle. º
*º Height - The height of the circle in º
*º inches. º
*º Width - The width of the circle in º
*º inches. º
*º Addition Notes: If the height of the circle does º
*º not equal the width you get an º
*º ellipse. º
*º This UDF is NOT fast. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS ARow, ACol, Height, Width
PRIVATE J, Y, Z, K, L, M, R, Point
Esc = CHR(27)
FOR R = 5 TO -5 STEP -.005
J = 30 * R
Y = ((1-J*J)^.5)
Z = -Y
IF Y <> 0
K = J * Height * 300 + (ARow * 300)
L = Y * Width * 300 + (ACol * 300)
M = Z * Width * 300 + (ACol * 300)
Point = Esc + "*p" + STR(K,5,0) + "y" +;
STR(L,5,0) + "X" + Esc + "*c2a2b0P"
@ J,0 SAY "&Point"
Point = Esc + "*p" + STR(K,5,0) + "y" +;
STR(M,5,0) + "X" + Esc + "*c2a2b0P"
@ J,0 SAY "&Point"
ENDIF
NEXT
RETURN(.T.)
************************************************************************
* SAMPLE2
* ...
CLEAR
USE TEST
* File contains: ... PAUL, SAM, ZELDA ...
INDEX ON NAME TO FName
Key = "PHIL"
SEEK Key
? RECNO()
? NAME
SOFTSEEK(Key)
? RECNO()
? NAME
* ...

FUNCTION SOFTSEEK
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: SOFTSEEK º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns a record equal toº
*º or just after the seek key. º
*º Parameters: NewSeek - The value to SEEK on. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS NewSeek
PRIVATE NewSeek, FirstChar
FirstChar = SUBSTR(NewSeek,1,1)
SEEK NewSeek
DO WHILE EOF()
IF LEN(NewSeek) > 1
NewSeek = SUBSTR(NewSeek,1,LEN(NewSeek)-1)
ELSE
NewSeek = CHR(ASC(FirstChar) + 1)
FirstChar = NewSeek
IF ASC(NewSeek) > 90 && ASC 90 = Z
GOTO BOTTOM
EXIT
ENDIF
ENDIF
SEEK NewSeek
ENDDO
RETURN(.T.)
************************************************************************
* SAMPLE2
* ...
SET COLOR TO W+/B,N/W
CLEAR
X = "THIS IS A TEST"
@ 2,2 CLEAR TO 22,70
@ 2,2 TO 22,70 DOUBLE
@ 12,12 SAY X
WAIT
BoxColor(2,2,22,70,"R/W","D")
@ 14,12 SAY X
WAIT
* ...

FUNCTION BOXCOLOR
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: BOXCOLOR º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function changes the color of a º
*º single or double line box around a º
*º message without changing the color of º
*º the message. º
*º Parameters: T - The top row of the box. º
*º L - The top column of the box. º
*º B - The bottom row of the box. º
*º R - The bottom column of the box. º
*º C - The new color for the box. º
*º SD - "S" = a single box and º
*º "D" = a double box. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS T,L,B,R,C,SD
PRIVATE T,L,B,R,C,SD,OldC
OldC = SETCOLOR()
SET COLOR TO &C
IF UPPER(SD) = "D"
@ T,L TO B,R DOUBLE
ELSE
@ T,L TO B,R
ENDIF
SET COLOR TO &OldC
RETURN(.T.)
************************************************************************
* SAMPLE2
* ...
SET COLOR TO W+/B,N/W
CLEAR
X = "THIS IS A TEST"
@ 2,2 CLEAR TO 22,70
@ 2,2 TO 22,70 DOUBLE
@ 16,12 SAY X
WAIT

MessCol(16,12,X,"G/R")
@ 16,12 SAY X
WAIT
* ...

FUNCTION MESSCOL
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: MESSCOL º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function changes the color of a º
*º message without affecting any other º
*º colors. º
*º Parameters: R - The row the message starts on. º
*º C - The column the message starts on. º
*º M - The message. º
*º NC - The new color for the message. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS R,C,M,NC
PRIVATE R,C,M,NC,OldC
OldC = SETCOLOR()
SET COLOR TO &NC
@ R,C SAY M
SET COLOR TO &OldC
RETURN(.T.)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 123456.7
Y = Dollars(X)
? Y
X = -23456.7
Y = Dollars(X)
? Y
* ...

FUNCTION DOLLARS
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: DOLLARS º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function displays a number as a º
*º dollar amount. º
*º Parameters: X - The number to display as a dollar º
*º amount. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X
PRIVATE Z
Z = LTRIM(TRANSFORM(X, "999,999,999,999.99"))
Z = IIF(X>0, "$"+Z, "-$"+SUBSTR(Z,2))
RETURN (Z)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = TIME()
? X
Y = NonMilt(X)
? Y
* ...

FUNCTION NONMILT
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: NONMILT º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function displays military time º
*º as a normal time with AM and PM. º
*º 14:22:22 is displayed as 2:22:22 PM º
*º Parameters: X - The military time to be displayed.º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X
PRIVATE Y, Z
Y = VAL(LEFT(X,2))
Z = IIF(Y<12, X+" AM", STR(Y-12,2,0)+SUBSTR(X,3)+" PM")
RETURN(Z)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = "14:32:21" && Time1
Y = "17:18:06" && Time2
Z = ElapTime(X,Y)
?Z
* ...

FUNCTION ELAPTIME
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: ELAPTIME º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function computes the difference º
*º between time one and time two. º
*º Parameters: X - Time one. º
*º Y - Time two. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, Y
PRIVATE Time1, Time2, Z, Hrs, Min, Sec
Time1 = (VAL(SUBSTR(X,1,2)) * 3600) +;
(VAL(SUBSTR(X,4,2)) * 60) + (VAL(SUBSTR(X,7)))
Time2 = (VAL(SUBSTR(Y,1,2)) * 3600) +;
(VAL(SUBSTR(Y,4,2)) * 60) + (VAL(SUBSTR(Y,7)))
Z = ABS(Time1 - Time2)
Hrs = INT(Z / 3600)
Min = INT((Z - Hrs * 3600) / 60)
Sec = Z - (Hrs * 3600) - (Min * 60)
RETURN (LTRIM(STR(Hrs,4,0) + ":" + STR(Min,2,0) + ":" + Str(Sec,2,0)))
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 14.87
A = NLen(X)
? A
X = -1314.87
A = NLen(X)
? A
* ...

FUNCTION NLEN
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: NLEN º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns the length of a º
*º numeric field. º
*º Parameters: X - The numeric field. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X
RETURN (LEN(ALLTRIM(STR(X))))
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 0
Y = " "
Z = CTOD(" / / ")
@ 12,12 GET X PICTURE "9" VALID AnyThing(X)
@ 13,12 GET Y PICTURE "!" VALID AnyThing(Y)
@ 14,12 GET Z VALID AnyThing(Z)
READ
* ...

FUNCTION ANYTHING
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: ANYTHING º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function returns a .F. if a data º
*º entry field contains blanks or a null. º
*º Parameters: X - The variable to check for a blank º
*º or a null. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X
IF EMPTY(X)
RETURN(.F.)
ELSE
RETURN(.T.)
ENDIF
************************************************************************
FUNCTION METFOOT
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: METFOOT º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts meters to feet º
*º and feet to meters. º
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
Meter_Foot = 3.280833333
Foot_Meter = 0.3048006096
FactorM = Meter_Foot
FactorA = Foot_Meter
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = KmMile(X,"A")
? X
? NewValue
* ...

FUNCTION KMMILE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: KMMILE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts kilometers to º
*º miles and miles to kilometers. º
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
KMeter_Miles = 0.6213699495
Miles_KMeter = 1.609347219
FactorM = KMeter_Miles
FactorA = Miles_KMeter
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = KmMPH(X,"A")
? X
? NewValue
* ...

FUNCTION KMMPH
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: KMMPH º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts kilometers per º
*º minute to miles per hour and miles per º
*º hour to kilometers per minute. º
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
KMetMin_MPH = 37.2822
MPH_KMetMin = 0.026822
FactorM = KMetMin_MPH
FactorA = MPH_KMetMin
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = CentIn(X,"M")
? X
? NewValue
* ...

FUNCTION CENTIN
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: CENTIN º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts centimeters to º
*º inches and inches to centimeters. º
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
Cm_Inch = 0.3937
Inch_Cm = 2.54000508
FactorM = Cm_Inch
FactorA = Inch_Cm
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = KiloLbs(X,"M")
? X
? NewValue
* ...

FUNCTION KILOLBS
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: KILOLBS º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts kilograms to º
*º pounds and pounds to kilograms. º
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
KGram_Lbs = 2.204622341
Lbs_KGram = 0.4535924277
FactorM = KGram_Lbs
FactorA = Lbs_KGram
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = GramOz(X,"M")
? X
? NewValue
* ...

FUNCTION GRAMOZ
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: GRAMOZ º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts grams to ounces º
*º and ounces to grams. º
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
Gram_Oz = 0.0352739
Oz_Gram = 28.349527
FactorM = Gram_Oz
FactorA = Oz_Gram
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = LiterGal(X,"M")
? X
? NewValue
* ...

FUNCTION LITERGAL
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: LITERGAL º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts liters to º
*º gallons and gallons to liters. º
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
Liter_Gal = 0.219976
Gal_Liter = 3.78533
FactorM = Liter_Gal
FactorA = Gal_Liter
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = CentF(X,"M")
? X
? NewValue
* ...

FUNCTION CENTF
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: CENTF º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts centigrade to º
*º Fahrenheit and Fahrenheit to º
*º centigrade. º
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
Centigrade = (F - 32) * 5 / 9
Fahrenheit = (C * 9 /5) + 32
FactorM = Centigrade
FactorA = Fahrenheit
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = CalBTU(X,"A")
? X
? NewValue
* ...

FUNCTION CALBTU
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: CALBTU º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts kilocalories to º
*º BTUs and BTUs to kilocalories. º
*º centigrade. º
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
CalK_BTU = 3.9685
BTU_CalK = 0.025198
FactorM = CalK_BTU
FactorA = BTU_CalK
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)

************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = JouCal(X,"A")
? X
? NewValue
* ...

FUNCTION JOLCAL
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: JOLCAL º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts Joules to º
*º kilocalories and kilocalories to Joulesº
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
Joule_CalK = 0.00023918
CalK_Joule = 4186
FactorM = Joule_CalK
FactorA = CalK_Joule
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = MetFrl(X,"A")
? X
? NewValue
* ...

FUNCTION METFRL
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: METFRL º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts meters to º
*º furlongs and furlongs to meters. º
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
Meter_Furlng = 0.00497096
Furlng_Meter = 201.168
FactorM = Meter_Furlng
FactorA = Furlng_Meter
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = MetFat(X,"A")
? X
? NewValue
* ...

FUNCTION METFAT
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: METFAT º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts meters to º
*º fathoms and fathoms to meters. º
*º Parameters: X - The variable to be converted from º
*º metric or American to the other. º
*º MA - "M" = convert to metric; º
*º "A" = convert to American. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, MA
PRIVATE FactorM, FactorA, Factor
Meter_Fathom = 0.546806
Fathom_Meter = 1.828804
FactorM = Meter_Fathom
FactorA = Fathom_Meter
Factor = IIF(UPPER(MA)="A", FactorM, FactorA)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = FatFt(X,1)
? X
? NewValue
* ...

FUNCTION FATFT
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: FATFT º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts fathoms to feet º
*º and feet to fathoms. º
*º Parameters: X - The variable to be converted º
*º from one measure to the other. º
*º Ord - 1 Forward direction from title. º
*º 2 Reverse direction from title. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, Ord
PRIVATE FactorF, FactorB, Factor
Fathom_Ft = 6
Ft_Fathom = 1 / 6
FactorF = Fathom_Ft
FactorB = Ft_Fathom
Factor = IIF(Ord=1, FactorF, FactorB)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = FurMile(X,1)
? X
? NewValue
* ...

FUNCTION FURMILE
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: FURMILE º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts furlongs to º
*º miles and miles to furlongs. º
*º Parameters: X - The variable to be converted º
*º from one measure to the other. º
*º Ord - 1 Forward direction from title. º
*º 2 Reverse direction from title. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, Ord
PRIVATE FactorF, FactorB, Factor
Furlong_Mile = 0.125
Mile_Furlong = 8
FactorF = Furlong_Mile
FactorB = Mile_Furlong
Factor = IIF(Ord=1, FactorF, FactorB)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = LCalHP(X,1)
? X
? NewValue
* ...

FUNCTION KCALHP
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: KCALHP º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts kilocalories to º
*º horsepower hours and horsepower hours º
*º to kilocalories. º
*º Parameters: X - The variable to be converted º
*º from one measure to the other. º
*º Ord - 1 Forward direction from title. º
*º 2 Reverse direction from title. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, Ord
PRIVATE FactorF, FactorB, Factor
CalK_HPHrs = 0.0015593
HPHrs_CalK = 641.304
FactorF = CalK_HPHrs
FactorB = HPHrs_CalK
Factor = IIF(Ord=1, FactorF, FactorB)
RETURN (X * Factor)
************************************************************************
* SAMPLE2
* ...
CLEAR
X = 1
NewValue = KWHP(X,1)
? X
? NewValue
* ...

FUNCTION KWHP
*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
*º Program...: KWHP º
*º Author....: Phil Steele - President º
*º Phillipps Computer Systems Inc. º
*º Address...: 52 Hook Mountain Road, º
*º Montville NJ 07045 º
*º Phone.....: (201) 575-8575 º
*º Date......: 03/22/88 º
*º Notice....: Copyright 1988 Philip Steele, º
*º All Rights Reserved. º
*º Notes.....: This function converts kilowatts to º
*º horsepower and horsepower to kilowatts.º
*º Parameters: X - The variable to be converted º
*º from one measure to the other. º
*º Ord - 1 Forward direction from title. º
*º 2 Reverse direction from title. º
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
PARAMETERS X, Ord
PRIVATE FactorF, FactorB, Factor
HP_KWatts = 0.74570
KWatts_HP = 1.3410
FactorF = HP_KWatts
FactorB = KWatts_HP
Factor = IIF(Ord=1, FactorF, FactorB)
RETURN (X * Factor)


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

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

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

  3. 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/