home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / clipper / udfs.arc / UDFS.PRG
Text File  |  1989-05-12  |  120KB  |  3,241 lines
  1. * ╔═══════════════════════════════════════════════════════════════════╗
  2. * ║ Program.: UDFS                                                    ║
  3. * ║                                                                   ║
  4. * ║ Author..: Phil Steele - President Phillipps Computer Systems Inc. ║
  5. * ║                                                                   ║
  6. * ║ Address.: 52 Hook Mountain Road,  Montville NJ 07045              ║
  7. * ║                                                                   ║
  8. * ║ Phone...: (201) 575-8575                                          ║
  9. * ║                                                                   ║
  10. * ║ Date....: 03/22/88                                                ║
  11. * ║                                                                   ║
  12. * ║ Notice..: Copyright 1988  Philip Steele, All Rights Reserved      ║
  13. * ║                                                                   ║
  14. * ║ Version.: CLIPPER AUTUMN 1986 and CLIPPER SUMMER 1987             ║
  15. * ║                                                                   ║
  16. * ║ Notes...: A Collection of User Defined Functions                  ║
  17. * ║                                                                   ║
  18. * ║                                                                   ║
  19. * ║    These functions are from the book: 64 Clipper User Defined     ║
  20. * ║                                                                   ║
  21. * ║    Functions - TAB Books  written by Phil Steele.                 ║
  22. * ║                                                                   ║
  23. * ║    This collection normally sells for $49.95 or about $0.75 per   ║
  24. * ║                                                                   ║
  25. * ║    function.                                                      ║
  26. * ║                                                                   ║
  27. * ║                                                                   ║
  28. * ║    I am making these UDFs available to you on a shareware basis.  ║
  29. * ║                                                                   ║
  30. * ║                                                                   ║
  31. * ║    If you find any of these functions useful and wish to change   ║
  32. * ║                                                                   ║
  33. * ║    them or incorporate tham as-is into your code - feel free to   ║
  34. * ║                                                                   ║
  35. * ║    do so.  Please give me (Phil Steele) credit somewhere in your  ║
  36. * ║                                                                   ║
  37. * ║    code.                                                          ║
  38. * ║                                                                   ║
  39. * ║                                                                   ║
  40. * ║    Remember these functions are NOT free - however only pay for   ║
  41. * ║                                                                   ║
  42. * ║    those that you use.  If you only like and use ONE function     ║
  43. * ║                                                                   ║
  44. * ║    send me $0.75,  if you like and use two of the 64 functions    ║
  45. * ║                                                                   ║
  46. * ║    send $1.50, I feel that this is a very fair method of payment. ║
  47. * ║                                                                   ║
  48. * ║                                                                   ║
  49. * ║    For amounts of $5.00 or more I accept Master card or Visa.     ║
  50. * ║                                                                   ║
  51. * ║                                                                   ║
  52. * ║    If you wish an explanation of how or why the UDFs work as      ║
  53. * ║                                                                   ║
  54. * ║    they do you can purchase the book.  If you can't find the      ║
  55. * ║                                                                   ║
  56. * ║    book you can order it directly from either TAB books or me.    ║
  57. * ║                                                                   ║
  58. * ║                                                                   ║
  59. * ║    Enjoy these UDFs and good luck.                                ║
  60. * ║                                                Phil Steele        ║
  61. * ║                                                                   ║
  62. * ╚═══════════════════════════════════════════════════════════════════╝
  63. *
  64. *  Calling code:
  65. *  SAMPLE1
  66. *  ...
  67.    CLEAR
  68.    STORE DATE() TO Birthday, StartDay
  69.    NDays = 7671  && 21 Years
  70.    @ 10,12 GET Birthday
  71.    @ 12,12 GET StartDay VALID DifDate(StartDay, BirthDay, NDays)
  72.    READ
  73. *  ...
  74.  
  75. FUNCTION DIFDATE
  76. *╔════════════════════════════════════════════════════╗
  77. *║ Program...: DIFDATE                                ║
  78. *║ Author....: Phil Steele - President                ║
  79. *║             Phillipps Computer Systems Inc.        ║
  80. *║ Address...: 52 Hook Mountain Road,                 ║
  81. *║             Montville NJ 07045                     ║
  82. *║ Phone.....: (201) 575-8575                         ║
  83. *║ Date......: 03/22/88                               ║
  84. *║ Notice....: Copyright 1988  Philip Steele,         ║
  85. *║             All Rights Reserved.                   ║
  86. *║ Notes.....: This function insures that DATE1 is    ║
  87. *║             X days greater than DATE2              ║
  88. *║ Parameters: DATE1, DATE2 - Dates to be compared    ║
  89. *║             NUMOFDAYS    - The number of days      ║
  90. *║                            DATE1 must be greater   ║
  91. *║                            than DATE2 for a .T.    ║
  92. *║                            result.                 ║
  93. *╚════════════════════════════════════════════════════╝
  94. PARAMETERS Date1, Date2, NumOfDays
  95. PRIVATE    Date1, Date2, NumOfDays
  96. IF Date1 >= Date2 + NumOfDays
  97.    RETURN(.T.)
  98. ELSE
  99.    RETURN(.F.)
  100. ENDIF
  101. *END:DIFDATE
  102. ************************************************************************
  103. *  Calling code:
  104. *  SAMPLE2
  105. *  ...
  106.    Job = "     "
  107.    ValidJobs = "DRV,HLP,LDR,GUARD,SPVSR,MNGR"
  108.    @ 10,12 GET Job VALID MatchStr(Job, ValidJobs)
  109.    READ
  110. *  ...
  111.  
  112. FUNCTION MATCHSTR
  113. *╔════════════════════════════════════════════════════╗
  114. *║ Program...: MATCHSTR                               ║
  115. *║ Author....: Phil Steele - President                ║
  116. *║             Phillipps Computer Systems Inc.        ║
  117. *║ Address...: 52 Hook Mountain Road,                 ║
  118. *║             Montville NJ 07045                     ║
  119. *║ Phone.....: (201) 575-8575                         ║
  120. *║ Date......: 03/22/88                               ║
  121. *║ Notice....: Copyright 1988  Philip Steele,         ║
  122. *║             All Rights Reserved.                   ║
  123. *║ Notes.....: This function insures that VAR1 is     ║
  124. *║             contained in STR1                      ║
  125. *║ Parameters: VAR1 - The variable to be compared     ║
  126. *║             STR1 - A group of string variables     ║
  127. *║                    separated by ","                ║
  128. *╚════════════════════════════════════════════════════╝
  129. PARAMETERS Var1, Str1
  130. PRIVATE    Var1, Str1
  131. Str1 = Str1 + ",,"
  132. DO WHILE .T.
  133.    Comma = AT(",", Str1)
  134.    IF Comma = 0 .OR. LEN(Str1) < 2
  135.       RETURN(.F.)
  136.    ENDIF
  137.    SStr = SUBSTR(Str1, 1, Comma - 1)
  138.    Str1 = SUBSTR(Str1, Comma + 1)
  139.    IF Var1 = SStr
  140.       RETURN(.T.)
  141.    ENDIF
  142. ENDDO
  143. *END:MATCHSTR
  144. ************************************************************************
  145. *  Calling code:
  146. *  SAMPLE3
  147. *  ...
  148. *  GET ...
  149. *  GET ...
  150.    BDate = DATE()
  151.    @ 10,12 GET BDate VALID BirthAge(BDate, 10, 3)
  152. *  GET ...
  153. *  GET ...
  154.    READ
  155. *  ...
  156.  
  157. FUNCTION BIRTHAGE
  158. *╔════════════════════════════════════════════════════╗
  159. *║ Program...: BIRTHAGE                               ║
  160. *║ Author....: Phil Steele - President                ║
  161. *║             Phillipps Computer Systems Inc.        ║
  162. *║ Address...: 52 Hook Mountain Road,                 ║
  163. *║             Montville NJ 07045                     ║
  164. *║ Phone.....: (201) 575-8575                         ║
  165. *║ Date......: 03/22/88                               ║
  166. *║ Notice....: Copyright 1988  Philip Steele,         ║
  167. *║             All Rights Reserved.                   ║
  168. *║ Notes.....: This function checks for a valid date  ║
  169. *║             and displays the elapsed years.        ║
  170. *║ Parameters: BDATE - The date checked for validity, ║
  171. *║             and used to compute elapsed years.     ║
  172. *║             X and Y - The coordinated used to      ║
  173. *║             display the elapsed years.             ║
  174. *╚════════════════════════════════════════════════════╝
  175. PARAMETERS BDate, X, Y
  176. PRIVATE    BDate, X, Y
  177. IF MONTH(BDate) < 1
  178.    RETURN(.T.)
  179. ENDIF
  180. EYears = (DATE() - BDate) / 365.25
  181. @ X,Y SAY STR(EYears,2,0)
  182. RETURN(.T.)
  183. *END:BIRTHAGE
  184. ************************************************************************
  185. *  Calling code:
  186. *  SAMPLE4
  187. *  ...
  188.    CLEAR
  189.    STORE 0 TO Number, Total
  190.    DO WHILE Number > -1
  191.       @ 12,12 GET Number VALID NumSum(Number,22,10)
  192.       READ
  193.    ENDDO
  194. *  ...
  195.  
  196. FUNCTION NUMSUM
  197. *╔════════════════════════════════════════════════════╗
  198. *║ Program...: NUMSUM                                 ║
  199. *║ Author....: Phil Steele - President                ║
  200. *║             Phillipps Computer Systems Inc.        ║
  201. *║ Address...: 52 Hook Mountain Road,                 ║
  202. *║             Montville NJ 07045                     ║
  203. *║ Phone.....: (201) 575-8575                         ║
  204. *║ Date......: 03/22/88                               ║
  205. *║ Notice....: Copyright 1988  Philip Steele,         ║
  206. *║             All Rights Reserved.                   ║
  207. *║ Notes.....: This function computes a sum of numbers║
  208. *║             and displays the total while the data  ║
  209. *║             is being entered.                      ║
  210. *║ Parameters: Number - Entered number.               ║
  211. *║             X and Y - The coordinates for the      ║
  212. *║             computed total.                        ║
  213. *║ Note......: Total must be defined in the calling   ║
  214. *║             procedure.                             ║
  215. *╚════════════════════════════════════════════════════╝
  216. PARAMETERS Number, X, Y
  217. PRIVATE    Number, X, Y
  218. Total = Number + Total
  219. @ X,Y SAY Total PICTURE "99,999.99"
  220. RETURN(.T.)
  221. ************************************************************************
  222. *  Calling code:
  223. *  SAMPLE2
  224. *  ...
  225.    N = 1
  226.    USE EMPLOYEE
  227.    INDEX ON NoZero(Ord) TO TEMPORD
  228.    DO WHILE .NOT. EOF()
  229.       @ N, 1 SAY EmpName
  230.       @ N,31 SAY EmpAddress
  231.       SKIP
  232.       IF N = 23
  233.          WAIT
  234.          CLEAR
  235.          N = 1
  236.       ENDIF
  237.    ENDDO
  238. *  ...
  239.  
  240. FUNCTION NOZERO
  241. *╔════════════════════════════════════════════════════╗
  242. *║ Program...: NOZERO                                 ║
  243. *║ Author....: Phil Steele - President                ║
  244. *║             Phillipps Computer Systems Inc.        ║
  245. *║ Address...: 52 Hook Mountain Road,                 ║
  246. *║             Montville NJ 07045                     ║
  247. *║ Phone.....: (201) 575-8575                         ║
  248. *║ Date......: 03/22/88                               ║
  249. *║ Notice....: Copyright 1988  Philip Steele,         ║
  250. *║             All Rights Reserved.                   ║
  251. *║ Notes.....: This function indexes a database in    ║
  252. *║             ascending order based on the numeric   ║
  253. *║             field Zip. However a zero value will   ║
  254. *║             come after 99999 in the index.         ║
  255. *║ Parameters: Zip - A five position numeric field in ║
  256. *║             the database.                          ║
  257. *╚════════════════════════════════════════════════════╝
  258. PARAMETERS Zip
  259. IF Zip = 0
  260.    RETURN(99999)
  261. ELSE
  262.    RETURN(Zip)
  263. ENDIF
  264. *END:NOZERO
  265. ************************************************************************
  266. * Calling code:
  267. * SAMPLE2
  268. * ...
  269.   SET COLOR TO W+/B,R+/B,B,B
  270.   CLEAR
  271.   @ 12,38 SAY "I N D E X I N G"
  272.   @ 18,10 TO 23,69 DOUBLE
  273.   @ 21,11 TO 21,68 DOUBLE
  274.   @ 21,10 SAY "╠"
  275.   @ 21,69 SAY "╣"
  276.   @ 19,24 SAY "P E R C E N T   C O M P L E T E"
  277.   @ 20,14 SAY "0    10   20   30   40   50"
  278.   @ 20,44 SAY "60   70   80   90   100"
  279.   USE TEST
  280.   PUBLIC Tot
  281.   Tot = RECCOUNT()
  282.   SET COLOR TO R+/B,W+/B,B,B
  283.   INDEX ON Bar(AA1+AA2+AA3) TO TEMP1
  284. * ...
  285.  
  286. FUNCTION BAR
  287. *╔════════════════════════════════════════════════════╗
  288. *║ Program...: BAR                                    ║
  289. *║ Author....: Phil Steele - President                ║
  290. *║             Phillipps Computer Systems Inc.        ║
  291. *║ Address...: 52 Hook Mountain Road,                 ║
  292. *║             Montville NJ 07045                     ║
  293. *║ Phone.....: (201) 575-8575                         ║
  294. *║ Date......: 03/22/88                               ║
  295. *║ Notice....: Copyright 1988  Philip Steele,         ║
  296. *║             All Rights Reserved.                   ║
  297. *║ Notes.....: This function displays a bar graph     ║
  298. *║             depicting the progress of an index     ║
  299. *║             operation.                             ║
  300. *║ Parameters: IFIELD - The field(s) to index on.     ║
  301. *║                                                    ║
  302. *║ Note1: The function "BAR" must be present every    ║
  303. *║        time you use the index - even if you are    ║
  304. *║        not reindexing the file.                    ║
  305. *║                                                    ║
  306. *║ Note2: The index is increased in size due to the   ║
  307. *║        UDF BAR - take note.                        ║
  308. *╚════════════════════════════════════════════════════╝
  309. PARAMETERS IField
  310. PRIVATE    IField
  311. Pct = IIF(RECNO()<Tot+1, RECNO()*100/Tot, 100)
  312. @ 22,14 SAY REPLICATE("█",(Pct/2)+1)     && CHR(219)
  313. RETURN(IField)
  314. *END:BAR
  315. ************************************************************************
  316. *  Calling code:
  317. *  SAMPLE2
  318. *  ...
  319.    @ 12,38 SAY "I N D E X I N G"
  320.    USE TEST
  321.    INDEX ON Inverse(Empname) TO TEMP1
  322. *  ...
  323.  
  324. FUNCTION INVERSE
  325. *╔════════════════════════════════════════════════════╗
  326. *║ Program...: INVERSE                                ║
  327. *║ Author....: Phil Steele - President                ║
  328. *║             Phillipps Computer Systems Inc.        ║
  329. *║ Address...: 52 Hook Mountain Road,                 ║
  330. *║             Montville NJ 07045                     ║
  331. *║ Phone.....: (201) 575-8575                         ║
  332. *║ Date......: 03/22/88                               ║
  333. *║ Notice....: Copyright 1988  Philip Steele,         ║
  334. *║             All Rights Reserved.                   ║
  335. *║ Notes.....: This function generates an inverse     ║
  336. *║             alphabetic index.                      ║
  337. *║ Parameters: INFIELD - The field(s) to index on.    ║
  338. *╚════════════════════════════════════════════════════╝
  339. PARAMETERS InField
  340. PRIVATE InField, NLoop
  341. NewString = " "
  342. FOR NLoop = 1 TO 30
  343.    NewChar = UPPER(SUBSTR(InField,NLoop,1))
  344.    Num = ASC(NewChar) - 78
  345.    Num = IIF(Num>=0, Num+1, Num)
  346.    Num = 77 - Num
  347.    Num = IIF(Num<=78, Num+1, Num)
  348.    NewString = NewString + CHR(Num)
  349. NEXT
  350. NewString = LTRIM(NewString) +;
  351.             SPACE(LEN(InField) - LEN(LTRIM(NewString)))
  352. RETURN(NewString)
  353. *END:INVERSE
  354. ************************************************************************
  355. *  Calling code:
  356. *  SAMPLE2
  357. *  ...
  358.    @ 12,38 SAY "I N D E X I N G"
  359.    USE TEST
  360.    INDEX ON FastInv(Empname) TO TEMP1
  361. *  ...
  362.  
  363. FUNCTION FASTINV
  364. *╔════════════════════════════════════════════════════╗
  365. *║ Program...: FASTINV                                ║
  366. *║ Author....: Phil Steele - President                ║
  367. *║             Phillipps Computer Systems Inc.        ║
  368. *║ Address...: 52 Hook Mountain Road,                 ║
  369. *║             Montville NJ 07045                     ║
  370. *║ Phone.....: (201) 575-8575                         ║
  371. *║ Date......: 03/22/88                               ║
  372. *║ Notice....: Copyright 1988  Philip Steele,         ║
  373. *║             All Rights Reserved.                   ║
  374. *║ Notes.....: This function generates an inverse     ║
  375. *║             alphabetic index of the first 4        ║
  376. *║             characters of a string.                ║
  377. *║ Parameters: INFIELD - The field(s) to index on.    ║
  378. *╚════════════════════════════════════════════════════╝
  379. PARAMETERS InField
  380. PRIVATE    InField, NLoop
  381. NewString = " "
  382. MaxLook = IIF(LEN(TRIM(InField))>4, 4, LEN(TRIM(InField)))
  383. FOR NLoop = 1 TO MaxLook
  384.    NewChar = UPPER(SUBSTR(InField,NLoop,1))
  385.    Num = ASC(NewChar) - 78
  386.    Num = IIF(Num>=0, Num+1, Num)
  387.    Num = -Num + 77
  388.    Num = IIF(Num<=78, Num+1, Num)
  389.    NewString = NewString + CHR(Num)
  390. NEXT
  391. NewString = LTRIM(NewString) + SPACE(LEN(InField) - LEN(LTRIM(NewString)))
  392. RETURN(NewString)
  393. *END:FASTINV
  394. ************************************************************************
  395. *  Calling code:
  396. *  SAMPLE2
  397. *  ...
  398.    @ 12,38 SAY "I N D E X I N G"
  399.    USE TEST
  400.    INDEX ON RevNumb(ZIP, 5) TO TEMP1
  401. *  ...
  402.  
  403. FUNCTION REVNUMB
  404. *╔════════════════════════════════════════════════════╗
  405. *║ Program...: REVNUMB                                ║
  406. *║ Author....: Phil Steele - President                ║
  407. *║             Phillipps Computer Systems Inc.        ║
  408. *║ Address...: 52 Hook Mountain Road,                 ║
  409. *║             Montville NJ 07045                     ║
  410. *║ Phone.....: (201) 575-8575                         ║
  411. *║ Date......: 03/22/88                               ║
  412. *║ Notice....: Copyright 1988  Philip Steele,         ║
  413. *║             All Rights Reserved.                   ║
  414. *║ Notes.....: This function indexes numberic fields  ║
  415. *║             decending.                             ║
  416. *║ Parameters: INFIELD - The field(s) to index on.    ║
  417. *║             LENNUM  - The length of InField.       ║
  418. *╚════════════════════════════════════════════════════╝
  419. PARAMETERS InField, LenNum
  420. PRIVATE    InField, LenNum
  421. SNines = REPLICATE("9", LenNum)
  422. Nines  = VAL(SNines)
  423. RETURN(Nines - InField)
  424. *END:REVNUMB
  425.  
  426. *  Calling code:
  427. *  SAMPLE2
  428. *  ...
  429.    @ 12,38 SAY "I N D E X I N G"
  430.    USE TEST
  431.    INDEX ON RevDate(EmpDate) TO TEMP1
  432. *  ...
  433. ************************************************************************
  434. FUNCTION REVDATE
  435. *╔════════════════════════════════════════════════════╗
  436. *║ Program...: REVDATE                                ║
  437. *║ Author....: Phil Steele - President                ║
  438. *║             Phillipps Computer Systems Inc.        ║
  439. *║ Address...: 52 Hook Mountain Road,                 ║
  440. *║             Montville NJ 07045                     ║
  441. *║ Phone.....: (201) 575-8575                         ║
  442. *║ Date......: 03/22/88                               ║
  443. *║ Notice....: Copyright 1988  Philip Steele,         ║
  444. *║             All Rights Reserved.                   ║
  445. *║ Notes.....: This function indexes dates decending. ║
  446. *║ Parameters: INDATE - The Date to index on.         ║
  447. *╚════════════════════════════════════════════════════╝
  448. PARAMETERS InDate
  449. PRIVATE    InDate
  450. NewDate = 99999999 - VAL(DTOS(InDate))
  451. RETURN(NewDate)
  452. * For the Autumn 1986 release of Clipper
  453. * Use the following
  454. * NewDate = YEAR(InDate)* 10000 + MONTH(InDate) * 100 + DAY(InDate)
  455. * NewDate = 99999999 - NewDate
  456. * RETURN(NewDate)
  457. *END:REVDATE
  458. ************************************************************************
  459. * Calling code:
  460. * SAMPLE2
  461. * ...
  462.   Mess1 = "DO YOU WISH TO"
  463.   Mess2 = "DELETE THIS RECORD?"
  464.   YNE   = " "
  465.   SET COLOR TO W+/B,B/W,B,B
  466.   CLEAR
  467.   YNE = YESORN(Mess1, Mess2)
  468. * ...
  469.  
  470. FUNCTION YESORN
  471. *╔════════════════════════════════════════════════════╗
  472. *║ Program...: YESORN                                 ║
  473. *║ Author....: Phil Steele - President                ║
  474. *║             Phillipps Computer Systems Inc.        ║
  475. *║ Address...: 52 Hook Mountain Road,                 ║
  476. *║             Montville NJ 07045                     ║
  477. *║ Phone.....: (201) 575-8575                         ║
  478. *║ Date......: 03/22/88                               ║
  479. *║ Notice....: Copyright 1988  Philip Steele,         ║
  480. *║             All Rights Reserved.                   ║
  481. *║ Notes.....: This function returns a box where the  ║
  482. *║             a user can answer the question in the  ║
  483. *║             box with a Y or N - the Y or N is then ║
  484. *║             returned.                              ║
  485. *║ Parameters: Mess1 - The first message line to be   ║
  486. *║                     displayed.                     ║
  487. *║             Mess2 - The second message line to be  ║
  488. *║                     displayed.                     ║
  489. *╚════════════════════════════════════════════════════╝
  490. PARAMETERS Mess1, Mess2
  491. PRIVATE Special,B1,B2,NewColor
  492. NewColor =  "W+/R,N/W,B,B,N/W"
  493. Special  =  CHR(218)+CHR(196)+CHR(183)+CHR(186)+;
  494.             CHR(188)+CHR(205)+CHR(212)+CHR(179)+CHR(32)
  495.             *  ┌───╖
  496.             *  │   ║
  497.             *  ╘═══╝
  498. DoubleBox = CHR(201)+CHR(205)+CHR(187)+CHR(186)+;
  499.             CHR(188)+CHR(205)+CHR(200)+CHR(186)+CHR(32)
  500.             *  ╔═══╗
  501.             *  ║   ║
  502.             *  ╚═══╝
  503. YorN = 0
  504. B2   = 21
  505. SAVE SCREEN
  506. SET CURSOR OFF
  507. * Autumn 1986 Release Use    CALL _setctyp WITH word(0)
  508. SET MESSAGE TO
  509. IF LEN(TRIM(Mess2)) = 0
  510.    B1 = LEN(TRIM(Mess1))
  511.    B2 = 20 + (41-B1)/2
  512. ENDIF
  513. SET COLOR TO "N/N"
  514. @  8,62 CLEAR TO 15,63
  515. @ 15,21 CLEAR TO 15,63
  516. SET COLOR TO &NewColor
  517. @  7,19,14,61 BOX DoubleBox
  518. @  8,B2 SAY TRIM(Mess1)
  519. @  9,21 SAY TRIM(Mess2)
  520. @ 11,27,13,33 BOX Special
  521. @ 11,48,13,53 BOX Special
  522. @ 12,28 PROMPT " Yes "
  523. @ 12,49 PROMPT " No "
  524. MENU TO YorN
  525. IF YorN = 1
  526.    YNE = "Y"
  527. ELSE
  528.    YNE = "N"
  529. ENDIF
  530. RESTORE SCREEN
  531. SET CURSOR ON
  532. * Autumn 1986 Release Use    CALL _setctyp WITH word(1)
  533. RETURN(YNE)
  534. *END:YESORN
  535. ************************************************************************
  536. * Calling code:
  537. * SAMPLE2
  538. * ...
  539.   SET COLOR TO W+/B,N/W,B,B
  540.   CLEAR
  541.   Ret    = .F.
  542.   Shadow = .T.
  543.   Top    = 10
  544.   Left   = 20
  545.   Bot    = 14
  546.   Right  = 60
  547.   SD     = "D"
  548.   BColor = "W+/R"
  549.   Ret    = BOXES(Top, Left, Bot, Right, Shadow, SD, BColor)
  550.   SET COLOR TO W+/B,N/W,B,B
  551. * ...
  552.  
  553. FUNCTION BOXES
  554. *╔════════════════════════════════════════════════════╗
  555. *║ Program...: BOXES                                  ║
  556. *║ Author....: Phil Steele - President                ║
  557. *║             Phillipps Computer Systems Inc.        ║
  558. *║ Address...: 52 Hook Mountain Road,                 ║
  559. *║             Montville NJ 07045                     ║
  560. *║ Phone.....: (201) 575-8575                         ║
  561. *║ Date......: 03/22/88                               ║
  562. *║ Notice....: Copyright 1988  Philip Steele,         ║
  563. *║             All Rights Reserved.                   ║
  564. *║ Notes.....: This function returns a box with a     ║
  565. *║             drop shadow.                           ║
  566. *║ Parameters: Top    - The top of the box.           ║
  567. *║             Left   - The left corner of the box.   ║
  568. *║             Bot    - The bottom of the box.        ║
  569. *║             Right  - The right corner of the box.  ║
  570. *║             Shadow - Should a shadow be drawn?     ║
  571. *║             SD     - Draw a single "S", or double  ║
  572. *║                      "D" box.                      ║
  573. *║             BColor - Color of the box.             ║
  574. *╚════════════════════════════════════════════════════╝
  575. PARAMETER T, L, B, R, S, SD, BC
  576. PRIVATE   T, L, B, R, S, SD, BC, Kind
  577. DoubleBox = CHR(201)+CHR(205)+CHR(187)+CHR(186)+;
  578.             CHR(188)+CHR(205)+CHR(200)+CHR(186)+CHR(32)
  579.           *  ╔═══╗
  580.           *  ║   ║
  581.           *  ╚═══╝
  582. SingleBox = CHR(218)+CHR(196)+CHR(191)+CHR(179)+;
  583.             CHR(217)+CHR(196)+CHR(192)+CHR(179)+CHR(32)
  584.           * ┌───┐
  585.           * │   │
  586.           * └───┘
  587. Kind = IIF(SD="S", SingleBox, DoubleBox)
  588. IF S
  589.    SET COLOR TO N/N
  590.    @ T+1, R+1 CLEAR TO B+1, R+2
  591.    @ B+1, L+2 CLEAR TO B+1, R+2
  592. ENDIF
  593. SET COLOR TO &BC
  594. @ T, L, B, R BOX Kind
  595. RETURN(.T.)
  596. *END:BOXES
  597. ************************************************************************
  598. * Calling code:
  599. * SAMPLE2
  600. * ...
  601.   SET COLOR TO W+/B,N/W,B,B
  602.   CLEAR
  603.   Message   = "This is the message to center"
  604.   @ 12,  0 SAY MessCent(Message, 80)
  605.   @ 14, 45 SAY MessCent(Message, 30)
  606. * ...
  607.  
  608. FUNCTION MESSCENT
  609. *╔════════════════════════════════════════════════════╗
  610. *║ Program...: MESSCENT                               ║
  611. *║ Author....: Phil Steele - President                ║
  612. *║             Phillipps Computer Systems Inc.        ║
  613. *║ Address...: 52 Hook Mountain Road,                 ║
  614. *║             Montville NJ 07045                     ║
  615. *║ Phone.....: (201) 575-8575                         ║
  616. *║ Date......: 03/22/88                               ║
  617. *║ Notice....: Copyright 1988  Philip Steele,         ║
  618. *║             All Rights Reserved.                   ║
  619. *║ Notes.....: This function returns a centered       ║
  620. *║             message.                               ║
  621. *║ Parameters: Mess   - The message to center.        ║
  622. *║             MaxLen - The maximum length of the     ║
  623. *║                      message.                      ║
  624. *╚════════════════════════════════════════════════════╝
  625. PARAMETER Mess, MaxLen
  626. PRIVATE   Mess, MaxLen
  627. Mess = LTRIM(TRIM(Mess))
  628. RETURN (REPLICATE(" ", (MaxLen-LEN(Mess))/2) + Mess)
  629. RETURN(.T.)
  630. *END:MESSCENT
  631. ************************************************************************
  632. *Calling code:
  633. *  SAMPLE2
  634. *  ...
  635.    CLEAR
  636.    SET DECIMALS TO 6
  637.    DECLARE ArrayN[10]
  638.    ArrayN[1]  = 87
  639.    ArrayN[2]  = 79
  640.    ArrayN[3]  = 97
  641.    ArrayN[4]  = 83
  642.    ArrayN[5]  = 90
  643.    ArrayN[6]  = 85
  644.    ArrayN[7]  = 51
  645.    ArrayN[8]  = 98
  646.    ArrayN[9]  = 99
  647.    ArrayN[10] = 88
  648.    TheSum     = ASum(ArrayN)
  649.    ? TheSum
  650. *  The Sum of the array = 857.0
  651. *  ...
  652.  
  653. FUNCTION ASUM
  654. *╔════════════════════════════════════════════════════╗
  655. *║ Program...: ASUM                                   ║
  656. *║ Author....: Phil Steele - President                ║
  657. *║             Phillipps Computer Systems Inc.        ║
  658. *║ Address...: 52 Hook Mountain Road,                 ║
  659. *║             Montville NJ 07045                     ║
  660. *║ Phone.....: (201) 575-8575                         ║
  661. *║ Date......: 03/22/88                               ║
  662. *║ Notice....: Copyright 1988  Philip Steele,         ║
  663. *║             All Rights Reserved.                   ║
  664. *║ Notes.....: This function sums the elements of an  ║
  665. *║             array.                                 ║
  666. *║ Parameters: ArrayN - The array containing numeric  ║
  667. *║                      elements to sum.              ║
  668. *╚════════════════════════════════════════════════════╝
  669. PARAMETERS ArrayN
  670. PRIVATE J, N, Tot
  671. STORE 0 TO J, Tot
  672. J = LEN(ArrayN)
  673. FOR N = 1 TO J
  674.    Tot = Tot + ArrayN[N]
  675. Next
  676. RETURN(Tot)
  677. ************************************************************************
  678. *Calling code:
  679. *  SAMPLE2
  680. *  ...
  681.    CLEAR
  682.    SET DECIMALS TO 6
  683.    DECLARE ArrayN[10]
  684.    ArrayN[1]  = 87
  685.    ArrayN[2]  = 79
  686.    ArrayN[3]  = 97
  687.    ArrayN[4]  = 83
  688.    ArrayN[5]  = 90
  689.    ArrayN[6]  = 85
  690.    ArrayN[7]  = 51
  691.    ArrayN[8]  = 98
  692.    ArrayN[9]  = 99
  693.    ArrayN[10] = 88
  694.    TheAvg     = AAvg(ArrayN)
  695.    ? TheAvg
  696. *  The Avg of the array = 85.7
  697. *  ...
  698.  
  699. FUNCTION AAVG
  700. *╔════════════════════════════════════════════════════╗
  701. *║ Program...: AAVG                                   ║
  702. *║ Author....: Phil Steele - President                ║
  703. *║             Phillipps Computer Systems Inc.        ║
  704. *║ Address...: 52 Hook Mountain Road,                 ║
  705. *║             Montville NJ 07045                     ║
  706. *║ Phone.....: (201) 575-8575                         ║
  707. *║ Date......: 03/22/88                               ║
  708. *║ Notice....: Copyright 1988  Philip Steele,         ║
  709. *║             All Rights Reserved.                   ║
  710. *║ Notes.....: This function computes the average of  ║
  711. *║             the elements in the array.             ║
  712. *║ Parameters: ArrayN - The array containing numeric  ║
  713. *║                      elements to average.          ║
  714. *╚════════════════════════════════════════════════════╝
  715. PARAMETERS ArrayN
  716. PRIVATE J, N, Tot, Avg
  717. STORE 0 TO J, Tot, Avg
  718. J = LEN(ArrayN)
  719. FOR N = 1 TO J
  720.    Tot = Tot + ArrayN[N]
  721. Next
  722. Avg = Tot / J
  723. RETURN(Avg)
  724. ************************************************************************
  725. *Calling code:
  726. *  SAMPLE2
  727. *  ...
  728.    CLEAR
  729.    SET DECIMALS TO 6
  730.    DECLARE ArrayN[10]
  731.    ArrayN[1]  = 87
  732.    ArrayN[2]  = 79
  733.    ArrayN[3]  = 97
  734.    ArrayN[4]  = 83
  735.    ArrayN[5]  = 90
  736.    ArrayN[6]  = 85
  737.    ArrayN[7]  = 51
  738.    ArrayN[8]  = 98
  739.    ArrayN[9]  = 99
  740.    ArrayN[10] = 88
  741.    TheVar     = AVar(ArrayN)
  742.    ? TheVar
  743. *  The Variance of the array = 193.122222
  744. *  ...
  745.  
  746. FUNCTION AVAR
  747. *╔════════════════════════════════════════════════════╗
  748. *║ Program...: AVAR                                   ║
  749. *║ Author....: Phil Steele - President                ║
  750. *║             Phillipps Computer Systems Inc.        ║
  751. *║ Address...: 52 Hook Mountain Road,                 ║
  752. *║             Montville NJ 07045                     ║
  753. *║ Phone.....: (201) 575-8575                         ║
  754. *║ Date......: 03/22/88                               ║
  755. *║ Notice....: Copyright 1988  Philip Steele,         ║
  756. *║             All Rights Reserved.                   ║
  757. *║ Notes.....: This function computes the variance of ║
  758. *║             the elements of an array               ║
  759. *║ Parameters: ArrayN - The array containing numeric  ║
  760. *║                      elements to compute the       ║
  761. *║                      variance of.                  ║
  762. *╚════════════════════════════════════════════════════╝
  763. PARAMETERS ArrayN
  764. PRIVATE J, N, Tot, SSq, Avg, Var
  765. STORE 0 TO J, Tot, SSq, Avg, Var
  766. J = LEN(ArrayN)
  767. FOR N = 1 TO J
  768.    Tot = Tot + ArrayN[N]
  769.    SSq = SSq + (ArrayN[N] * ArrayN[N])
  770. Next
  771. Var = (SSq - (Tot * Tot) / J) / (J - 1)
  772. RETURN(Var)
  773. ************************************************************************
  774. *Calling code:
  775. *  SAMPLE2
  776. *  ...
  777.    CLEAR
  778.    SET DECIMALS TO 6
  779.    DECLARE ArrayN[10]
  780.    ArrayN[1]  = 87
  781.    ArrayN[2]  = 79
  782.    ArrayN[3]  = 97
  783.    ArrayN[4]  = 83
  784.    ArrayN[5]  = 90
  785.    ArrayN[6]  = 85
  786.    ArrayN[7]  = 51
  787.    ArrayN[8]  = 98
  788.    ArrayN[9]  = 99
  789.    ArrayN[10] = 88
  790.    TheSD      = ASD(ArrayN)
  791.    ? TheSD
  792.  
  793. *  The Std Dev of the array = 13.896842
  794. *  ...
  795.  
  796. FUNCTION ASD
  797. *╔════════════════════════════════════════════════════╗
  798. *║ Program...: ASD                                    ║
  799. *║ Author....: Phil Steele - President                ║
  800. *║             Phillipps Computer Systems Inc.        ║
  801. *║ Address...: 52 Hook Mountain Road,                 ║
  802. *║             Montville NJ 07045                     ║
  803. *║ Phone.....: (201) 575-8575                         ║
  804. *║ Date......: 03/22/88                               ║
  805. *║ Notice....: Copyright 1988  Philip Steele,         ║
  806. *║             All Rights Reserved.                   ║
  807. *║ Notes.....: This function computes the standard    ║
  808. *║             deviation of the elements of an array  ║
  809. *║ Parameters: ArrayN - The array containing numeric  ║
  810. *║                      elements to compute the       ║
  811. *║                      standard deviation of.        ║
  812. *╚════════════════════════════════════════════════════╝
  813. PARAMETERS ArrayN
  814. PRIVATE J, N, Tot, SSq, Avg, Var, Std
  815. * Note: If you already have a variance function
  816. * just use the next line without the comment.
  817. * RETURN(AVar(ArrayN)^0.5)
  818. STORE 0 TO J, Tot, SSq, Avg, Var, Std
  819. J = LEN(ArrayN)
  820. FOR N = 1 TO J
  821.    Tot = Tot + ArrayN[N]
  822.    SSq = SSq + (ArrayN[N] * ArrayN[N])
  823. Next
  824. Var = (SSq - (Tot * Tot) / J) / (J - 1)
  825. Std = Var ^ 0.5
  826. RETURN(Std)
  827. ************************************************************************
  828. *Calling code:
  829. *  SAMPLE2
  830. *  ...
  831.    DECLARE ArrayN[9]
  832.    ArrayN[1] = "ABC"
  833.    ArrayN[2] = "AVD"
  834.    ArrayN[3] = "VEF"
  835.    ArrayN[4] = "BER"
  836.    ArrayN[5] = "AAA"
  837.    ArrayN[6] = "XEW"
  838.    ArrayN[7] = "EWW"
  839.    ArrayN[8] = "A"
  840.    ArrayN[9] = "BBG"
  841.    First     = AMin(ArrayN)
  842.    ? First
  843.  
  844. *  The minimum value in the array is "A"
  845. *  ...
  846.  
  847. FUNCTION AMIN
  848. *╔════════════════════════════════════════════════════╗
  849. *║ Program...: AMIN                                   ║
  850. *║ Author....: Phil Steele - President                ║
  851. *║             Phillipps Computer Systems Inc.        ║
  852. *║ Address...: 52 Hook Mountain Road,                 ║
  853. *║             Montville NJ 07045                     ║
  854. *║ Phone.....: (201) 575-8575                         ║
  855. *║ Date......: 03/22/88                               ║
  856. *║ Notice....: Copyright 1988  Philip Steele,         ║
  857. *║             All Rights Reserved.                   ║
  858. *║ Notes.....: This function finds the element of the ║
  859. *║             array containing the lowest value, and ║
  860. *║             returns its value.                     ║
  861. *║ Parameters: Array - The array containing elements  ║
  862. *║                     which this function will use   ║
  863. *║                     to find the lowest.            ║
  864. *╚════════════════════════════════════════════════════╝
  865. PARAMETERS Array
  866. PRIVATE N, X, J
  867. N = LEN(Array)
  868. X = Array[1]
  869. FOR J = 2 TO N
  870.    X = IIF(Array[J]<X, Array[J], X)
  871. NEXT
  872. RETURN(X)
  873. ************************************************************************
  874. *Calling code:
  875. *  SAMPLE2
  876. *  ...
  877.    DECLARE ArrayN[9]
  878.    ArrayN[1] = "ABC"
  879.    ArrayN[2] = "AVD"
  880.    ArrayN[3] = "VEF"
  881.    ArrayN[4] = "BER"
  882.    ArrayN[5] = "AAA"
  883.    ArrayN[6] = "XEW"
  884.    ArrayN[7] = "EWW"
  885.    ArrayN[8] = "A"
  886.    ArrayN[9] = "BBG"
  887.    Last      = AMax(ArrayN)
  888.    ? Last
  889.  
  890. *  The maximum value in the array is "XEW"
  891. *  ...
  892.  
  893. FUNCTION AMAX
  894. *╔════════════════════════════════════════════════════╗
  895. *║ Program...: AMAX                                   ║
  896. *║ Author....: Phil Steele - President                ║
  897. *║             Phillipps Computer Systems Inc.        ║
  898. *║ Address...: 52 Hook Mountain Road,                 ║
  899. *║             Montville NJ 07045                     ║
  900. *║ Phone.....: (201) 575-8575                         ║
  901. *║ Date......: 03/22/88                               ║
  902. *║ Notice....: Copyright 1988  Philip Steele,         ║
  903. *║             All Rights Reserved.                   ║
  904. *║ Notes.....: This function finds the element of the ║
  905. *║             array containing the highest value,    ║
  906. *║             and returns its value.                 ║
  907. *║ Parameters: Array - The array containing elements  ║
  908. *║                     which this function will use   ║
  909. *║                     to find the highest.           ║
  910. *╚════════════════════════════════════════════════════╝
  911. PARAMETERS Array
  912. PRIVATE N, X, J
  913. N = LEN(Array)
  914. X = Array[1]
  915. FOR J = 2 TO N
  916.    X = IIF(Array[J]>X, Array[J], X)
  917. NEXT
  918. RETURN(X)
  919. ************************************************************************
  920. *Calling code:
  921. *  SAMPLE2
  922. *  ...
  923.    CLEAR
  924.    HexNum = "AAAA"
  925.    Dec    = DecEquiv(HexNum)
  926.    ? Dec
  927. *  The Decimal equivalent is 43690
  928. *  ...
  929.  
  930. FUNCTION DECEQUIV
  931. *╔════════════════════════════════════════════════════╗
  932. *║ Program...: DECEQUIV                               ║
  933. *║ Author....: Phil Steele - President                ║
  934. *║             Phillipps Computer Systems Inc.        ║
  935. *║ Address...: 52 Hook Mountain Road,                 ║
  936. *║             Montville NJ 07045                     ║
  937. *║ Phone.....: (201) 575-8575                         ║
  938. *║ Date......: 03/22/88                               ║
  939. *║ Notice....: Copyright 1988  Philip Steele,         ║
  940. *║             All Rights Reserved.                   ║
  941. *║ Notes.....: This function converts a hexadecimal   ║
  942. *║             number (0-FFFF) to a decimal number.   ║
  943. *║ Parameters: HexNum - The hexadecimal number to be  ║
  944. *║                      converted into a decimal      ║
  945. *║                      number.                       ║
  946. *╚════════════════════════════════════════════════════╝
  947. PARAMETERS HexN
  948. PRIVATE Ans, AllHex, N1, N2, N3, N4
  949. AllHex = "123456789ABCDEF"
  950. N1 = AT(SUBSTR(HexN,1,1), AllHex)
  951. N2 = AT(SUBSTR(HexN,2,1), AllHex)
  952. N3 = AT(SUBSTR(HexN,3,1), AllHex)
  953. N4 = AT(SUBSTR(HexN,4,1), AllHex)
  954. Ans = (N1 * 4096) + (N2 * 256) + (N3 * 16) + N4
  955. RETURN(Ans)
  956. ************************************************************************
  957. *Calling code:
  958. *  SAMPLE2
  959. *  ...
  960.    CLEAR
  961.    DecNum = 43690
  962.    Hex    = HexEquiv(DecNum)
  963.    ? Hex
  964. *  The Hexadecimal equivalent is AAAA
  965. *  ...
  966.  
  967. FUNCTION HEXEQUIV
  968. *╔════════════════════════════════════════════════════╗
  969. *║ Program...: HEXEQUIV                               ║
  970. *║ Author....: Phil Steele - President                ║
  971. *║             Phillipps Computer Systems Inc.        ║
  972. *║ Address...: 52 Hook Mountain Road,                 ║
  973. *║             Montville NJ 07045                     ║
  974. *║ Phone.....: (201) 575-8575                         ║
  975. *║ Date......: 03/22/88                               ║
  976. *║ Notice....: Copyright 1988  Philip Steele,         ║
  977. *║             All Rights Reserved.                   ║
  978. *║ Notes.....: This function converts a decimal       ║
  979. *║             number (0-65535) to a hexadecimal      ║
  980. *║             number.                                ║
  981. *║ Parameters: DecNum - The decimal number to be      ║
  982. *║                      converted into a hexadecimal  ║
  983. *║                      number.                       ║
  984. *╚════════════════════════════════════════════════════╝
  985. PARAMETERS DecN
  986. PRIVATE Ans, N1, N2, N3, N4, M1, M2, M3
  987. N1 = INT(DecN / 4096)
  988. M1 = N1 * 4096
  989. N2 = INT((DecN - M1) / 256)
  990. M2 = N2 * 256
  991. N3 = INT((DecN - M1 - M2) / 16)
  992. M3 = N3 * 16
  993. N4 = INT(DecN - M1 - M2 - M3)
  994. Ans = Let(N1) + Let(N2) + Let(N3) + Let(N4)
  995. RETURN(Ans)
  996.  
  997.  
  998. FUNCTION LET
  999. PARAMETER Num
  1000. IF Num < 10 .AND. Num > 0
  1001.    RETURN(STR(Num,1,0))
  1002. ENDIF
  1003. DO CASE
  1004.    CASE Num = 0
  1005.       RETURN("0")
  1006.    CASE Num = 10
  1007.       RETURN("A")
  1008.    CASE Num = 11
  1009.       RETURN("B")
  1010.    CASE Num = 12
  1011.       RETURN("C")
  1012.    CASE Num = 13
  1013.       RETURN("D")
  1014.    CASE Num = 14
  1015.       RETURN("E")
  1016.    CASE Num = 15
  1017.       RETURN("F")
  1018. ENDCASE
  1019. ************************************************************************
  1020. *Calling code:
  1021. *  SAMPLE2
  1022. *  ...
  1023.    CLEAR
  1024.    Mat = 27000
  1025.    Now = 10000
  1026.    Yrs = 12
  1027.    NRate = Rate(Mat, Now, Yrs)
  1028.    ? NRate
  1029. *  NRate Should be .0831 or 8.31%
  1030. *  ...
  1031.  
  1032. FUNCTION RATE
  1033. *╔════════════════════════════════════════════════════╗
  1034. *║ Program...: RATE                                   ║
  1035. *║ Author....: Phil Steele - President                ║
  1036. *║             Phillipps Computer Systems Inc.        ║
  1037. *║ Address...: 52 Hook Mountain Road,                 ║
  1038. *║             Montville NJ 07045                     ║
  1039. *║ Phone.....: (201) 575-8575                         ║
  1040. *║ Date......: 03/22/88                               ║
  1041. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1042. *║             All Rights Reserved.                   ║
  1043. *║ Notes.....: This function computes the interest    ║
  1044. *║             rate an investments earns.             ║
  1045. *║ Parameters: Mat - The dollar amount the investment ║
  1046. *║                   is worth at maturity.            ║
  1047. *║             Now - The dollar amount the investment ║
  1048. *║                   is worth at the start.           ║
  1049. *║             Yrs - The number of years required for ║
  1050. *║                   the investment to go from a      ║
  1051. *║                   starting value of Now to a final ║
  1052. *║                   value of Mat.                    ║
  1053. *╚════════════════════════════════════════════════════╝
  1054. PARAMETERS Mat, Now, Yrs
  1055. PRIVATE N, D, M , R
  1056. M = Yrs * 12
  1057. N = Mat
  1058. D = Now
  1059. R = ((N / D) ^ (1 / M)) - 1
  1060. RETURN(R*12)
  1061. ************************************************************************
  1062. *Calling code:
  1063. *  SAMPLE2
  1064. *  ...
  1065.    CLEAR
  1066.    Int = 10
  1067.    Mat = 20000
  1068.    Now = 10000
  1069.    NMonth = Term(Int, Mat, Now)
  1070.    ? NMonth
  1071. *  NMonth Should be 83.52
  1072. *  ...
  1073.  
  1074. FUNCTION TERM
  1075. *╔════════════════════════════════════════════════════╗
  1076. *║ Program...: TERM                                   ║
  1077. *║ Author....: Phil Steele - President                ║
  1078. *║             Phillipps Computer Systems Inc.        ║
  1079. *║ Address...: 52 Hook Mountain Road,                 ║
  1080. *║             Montville NJ 07045                     ║
  1081. *║ Phone.....: (201) 575-8575                         ║
  1082. *║ Date......: 03/22/88                               ║
  1083. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1084. *║             All Rights Reserved.                   ║
  1085. *║ Notes.....: This function computes the time        ║
  1086. *║             required for an investment to grow     ║
  1087. *║             from a value of Now to a value of Mat  ║
  1088. *║             at a compound interest rate of Int.    ║
  1089. *║ Parameters: Mat - The dollar amount the investment ║
  1090. *║                   is worth at maturity.            ║
  1091. *║             Now - The dollar amount the investment ║
  1092. *║                   is worth at the start.           ║
  1093. *║             Int - The compound interest rate which ║
  1094. *║                   the investment in invested at.   ║
  1095. *╚════════════════════════════════════════════════════╝
  1096. PARAMETERS Int, Mat, Now
  1097. PRIVATE N, D, I
  1098. I = Int * 0.01 / 12
  1099. N = LOG(Mat / Now)
  1100. D = LOG(1 + I)
  1101. RETURN(N/D)
  1102. ************************************************************************
  1103. *Calling code:
  1104. *  SAMPLE2
  1105. *  ...
  1106.    CLEAR
  1107.    Int = 9.5
  1108.    Mat = 200000
  1109.    Dep = 2000
  1110.    NYears = Term2(Dep, Int, Mat)
  1111.    ? NYrs
  1112. *  NYrs Should be 25.91
  1113. *  ...
  1114.  
  1115. FUNCTION TERM2
  1116. *╔════════════════════════════════════════════════════╗
  1117. *║ Program...: TERM2                                  ║
  1118. *║ Author....: Phil Steele - President                ║
  1119. *║             Phillipps Computer Systems Inc.        ║
  1120. *║ Address...: 52 Hook Mountain Road,                 ║
  1121. *║             Montville NJ 07045                     ║
  1122. *║ Phone.....: (201) 575-8575                         ║
  1123. *║ Date......: 03/22/88                               ║
  1124. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1125. *║             All Rights Reserved.                   ║
  1126. *║ Notes.....: This function computes the time        ║
  1127. *║             required for a periodic investment     ║
  1128. *║             to grow to a value of Mat at a         ║
  1129. *║             compound interest rate of Int.         ║
  1130. *║ Parameters: Mat - The dollar amount the investment ║
  1131. *║                   is worth at maturity.            ║
  1132. *║             Dep - The dollar amount of the         ║
  1133. *║                   periodic investment.             ║
  1134. *║             Int - The compound interest rate which ║
  1135. *║                   the investment in invested at.   ║
  1136. *╚════════════════════════════════════════════════════╝
  1137. PARAMETERS Dep, Int, Mat
  1138. PRIVATE N, D
  1139. IR = Int * 0.01
  1140. N  = LOG(1 + (Mat * IR / Dep))
  1141. D  = LOG(1 + IR)
  1142. RETURN(N/D)
  1143. ************************************************************************
  1144. *Calling code:
  1145. *  SAMPLE2
  1146. *  ...
  1147.    CLEAR
  1148.    Int  = 11.5
  1149.    Prin = 250000
  1150.    Yrs  = 30
  1151.    MPay = Pmts(Int, Prin, Yrs)
  1152.    ? MPay
  1153. *  MPay Should be $2,475.73
  1154. *  ...
  1155.  
  1156. FUNCTION PMTS
  1157. *╔════════════════════════════════════════════════════╗
  1158. *║ Program...: PMTS                                   ║
  1159. *║ Author....: Phil Steele - President                ║
  1160. *║             Phillipps Computer Systems Inc.        ║
  1161. *║ Address...: 52 Hook Mountain Road,                 ║
  1162. *║             Montville NJ 07045                     ║
  1163. *║ Phone.....: (201) 575-8575                         ║
  1164. *║ Date......: 03/22/88                               ║
  1165. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1166. *║             All Rights Reserved.                   ║
  1167. *║ Notes.....: This function computes the monthly     ║
  1168. *║             payment due on a straight interest     ║
  1169. *║             loan such as a mortgage.               ║
  1170. *║ Parameters: Int  - The loan interest rate.         ║
  1171. *║             Prin - The total amount of the loan.   ║
  1172. *║             Yrs  - The number of years the loan    ║
  1173. *║                    is for.                         ║
  1174. *╚════════════════════════════════════════════════════╝
  1175. PARAMETERS Int, Prin, Yrs
  1176. PRIVATE N, D, I, Y
  1177. Y = Yrs * 12
  1178. I = Int * 0.01 / 12
  1179. D = 1-(I + 1) ^ -Y
  1180. RETURN(Prin*I/D)
  1181. ************************************************************************
  1182. *Calling code:
  1183. *  SAMPLE2
  1184. *  ...
  1185.    CLEAR
  1186.    Int = 10
  1187.    Dep = 2000
  1188.    Yrs = 20
  1189.    NFV = FV(Dep, Int, Yrs)
  1190.    ? NFV
  1191. *  NFV Should be $114,550
  1192. *  ...
  1193.  
  1194. FUNCTION FV
  1195. *╔════════════════════════════════════════════════════╗
  1196. *║ Program...: FV                                     ║
  1197. *║ Author....: Phil Steele - President                ║
  1198. *║             Phillipps Computer Systems Inc.        ║
  1199. *║ Address...: 52 Hook Mountain Road,                 ║
  1200. *║             Montville NJ 07045                     ║
  1201. *║ Phone.....: (201) 575-8575                         ║
  1202. *║ Date......: 03/22/88                               ║
  1203. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1204. *║             All Rights Reserved.                   ║
  1205. *║ Notes.....: This function computes the future      ║
  1206. *║             value of a periodic investment at a    ║
  1207. *║             constant interest rate.                ║
  1208. *║ Parameters: Int - The interest rate.               ║
  1209. *║             Dep - The periodic investment amount.  ║
  1210. *║             Yrs - The number of years the Dep is   ║
  1211. *║                   made over.                       ║
  1212. *╚════════════════════════════════════════════════════╝
  1213. PARAMETERS Dep, Int, Yrs
  1214. PRIVATE N, D
  1215. D = Int * 0.01
  1216. N = ((1 + D) ^ Yrs) - 1
  1217. RETURN(N*Dep/D)
  1218. ************************************************************************
  1219. *Calling code:
  1220. *  SAMPLE2
  1221. *  ...
  1222.    CLEAR
  1223.    Int = 9.5
  1224.    Pay = 50000
  1225.    Yrs = 20
  1226.    NPV = PV(Int, Pay, Yrs)
  1227.    ? NPV
  1228. *  NPV Should be $440,619.11
  1229. *  ...
  1230.  
  1231. FUNCTION PV
  1232. *╔════════════════════════════════════════════════════╗
  1233. *║ Program...: PV                                     ║
  1234. *║ Author....: Phil Steele - President                ║
  1235. *║             Phillipps Computer Systems Inc.        ║
  1236. *║ Address...: 52 Hook Mountain Road,                 ║
  1237. *║             Montville NJ 07045                     ║
  1238. *║ Phone.....: (201) 575-8575                         ║
  1239. *║ Date......: 03/22/88                               ║
  1240. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1241. *║             All Rights Reserved.                   ║
  1242. *║ Notes.....: This function computes the present     ║
  1243. *║             value of a periodic payment invested   ║
  1244. *║             at a constant interest rate.           ║
  1245. *║ Parameters: Int - The interest rate.               ║
  1246. *║             Pay - The periodic payment amount.     ║
  1247. *║             Yrs - The number of years the Pay is   ║
  1248. *║                   made over.                       ║
  1249. *╚════════════════════════════════════════════════════╝
  1250. PARAMETERS Int, Pay, Yrs
  1251. PRIVATE N, D, I
  1252. D = Int * 0.01
  1253. N = 1 - ((1 + D) ^ -Yrs)
  1254. RETURN(Pay*N/D)
  1255. ************************************************************************
  1256. *Calling code:
  1257. *  SAMPLE2
  1258. *  ...
  1259.    CLEAR
  1260.    Cost = 10000
  1261.    Sal  = 2000
  1262.    Life = 5
  1263.    Yr   = 2
  1264.    SDep = SL (Cost, Sal, Life)
  1265.    ? SDep
  1266. *  SDep Should be 1600
  1267. *  ...
  1268.  
  1269. FUNCTION SL
  1270. *╔════════════════════════════════════════════════════╗
  1271. *║ Program...: SL                                     ║
  1272. *║ Author....: Phil Steele - President                ║
  1273. *║             Phillipps Computer Systems Inc.        ║
  1274. *║ Address...: 52 Hook Mountain Road,                 ║
  1275. *║             Montville NJ 07045                     ║
  1276. *║ Phone.....: (201) 575-8575                         ║
  1277. *║ Date......: 03/22/88                               ║
  1278. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1279. *║             All Rights Reserved.                   ║
  1280. *║ Notes.....: This function computes the annual      ║
  1281. *║             depreciation of an asset with salvage  ║
  1282. *║             value of Sal over a useful life of     ║
  1283. *║             Life.                                  ║
  1284. *║ Parameters: Cost - Cost of the asset.              ║
  1285. *║             Sal  - Salvage value of the asset.     ║
  1286. *║             Life - Useful life of the asset.       ║
  1287. *╚════════════════════════════════════════════════════╝
  1288. PARAMETERS C, S, L
  1289. PRIVATE    C, S
  1290. N = (C - S)
  1291. RETURN(N/L)
  1292. ************************************************************************
  1293. *Calling code:
  1294. *  SAMPLE2
  1295. *  ...
  1296.    CLEAR
  1297.    Cost = 10000
  1298.    Sal  = 2000
  1299.    Life = 5
  1300.    Yr   = 2
  1301.    YDep = SYD(Cost, Sal, Life, Yr)
  1302.    ? YDep
  1303. *  YDep Should be 2133
  1304. *  ...
  1305.  
  1306. FUNCTION SYD
  1307. *╔════════════════════════════════════════════════════╗
  1308. *║ Program...: SYD                                    ║
  1309. *║ Author....: Phil Steele - President                ║
  1310. *║             Phillipps Computer Systems Inc.        ║
  1311. *║ Address...: 52 Hook Mountain Road,                 ║
  1312. *║             Montville NJ 07045                     ║
  1313. *║ Phone.....: (201) 575-8575                         ║
  1314. *║ Date......: 03/22/88                               ║
  1315. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1316. *║             All Rights Reserved.                   ║
  1317. *║ Notes.....: This function computes the yearly (Yr) ║
  1318. *║             depreciation of an asset with salvage  ║
  1319. *║             value of Sal over a useful life of     ║
  1320. *║             Life.                                  ║
  1321. *║ Parameters: Cost - Cost of the asset.              ║
  1322. *║             Sal  - Salvage value of the asset.     ║
  1323. *║             Life - Useful life of the asset.       ║
  1324. *║             Yr   - The year you wish to compute    ║
  1325. *║                    the depreciation for.           ║
  1326. *╚════════════════════════════════════════════════════╝
  1327. PARAMETERS C, S, L, Y
  1328. PRIVATE    C, S, L, Y
  1329. N = (C - S) * (L - Y + 1)
  1330. D = (L * (L + 1) / 2)
  1331. RETURN(N/D)
  1332. ************************************************************************
  1333. *Calling code:
  1334. *  SAMPLE2
  1335. *  ...
  1336.    CLEAR
  1337.    Cost = 10000
  1338.    Sal  = 2000
  1339.    Life = 5
  1340.    Yr   = 2
  1341.    DDep = DDL(Cost, Sal, Life, Yr)
  1342.    ? DDep
  1343. *  DDep Should be 2400
  1344. *  ...
  1345.  
  1346. FUNCTION DDL
  1347. *╔════════════════════════════════════════════════════╗
  1348. *║ Program...: DDL                                    ║
  1349. *║ Author....: Phil Steele - President                ║
  1350. *║             Phillipps Computer Systems Inc.        ║
  1351. *║ Address...: 52 Hook Mountain Road,                 ║
  1352. *║             Montville NJ 07045                     ║
  1353. *║ Phone.....: (201) 575-8575                         ║
  1354. *║ Date......: 03/22/88                               ║
  1355. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1356. *║             All Rights Reserved.                   ║
  1357. *║ Notes.....: This function computes the yearly (Yr) ║
  1358. *║             depreciation of an asset with salvage  ║
  1359. *║             value of Sal over a useful life of     ║
  1360. *║             Life.                                  ║
  1361. *║ Parameters: Cost - Cost of the asset.              ║
  1362. *║             Sal  - Salvage value of the asset.     ║
  1363. *║             Life - Useful life of the asset.       ║
  1364. *║             Yr   - The year you wish to compute    ║
  1365. *║                    the depreciation for.           ║
  1366. *╚════════════════════════════════════════════════════╝
  1367. PARAMETERS C, S, L, Y
  1368. PRIVATE    C, S, L, Y, N, NewTotal, TotDep
  1369. CLEAR
  1370. DECLARE YrDep[L]
  1371. NewTotal = C
  1372. TotDep   = 0
  1373. FOR N = 1 TO Y
  1374.    YrDep[N] = NewTotal * 2 / L
  1375.    NewTotal = NewTotal - YrDep[N]
  1376.    TotDep   = IIF(N<=Y, TotDep+YrDep[N], TotDep)
  1377. NEXT
  1378. RETURN(YrDep[Y])
  1379. ************************************************************************
  1380. *Calling code:
  1381. *SAMPLE2
  1382. * ...
  1383. DECLARE AllFiles[ADIR("*.DBF")]
  1384. NumOfFiles = ADIR("*.DBF", ALLFILES)
  1385. ? NumOfFiles
  1386. FOR J = 1 TO NumOfFiles
  1387.    ? AllFiles[J]
  1388.    NEXT
  1389. WAIT
  1390. ASORT(AllFiles)
  1391. FOR J = 1 TO NumOfFiles
  1392.    ? AllFiles[J]
  1393. NEXT
  1394. *...
  1395.  
  1396. FUNCTION ASORT
  1397. *╔════════════════════════════════════════════════════╗
  1398. *║ Program...: ASORT                                  ║
  1399. *║ Author....: Phil Steele - President                ║
  1400. *║             Phillipps Computer Systems Inc.        ║
  1401. *║ Address...: 52 Hook Mountain Road,                 ║
  1402. *║             Montville NJ 07045                     ║
  1403. *║ Phone.....: (201) 575-8575                         ║
  1404. *║ Date......: 03/22/88                               ║
  1405. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1406. *║             All Rights Reserved.                   ║
  1407. *║ Notes.....: This function returns an array sorted  ║
  1408. *║             in ascending order.                    ║
  1409. *║ Parameters: AName - The array to sort.             ║
  1410. *╚════════════════════════════════════════════════════╝
  1411. PARAMETERS AName
  1412. PRIVATE J, K, C, ALen
  1413. ALen = LEN(AName)
  1414. FOR J = 1 TO ALen - 1
  1415.    FOR K = J+1 TO ALen
  1416.       IF AName[K] < AName[J]
  1417.          C        = AName[K]
  1418.          AName[K] = AName[J]
  1419.          AName[J] = C
  1420.       ENDIF
  1421.    NEXT
  1422. NEXT
  1423. RETURN(.T.)
  1424. ************************************************************************
  1425. Calling code:
  1426. *SAMPLE2
  1427. *...
  1428. SELECT A
  1429. Rank = ALLTRIM(A->EmpRank)
  1430. @ 12, 12 SAY Rank  PICTURE "@!"
  1431. *...
  1432.  
  1433. FUNCTION ALLTRIM
  1434. *╔════════════════════════════════════════════════════╗
  1435. *║ Program...: ALLTRIM                                ║
  1436. *║ Author....: Phil Steele - President                ║
  1437. *║             Phillipps Computer Systems Inc.        ║
  1438. *║ Address...: 52 Hook Mountain Road,                 ║
  1439. *║             Montville NJ 07045                     ║
  1440. *║ Phone.....: (201) 575-8575                         ║
  1441. *║ Date......: 03/22/88                               ║
  1442. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1443. *║             All Rights Reserved.                   ║
  1444. *║ Notes.....: This function returns a string with    ║
  1445. *║             leading and trialing blanks revoved.   ║
  1446. *║ Parameters: Str - The string to trim.              ║
  1447. *╚════════════════════════════════════════════════════╝
  1448. PARAMETER Str
  1449. RETURN (LTRIM(TRIM(Str)))
  1450. *END:ALLTRIM
  1451. ************************************************************************
  1452. *  SAMPLE2
  1453. *  ...
  1454. CLEAR
  1455. X = " 1 "
  1456. Y = " 22"
  1457. @ 12,12 SAY X PICTURE "!!!"
  1458. @ 12,15 SAY "/"
  1459. @ 12,16 SAY Y PICTURE "!!!"
  1460.  
  1461. @ 14,12 SAY  NTRIM(X,3) PICTURE "!!!"
  1462. @ 14,15 SAY "/"
  1463. @ 14,16 SAY LTRIM(Y) PICTURE "!!!"
  1464. * ...
  1465.  
  1466. FUNCTION NTRIM
  1467. *╔════════════════════════════════════════════════════╗
  1468. *║ Program...: NTRIM                                  ║
  1469. *║ Author....: Phil Steele - President                ║
  1470. *║             Phillipps Computer Systems Inc.        ║
  1471. *║ Address...: 52 Hook Mountain Road,                 ║
  1472. *║             Montville NJ 07045                     ║
  1473. *║ Phone.....: (201) 575-8575                         ║
  1474. *║ Date......: 03/22/88                               ║
  1475. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1476. *║             All Rights Reserved.                   ║
  1477. *║ Notes.....: This function returns a right          ║
  1478. *║             justified pseudo-numeric field         ║
  1479. *║ Parameters: PNum - The pseudo-numeric variable     ║
  1480. *║             PLen - The field length.               ║
  1481. *╚════════════════════════════════════════════════════╝
  1482. PARAMETERS PNum, PLen
  1483. RETURN(STR(VAL(PNum),PLen,0))
  1484. ************************************************************************
  1485. *  SAMPLE2
  1486. *  ...
  1487. CLEAR
  1488. X = 1
  1489. Y = 22
  1490. @ 12,12 SAY X PICTURE "9999"
  1491. @ 12,16 SAY "/"
  1492. @ 12,17 SAY Y PICTURE "9999"
  1493.  
  1494. SX = ZFILL(X,4)
  1495. SY = ZFILL(Y,4)
  1496. @ 14,12 SAY SX PICTURE "!!!!"
  1497. @ 14,16 SAY "/"
  1498. @ 14,17 SAY SY PICTURE "!!!!"
  1499. *  ...
  1500.  
  1501. FUNCTION ZFILL
  1502. *╔════════════════════════════════════════════════════╗
  1503. *║ Program...: ZFILL                                  ║
  1504. *║ Author....: Phil Steele - President                ║
  1505. *║             Phillipps Computer Systems Inc.        ║
  1506. *║ Address...: 52 Hook Mountain Road,                 ║
  1507. *║             Montville NJ 07045                     ║
  1508. *║ Phone.....: (201) 575-8575                         ║
  1509. *║ Date......: 03/22/88                               ║
  1510. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1511. *║             All Rights Reserved.                   ║
  1512. *║ Notes.....: This function display a numeric field  ║
  1513. *║             justified with leading zeros.          ║
  1514. *║ Parameters: Num  - The numeric field.              ║
  1515. *║             Size - The total field length.         ║
  1516. *╚════════════════════════════════════════════════════╝
  1517. PARAMETERS Num, Size
  1518. PRIVATE NewNum, N
  1519. NewNum = LTRIM(STR(Num,19,0))
  1520. N      = LEN(NewNum)
  1521. NewNum = REPLICATE("0", Size - N) + NewNum
  1522. RETURN(NewNum)
  1523. ************************************************************************
  1524. * SAMPLE2
  1525. * ...
  1526. FName = "    PHIL"
  1527. LName = "    STEELE"
  1528. Name  = LJust(FName) + LJust(LName)
  1529. ? Name
  1530. ? Len(Name)
  1531. * Len(Name) SHOULD = 18
  1532. * ...
  1533.  
  1534. FUNCTION LJUST
  1535. *╔════════════════════════════════════════════════════╗
  1536. *║ Program...: LJUST                                  ║
  1537. *║ Author....: Phil Steele - President                ║
  1538. *║             Phillipps Computer Systems Inc.        ║
  1539. *║ Address...: 52 Hook Mountain Road,                 ║
  1540. *║             Montville NJ 07045                     ║
  1541. *║ Phone.....: (201) 575-8575                         ║
  1542. *║ Date......: 03/22/88                               ║
  1543. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1544. *║             All Rights Reserved.                   ║
  1545. *║ Notes.....: This function left justifies a string. ║
  1546. *║ Parameters: InStr - The string to left justify.    ║
  1547. *╚════════════════════════════════════════════════════╝
  1548. PARAMETERS InStr
  1549. PRIVATE N, OutStr
  1550. N      = LEN(InStr)
  1551. OutStr = LTRIM(InStr)
  1552. OutStr = OutStr + REPLICATE(" ", N-LEN(OutStr))
  1553. RETURN(OutStr)
  1554. ************************************************************************
  1555. * SAMPLE2
  1556. * ...
  1557. Str    = "ABCDEFGH"
  1558. NewStr = Left(STR,5)
  1559. ? NewStr
  1560. * ...
  1561.  
  1562. FUNCTION LEFT
  1563. *╔════════════════════════════════════════════════════╗
  1564. *║ Program...: LEFT                                   ║
  1565. *║ Author....: Phil Steele - President                ║
  1566. *║             Phillipps Computer Systems Inc.        ║
  1567. *║ Address...: 52 Hook Mountain Road,                 ║
  1568. *║             Montville NJ 07045                     ║
  1569. *║ Phone.....: (201) 575-8575                         ║
  1570. *║ Date......: 03/22/88                               ║
  1571. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1572. *║             All Rights Reserved.                   ║
  1573. *║ Notes.....: This function returns the left Num of  ║
  1574. *║             characters.                            ║
  1575. *║ Parameters: Str - The string to return the left    ║
  1576. *║                   Num of characters from.          ║
  1577. *║             Num - The number of chacters to return ║
  1578. *║                   from the left of the string.     ║
  1579. *╚════════════════════════════════════════════════════╝
  1580. PARAMETERS Str, Size
  1581. PRIVATE NewStr
  1582. NewStr = SUBSTR(Str,1,Size)
  1583. RETURN(NewStr)
  1584. ************************************************************************
  1585. * SAMPLE2
  1586. * ...
  1587. Str    = "ABCDEFGH"
  1588. NewStr = Right(STR,5)
  1589. ? NewStr
  1590. * ...
  1591.  
  1592. FUNCTION RIGHT
  1593. *╔════════════════════════════════════════════════════╗
  1594. *║ Program...: RIGHT                                  ║
  1595. *║ Author....: Phil Steele - President                ║
  1596. *║             Phillipps Computer Systems Inc.        ║
  1597. *║ Address...: 52 Hook Mountain Road,                 ║
  1598. *║             Montville NJ 07045                     ║
  1599. *║ Phone.....: (201) 575-8575                         ║
  1600. *║ Date......: 03/22/88                               ║
  1601. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1602. *║             All Rights Reserved.                   ║
  1603. *║ Notes.....: This function returns the right Num of ║
  1604. *║             characters.                            ║
  1605. *║ Parameters: Str - The string to return the right   ║
  1606. *║                   Num of characters from.          ║
  1607. *║             Num - The number of chacters to return ║
  1608. *║                   from the right of the string.    ║
  1609. *╚════════════════════════════════════════════════════╝
  1610. PARAMETERS Str, Size
  1611. PRIVATE Start, NewStr
  1612. Start  = LEN(Str) - Size + 1
  1613. NewStr = SUBSTR(Str,Start)
  1614. RETURN(NewStr)
  1615. ************************************************************************
  1616. * SAMPLE2
  1617. * ...
  1618. SET DEVICE TO PRINT
  1619. N = 0
  1620. Esc = CHR(27)
  1621. Start = Esc + "*p0x0Y"
  1622. @ N,0 SAY "&Start"
  1623. HLine(1,2,6,2,N)
  1624. EJECT
  1625. SET DEVICE TO SCREEN
  1626. * ...
  1627.  
  1628. FUNCTION HLINE
  1629. *╔════════════════════════════════════════════════════╗
  1630. *║ Program...: HLINE                                  ║
  1631. *║ Author....: Phil Steele - President                ║
  1632. *║             Phillipps Computer Systems Inc.        ║
  1633. *║ Address...: 52 Hook Mountain Road,                 ║
  1634. *║             Montville NJ 07045                     ║
  1635. *║ Phone.....: (201) 575-8575                         ║
  1636. *║ Date......: 03/22/88                               ║
  1637. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1638. *║             All Rights Reserved.                   ║
  1639. *║ Notes.....: This function draws a horizontal line  ║
  1640. *║             on a laser printer.                    ║
  1641. *║ Parameters: StartD - The starting position of the  ║
  1642. *║                      line down from the top of the ║
  1643. *║                      page in inches.               ║
  1644. *║             StartL - The starting position of the  ║
  1645. *║                      line in from the left of the  ║
  1646. *║                      page in inches.               ║
  1647. *║             HLen   - The length of the horizontal  ║
  1648. *║                      line in inches.               ║
  1649. *║             LWidth - The width of the horizontal   ║
  1650. *║                      line in 1/300's of an inch.   ║
  1651. *║             J      - The line current line number  ║
  1652. *║                      where printing is occurring.  ║
  1653. *╚════════════════════════════════════════════════════╝
  1654. PARAMETERS StartD, StartL, HLen, LWidth, J
  1655. PRIVATE    CompD,  CompL,  CLen, J, Esc
  1656. Esc     = CHR(27)
  1657. CompD   = 300 * StartD - 150
  1658. CompD   = IIF(CompD<0, 0, CompD)
  1659. CompL   = 300 * StartL - 75
  1660. CompL   = IIF(CompL<0, 0, CompL)
  1661. CLen    = 300 * HLen
  1662. HorLine = Esc + "*p" + STR(CompD,5,0)  + "y" + STR(CompL,5,0) + "X" + ;
  1663.           Esc + "*c" + STR(LWidth,2,0) + "b" + STR(CLen, 5,0) + "a0P"
  1664. @ J,0 SAY "&HorLine"
  1665. RETURN(.T.)
  1666. ************************************************************************
  1667. * SAMPLE2
  1668. * ...
  1669. SET DEVICE TO PRINT
  1670. N = 0
  1671. Esc = CHR(27)
  1672. Start = Esc + "*p0x0Y"
  1673. @ N,0 SAY "&Start"
  1674. VLine(1,2,6,2,N)
  1675. EJECT
  1676. SET DEVICE TO SCREEN
  1677. * ...
  1678.  
  1679. FUNCTION VLINE
  1680. *╔════════════════════════════════════════════════════╗
  1681. *║ Program...: VLINE                                  ║
  1682. *║ Author....: Phil Steele - President                ║
  1683. *║             Phillipps Computer Systems Inc.        ║
  1684. *║ Address...: 52 Hook Mountain Road,                 ║
  1685. *║             Montville NJ 07045                     ║
  1686. *║ Phone.....: (201) 575-8575                         ║
  1687. *║ Date......: 03/22/88                               ║
  1688. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1689. *║             All Rights Reserved.                   ║
  1690. *║ Notes.....: This function draws a horizontal line  ║
  1691. *║             on a laser printer.                    ║
  1692. *║ Parameters: StartD - The starting position of the  ║
  1693. *║                      line down from the top of the ║
  1694. *║                      page in inches.               ║
  1695. *║             StartL - The starting position of the  ║
  1696. *║                      line in from the left of the  ║
  1697. *║                      page in inches.               ║
  1698. *║             HLen   - The length of the vertical    ║
  1699. *║                      line in inches.               ║
  1700. *║             LWidth - The width of the vertical     ║
  1701. *║                      line in 1/300's of an inch.   ║
  1702. *║             J      - The line current line number  ║
  1703. *║                      where printing is occurring.  ║
  1704. *╚════════════════════════════════════════════════════╝
  1705. PARAMETERS StartD, StartL, HLen, LWidth, J
  1706. PRIVATE    CompD,  CompL,  CLen, J, Esc
  1707. Esc     = CHR(27)
  1708. CompD   = 300 * StartD - 150
  1709. CompD   = IIF(CompD<0, 0, CompD)
  1710. CompL   = 300 * StartL - 75
  1711. CompL   = IIF(CompL<0, 0, CompL)
  1712. CLen    = 300 * VLen
  1713. VerLine = Esc + "*p" + STR(CompD,5,0)  + "y" + STR(CompL,5,0) + "X" + ;
  1714.           Esc + "*c" + STR(LWidth,2,0) + "a" + STR(CLen, 5,0) + "b0P"
  1715. @ J,0 SAY "&VerLine"
  1716. RETURN(.T.)
  1717. ************************************************************************
  1718. * SAMPLE2
  1719. * ...
  1720. SET DEVICE TO PRINT
  1721. N = 0
  1722. Esc = CHR(27)
  1723. Start = Esc + "*p0x0Y"
  1724. @ N,0 SAY "&Start"
  1725. HPBox(1,2,5,3,2,N)
  1726. EJECT
  1727. SET DEVICE TO SCREEN
  1728. * ...
  1729.  
  1730. FUNCTION HPBOX
  1731. *╔════════════════════════════════════════════════════╗
  1732. *║ Program...: HPBOX                                  ║
  1733. *║ Author....: Phil Steele - President                ║
  1734. *║             Phillipps Computer Systems Inc.        ║
  1735. *║ Address...: 52 Hook Mountain Road,                 ║
  1736. *║             Montville NJ 07045                     ║
  1737. *║ Phone.....: (201) 575-8575                         ║
  1738. *║ Date......: 03/22/88                               ║
  1739. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1740. *║             All Rights Reserved.                   ║
  1741. *║ Notes.....: This function draws a horizontal line  ║
  1742. *║             on a laser printer.                    ║
  1743. *║ Parameters: StartD - The starting position of the  ║
  1744. *║                      box down from the top of the  ║
  1745. *║                      top of the page in inches.    ║
  1746. *║             StartL - The starting position of the  ║
  1747. *║                      box in from the left of the   ║
  1748. *║                      page in inches.               ║
  1749. *║             EndD   - The ending position of the    ║
  1750. *║                      box down from the top of the  ║
  1751. *║                      top of the page in inches.    ║
  1752. *║             EndR   - The ending position of the    ║
  1753. *║                      box in from the left of the   ║
  1754. *║                      page in inches.               ║
  1755. *║             LWidth - The width of the vertical     ║
  1756. *║                      line in 1/300's of an inch.   ║
  1757. *║             J      - The line current line number  ║
  1758. *║                      where printing is occurring.  ║
  1759. *╚════════════════════════════════════════════════════╝
  1760. PARAMETERS StartD, StartL, EndD, EndR, LWidth, J
  1761. PRIVATE    HStart, HLen, VStart, VLen, HStart2, VStart2, Esc
  1762. Esc     = CHR(27)
  1763. HStart  = StartD
  1764. HLen    = EndD - StartD
  1765. VStart  = StartL
  1766. VLen    = EndR - StartL
  1767. HStart2 = EndD
  1768. VStart2 = EndR
  1769. HLine(HStart,  VStart,  VLen, LWidth, J)
  1770. VLine(HStart,  VStart,  HLen, LWidth, J)
  1771. HLine(HStart2, VStart,  VLen, LWidth, J)
  1772. VLine(HStart,  VStart2, HLen, LWidth, J)
  1773. RETURN(.T.)
  1774. ************************************************************************
  1775. * SAMPLE2
  1776. * ...
  1777. CLEAR
  1778. X = 3
  1779. Y = 6
  1780. Z = DIV(Y,X)
  1781. ?Z
  1782. X = 0
  1783. Z = DIV(Y,X)
  1784. ?Z
  1785. X = 3
  1786. Y = 0
  1787. Z = DIV(Y,X)
  1788. ?Z
  1789. X = 0
  1790. Y = 0
  1791. Z = DIV(Y,X)
  1792. ?Z
  1793. * ...
  1794.  
  1795. FUNCTION DIV
  1796. *╔════════════════════════════════════════════════════╗
  1797. *║ Program...: DIV                                    ║
  1798. *║ Author....: Phil Steele - President                ║
  1799. *║             Phillipps Computer Systems Inc.        ║
  1800. *║ Address...: 52 Hook Mountain Road,                 ║
  1801. *║             Montville NJ 07045                     ║
  1802. *║ Phone.....: (201) 575-8575                         ║
  1803. *║ Date......: 03/22/88                               ║
  1804. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1805. *║             All Rights Reserved.                   ║
  1806. *║ Notes.....: This function checks for division by   ║
  1807. *║             zero.                                  ║
  1808. *║ Parameters: X - The numerator.                     ║
  1809. *║             Y - The denominator.                   ║
  1810. *╚════════════════════════════════════════════════════╝
  1811. PARAMETERS X, Y
  1812. PRIVATE    X, Y
  1813. IF X = 0 .OR. Y = 0
  1814.    RETURN(0)
  1815. ELSE
  1816.    RETURN (X/Y)
  1817. ENDIF
  1818. *END:DIV
  1819. ************************************************************************
  1820. * SAMPLE2
  1821. * ...
  1822. CLEAR
  1823. Str    = "THIS IS A LONG STRING"
  1824. NewStr = REMOVE(Str,11,5)
  1825. ? NewStr
  1826. * ...
  1827.  
  1828. FUNCTION REMOVE
  1829. *╔════════════════════════════════════════════════════╗
  1830. *║ Program...: REMOVE                                 ║
  1831. *║ Author....: Phil Steele - President                ║
  1832. *║             Phillipps Computer Systems Inc.        ║
  1833. *║ Address...: 52 Hook Mountain Road,                 ║
  1834. *║             Montville NJ 07045                     ║
  1835. *║ Phone.....: (201) 575-8575                         ║
  1836. *║ Date......: 03/22/88                               ║
  1837. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1838. *║             All Rights Reserved.                   ║
  1839. *║ Notes.....: This function removes a group of       ║
  1840. *║             characters from a string.              ║
  1841. *║ Parameters: Str   - The string to operate on.      ║
  1842. *║             Start - The starting position of the   ║
  1843. *║                     area to be removed.            ║
  1844. *║             RLen  - The length of the area to      ║
  1845. *║                     remove.                        ║
  1846. *╚════════════════════════════════════════════════════╝
  1847. PARAMETERS Str, Start, RLen
  1848. PRIVATE    Str, Start, RLen, NewStr
  1849. NewStr = SUBSTR(Str,1,Start-1) + SUBSTR(Str,Start+RLen)
  1850. RETURN (NewStr)
  1851. ************************************************************************
  1852. * SAMPLE2
  1853. * ...
  1854. CLEAR
  1855. Str1   = "THIS IS A STRING"
  1856. Str2   = "LONGER "
  1857. NewStr = STUFF(Str1,11,7,Str2)
  1858. ? NewStr
  1859. * ...
  1860.  
  1861. FUNCTION STUFF
  1862. *╔════════════════════════════════════════════════════╗
  1863. *║ Program...: STUFF                                  ║
  1864. *║ Author....: Phil Steele - President                ║
  1865. *║             Phillipps Computer Systems Inc.        ║
  1866. *║ Address...: 52 Hook Mountain Road,                 ║
  1867. *║             Montville NJ 07045                     ║
  1868. *║ Phone.....: (201) 575-8575                         ║
  1869. *║ Date......: 03/22/88                               ║
  1870. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1871. *║             All Rights Reserved.                   ║
  1872. *║ Notes.....: This function inserts characters into  ║
  1873. *║             a string.                              ║
  1874. *║ Parameters: Str   - The primary string to operate  ║
  1875. *║                       on.                          ║
  1876. *║                     new string to be inserted      ║
  1877. *║             RLen  - The length of the area to      ║
  1878. *║                     added to the primary string.   ║
  1879. *║             Rep   - The secondary string  -  the   ║
  1880. *║                     string to be inserted.         ║
  1881. *╚════════════════════════════════════════════════════╝
  1882. PARAMETERS Str, Start, RLen, Rep
  1883. RETURN SUBSTR(Str,1,Start-1)+Rep+SUBSTR(Str,Start+RLen)
  1884. ************************************************************************
  1885. * SAMPLE2
  1886. * ...
  1887. CLEAR
  1888. A = "phil"
  1889. B = "PHIL"
  1890. X = PROPER(A)
  1891. ? X
  1892. X = PROPER(B)
  1893. ? X
  1894. * ...
  1895.  
  1896. FUNCTION PROPER
  1897. *╔════════════════════════════════════════════════════╗
  1898. *║ Program...: PROPER                                 ║
  1899. *║ Author....: Phil Steele - President                ║
  1900. *║             Phillipps Computer Systems Inc.        ║
  1901. *║ Address...: 52 Hook Mountain Road,                 ║
  1902. *║             Montville NJ 07045                     ║
  1903. *║ Phone.....: (201) 575-8575                         ║
  1904. *║ Date......: 03/22/88                               ║
  1905. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1906. *║             All Rights Reserved.                   ║
  1907. *║ Notes.....: This function converts a string to     ║
  1908. *║             lower case and then converts the first ║
  1909. *║             character of the string to upper case. ║
  1910. *║ Parameters: X - The words to convert into "proper" ║
  1911. *║                 format.                            ║
  1912. *╚════════════════════════════════════════════════════╝
  1913. PARAMETERS X
  1914. X = UPPER(SUBSTR(X,1,1)) + LOWER(SUBSTR(X,2))
  1915. RETURN(X)
  1916. ************************************************************************
  1917. * SAMPLE2
  1918. * ...
  1919. CLEAR
  1920. A = "Phil"
  1921. B = "PHIL"
  1922. C = "PHILL"
  1923. D = "Bill"
  1924. X = COMPARE(A,B)
  1925. ? X
  1926. X = COMPARE(A,C)
  1927. ? X
  1928. X = COMPARE(A,D)
  1929. ? X
  1930. * ...
  1931.  
  1932. FUNCTION COMPARE
  1933. *╔════════════════════════════════════════════════════╗
  1934. *║ Program...: COMPARE                                ║
  1935. *║ Author....: Phil Steele - President                ║
  1936. *║             Phillipps Computer Systems Inc.        ║
  1937. *║ Address...: 52 Hook Mountain Road,                 ║
  1938. *║             Montville NJ 07045                     ║
  1939. *║ Phone.....: (201) 575-8575                         ║
  1940. *║ Date......: 03/22/88                               ║
  1941. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1942. *║             All Rights Reserved.                   ║
  1943. *║ Notes.....: This function draws a horizontal line  ║
  1944. *║             on a laser printer.                    ║
  1945. *║ Parameters: X - The first variable to compare.     ║
  1946. *║             Y - The second variable to compare.    ║
  1947. *╚════════════════════════════════════════════════════╝
  1948. PARAMETERS X, Y
  1949. PRIVATE    X, Y
  1950. IF UPPER(X) == UPPER(Y)
  1951.    RETURN(.T.)
  1952. ELSE
  1953.    RETURN(.F.)
  1954. ENDIF
  1955. ************************************************************************
  1956. * SAMPLE2
  1957. * ...
  1958. SET COLOR TO W+/B,W/N,B
  1959. CLEAR
  1960. Test = .F.
  1961. IF .NOT. Test
  1962.    ERR(1)
  1963.    @ 12,1 SAY ""
  1964. ENDIF
  1965. * ...
  1966.  
  1967. FUNCTION ERR
  1968. *╔════════════════════════════════════════════════════╗
  1969. *║ Program...: ERR                                    ║
  1970. *║ Author....: Phil Steele - President                ║
  1971. *║             Phillipps Computer Systems Inc.        ║
  1972. *║ Address...: 52 Hook Mountain Road,                 ║
  1973. *║             Montville NJ 07045                     ║
  1974. *║ Phone.....: (201) 575-8575                         ║
  1975. *║ Date......: 03/22/88                               ║
  1976. *║ Notice....: Copyright 1988  Philip Steele,         ║
  1977. *║             All Rights Reserved.                   ║
  1978. *║ Notes.....: This function displays an error on line║
  1979. *║             24 in white on red.                    ║
  1980. *║ Parameters: N - The number of the error to display.║
  1981. *╚════════════════════════════════════════════════════╝
  1982. PARAMETERS N
  1983. PRIVATE    N, Key, OldColor
  1984. OldColor = SETCOLOR()
  1985. Key       = 0
  1986. SAVESCREEN(24,0,24,79)
  1987. SET COLOR TO W+/R
  1988. @ 24,0 CLEAR TO 24,79
  1989. SET CURSOR OFF
  1990. DO CASE
  1991.    CASE N = 1
  1992.       @ 24,12 SAY CENT("Error Message one")
  1993.    CASE N = 2
  1994.       @ 24,12 SAY CENT("Error Message two")
  1995.    CASE N = 3
  1996.       @ 24,12 SAY CENT("Error Message three")
  1997.    CASE N = 4
  1998.       @ 24,12 SAY CENT("Error Message four")
  1999.    CASE N = 5
  2000.       @ 24,12 SAY CENT("Error Message five")
  2001. ENDCASE
  2002. Key = INKEY(5)
  2003. SET COLOR TO (OldColor)
  2004. RESTSCREEN(24,0,24,79)
  2005. SET CURSOR ON
  2006. CLEAR TYPEAHEAD
  2007. RETURN(.T.)
  2008. ************************************************************************
  2009. * SAMPLE2
  2010. * ...
  2011. CLEAR
  2012. N = 5
  2013. Z = FACT(N)
  2014. ? Z
  2015. * ...
  2016.  
  2017. FUNCTION FACT
  2018. *╔════════════════════════════════════════════════════╗
  2019. *║ Program...: FACT                                   ║
  2020. *║ Author....: Phil Steele - President                ║
  2021. *║             Phillipps Computer Systems Inc.        ║
  2022. *║ Address...: 52 Hook Mountain Road,                 ║
  2023. *║             Montville NJ 07045                     ║
  2024. *║ Phone.....: (201) 575-8575                         ║
  2025. *║ Date......: 03/22/88                               ║
  2026. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2027. *║             All Rights Reserved.                   ║
  2028. *║ Notes.....: This function computes the factorial   ║
  2029. *║             of a number.                           ║
  2030. *║ Parameters: N - The number you need the factorial  ║
  2031. *║                 of.                                ║
  2032. *╚════════════════════════════════════════════════════╝
  2033. PARAMETERS N
  2034. PRIVATE    N, J, K
  2035. K = 1
  2036. FOR J = 2 TO N
  2037.    K = K * J
  2038. NEXT
  2039. RETURN (K)
  2040. ************************************************************************
  2041. * SAMPLE2
  2042. * ...
  2043. CLEAR
  2044. N = 5
  2045. Z = 4
  2046. ? N, Z
  2047. DO SWAP WITH N, Z
  2048. ? N, Z
  2049. * ...
  2050.  
  2051. PROCEDURE SWAP
  2052. *╔════════════════════════════════════════════════════╗
  2053. *║ Program...: SWAP                                   ║
  2054. *║ Author....: Phil Steele - President                ║
  2055. *║             Phillipps Computer Systems Inc.        ║
  2056. *║ Address...: 52 Hook Mountain Road,                 ║
  2057. *║             Montville NJ 07045                     ║
  2058. *║ Phone.....: (201) 575-8575                         ║
  2059. *║ Date......: 03/22/88                               ║
  2060. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2061. *║             All Rights Reserved.                   ║
  2062. *║ Notes.....: This function swaps the values of two  ║
  2063. *║             variables.                             ║
  2064. *║ Parameters: A - A variable to be swapped.          ║
  2065. *║             B - Another variable to be swapped.    ║
  2066. *╚════════════════════════════════════════════════════╝
  2067. PARAMETERS A, B
  2068. PRIVATE    C
  2069. C = A
  2070. A = B
  2071. B = C
  2072. RETURN
  2073. ************************************************************************
  2074. * SAMPLE2
  2075. * ...
  2076. CLEAR
  2077. Choice = 0
  2078. @ 10,30 CLEAR TO 20,50
  2079. @ 10,30       TO 20,50 DOUBLE
  2080. @ 13,31       TO 13,49
  2081. @ 11,35 SAY "MASTER MENU"
  2082. @ 13,30 SAY "╟"  && CHR(199)
  2083. @ 13,50 SAY "╢"  && CHR(182)
  2084. SET MESSAGE TO 12
  2085. @ 14,31 PROMPT "1. Choice A ......." MESSAGE FIX("Message a",30)
  2086. @ 15,31 PROMPT "2. Choice B ......." MESSAGE FIX("Message bb",30)
  2087. @ 16,31 PROMPT "3. Choice C ......." MESSAGE FIX("Message ccc",30)
  2088. @ 17,31 PROMPT "4. Choice D ......." MESSAGE FIX("Message dddd",30)
  2089. @ 18,31 PROMPT "5. Choice E ......." MESSAGE FIX("Message eeeee",30)
  2090. @ 19,31 PROMPT "6. Choice F ......." MESSAGE FIX("Message ffffff",30)
  2091. MENU TO Choice
  2092. * ...
  2093.  
  2094. FUNCTION FIX
  2095. *╔════════════════════════════════════════════════════╗
  2096. *║ Program...: FIX                                    ║
  2097. *║ Author....: Phil Steele - President                ║
  2098. *║             Phillipps Computer Systems Inc.        ║
  2099. *║ Address...: 52 Hook Mountain Road,                 ║
  2100. *║             Montville NJ 07045                     ║
  2101. *║ Phone.....: (201) 575-8575                         ║
  2102. *║ Date......: 03/22/88                               ║
  2103. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2104. *║             All Rights Reserved.                   ║
  2105. *║ Notes.....: This function places the MENU message  ║
  2106. *║             at the proper place on the screen      ║
  2107. *║ Parameters: A - A variable to be swapped.          ║
  2108. *║             B - Another variable to be swapped.    ║
  2109. *╚════════════════════════════════════════════════════╝
  2110. PARAMETER Mess, Start
  2111. RETURN(SPACE(Start) + "║" + Mess )
  2112. ************************************************************************
  2113. * SAMPLE2
  2114. * ...
  2115. CLEAR
  2116. SET DECIMALS TO 12
  2117. X = PI()
  2118. ? X
  2119. * ...
  2120.  
  2121. FUNCTION PI
  2122. *╔════════════════════════════════════════════════════╗
  2123. *║ Program...: PI                                     ║
  2124. *║ Author....: Phil Steele - President                ║
  2125. *║             Phillipps Computer Systems Inc.        ║
  2126. *║ Address...: 52 Hook Mountain Road,                 ║
  2127. *║             Montville NJ 07045                     ║
  2128. *║ Phone.....: (201) 575-8575                         ║
  2129. *║ Date......: 03/22/88                               ║
  2130. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2131. *║             All Rights Reserved.                   ║
  2132. *║ Notes.....: This function returns the value of PI  ║
  2133. *║             to 11 decimal places.                  ║
  2134. *║ Parameters: No parameters are used.                ║
  2135. *╚════════════════════════════════════════════════════╝
  2136. RETURN(3.14159265359)
  2137. ************************************************************************
  2138. * SAMPLE2
  2139. * ...
  2140. CLEAR
  2141. X = 30
  2142. Y = RAD(X)
  2143. ?Y
  2144. * ...
  2145.  
  2146. FUNCTION RAD
  2147. *╔════════════════════════════════════════════════════╗
  2148. *║ Program...: RAD                                    ║
  2149. *║ Author....: Phil Steele - President                ║
  2150. *║             Phillipps Computer Systems Inc.        ║
  2151. *║ Address...: 52 Hook Mountain Road,                 ║
  2152. *║             Montville NJ 07045                     ║
  2153. *║ Phone.....: (201) 575-8575                         ║
  2154. *║ Date......: 03/22/88                               ║
  2155. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2156. *║             All Rights Reserved.                   ║
  2157. *║ Notes.....: This convert from degrees to radians.  ║
  2158. *║ Parameters: X - The value in degrees to be         ║
  2159. *║                 converted to radians.              ║
  2160. *╚════════════════════════════════════════════════════╝
  2161. PARAMETERS X
  2162. RETURN(3.14159265359 * X / 180)
  2163. ************************************************************************
  2164. * SAMPLE2
  2165. * ...
  2166. CLEAR
  2167. X = 1
  2168. Y = DEG(X)
  2169. ?Y
  2170. * ...
  2171.  
  2172. FUNCTION DEG
  2173. *╔════════════════════════════════════════════════════╗
  2174. *║ Program...: DEG                                    ║
  2175. *║ Author....: Phil Steele - President                ║
  2176. *║             Phillipps Computer Systems Inc.        ║
  2177. *║ Address...: 52 Hook Mountain Road,                 ║
  2178. *║             Montville NJ 07045                     ║
  2179. *║ Phone.....: (201) 575-8575                         ║
  2180. *║ Date......: 03/22/88                               ║
  2181. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2182. *║             All Rights Reserved.                   ║
  2183. *║ Notes.....: This function converts radians to      ║
  2184. *║             degrees.                               ║
  2185. *║ Parameters: X - The value in radians to be         ║
  2186. *║                 converted to degrees.              ║
  2187. *╚════════════════════════════════════════════════════╝
  2188. PRIVATE    X
  2189. PARAMETERS X
  2190. RETURN(180 * X / 3.14159265359)
  2191. ************************************************************************
  2192. * SAMPLE2
  2193. * ...
  2194. CLEAR
  2195. SET DECIMAL TO 15
  2196. X=90
  2197. ?Sine(X)
  2198. * ...
  2199.  
  2200. FUNCTION SINE
  2201. *╔════════════════════════════════════════════════════╗
  2202. *║ Program...: SINE                                   ║
  2203. *║ Author....: Phil Steele - President                ║
  2204. *║             Phillipps Computer Systems Inc.        ║
  2205. *║ Address...: 52 Hook Mountain Road,                 ║
  2206. *║             Montville NJ 07045                     ║
  2207. *║ Phone.....: (201) 575-8575                         ║
  2208. *║ Date......: 03/22/88                               ║
  2209. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2210. *║             All Rights Reserved.                   ║
  2211. *║ Notes.....: This function computes the Sine of a   ║
  2212. *║             value given in degrees.                ║
  2213. *║ Parameters: X - The value in degrees that we want  ║
  2214. *║                 the Sine of.                       ║
  2215. *╚════════════════════════════════════════════════════╝
  2216. PARAMETERS X
  2217. PRIVATE X, J, Y
  2218. X    = RAD(X)
  2219. Y    = X
  2220. Sign = 1
  2221. FOR J = 3 TO 17 STEP 2
  2222.    Sign = IIF(Sign<0, 1, -1)
  2223.    X    = X + (Sign * Y^J)/(FACT(J))
  2224. NEXT
  2225. RETURN(X)
  2226. ************************************************************************
  2227. * SAMPLE2
  2228. * ...
  2229. CLEAR
  2230. SET DECIMAL TO 15
  2231. X=60
  2232. ?Cos(X)
  2233. * ...
  2234.  
  2235. FUNCTION COS
  2236. *╔════════════════════════════════════════════════════╗
  2237. *║ Program...: COS                                    ║
  2238. *║ Author....: Phil Steele - President                ║
  2239. *║             Phillipps Computer Systems Inc.        ║
  2240. *║ Address...: 52 Hook Mountain Road,                 ║
  2241. *║             Montville NJ 07045                     ║
  2242. *║ Phone.....: (201) 575-8575                         ║
  2243. *║ Date......: 03/22/88                               ║
  2244. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2245. *║             All Rights Reserved.                   ║
  2246. *║ Notes.....: This function computes the Cosine of a ║
  2247. *║             value given in degrees.                ║
  2248. *║ Parameters: X - The value in degrees that we want  ║
  2249. *║                 the Cosine of.                     ║
  2250. *╚════════════════════════════════════════════════════╝
  2251. PARAMETERS X
  2252. PRIVATE X, J, Y
  2253. X = RAD(X)
  2254. Y = X
  2255. X = 1
  2256. Sign = 1
  2257. FOR J = 2 TO 16 STEP 2
  2258.    Sign = IIF(Sign<0, 1, -1)
  2259.    X    = X + (Sign * Y^J)/(FACT(J))
  2260. NEXT
  2261. RETURN(X)
  2262. ************************************************************************
  2263. * SAMPLE2
  2264. * ...
  2265. CLEAR
  2266. SET DECIMAL TO 15
  2267. X=45
  2268. ?Tan(X)
  2269. * ...
  2270.  
  2271. FUNCTION TAN
  2272. *╔════════════════════════════════════════════════════╗
  2273. *║ Program...: TAN                                    ║
  2274. *║ Author....: Phil Steele - President                ║
  2275. *║             Phillipps Computer Systems Inc.        ║
  2276. *║ Address...: 52 Hook Mountain Road,                 ║
  2277. *║             Montville NJ 07045                     ║
  2278. *║ Phone.....: (201) 575-8575                         ║
  2279. *║ Date......: 03/22/88                               ║
  2280. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2281. *║             All Rights Reserved.                   ║
  2282. *║ Notes.....: This function computes the Tangent of  ║
  2283. *║             a value given in degrees.              ║
  2284. *║ Parameters: X - The value in degrees that we want  ║
  2285. *║                 the Tangent of.                    ║
  2286. *╚════════════════════════════════════════════════════╝
  2287. PRIVATE X, J, Y
  2288. J = SINE(X)
  2289. Y = COS(X)
  2290. RETURN(J/Y)
  2291. ************************************************************************
  2292. * SAMPLE2
  2293. * ...
  2294. ARow   = 2
  2295. ACol   = 2
  2296. Height = 3
  2297. Width  = 3
  2298. Esc    = CHR(27)
  2299. DO WHILE ARow <> 0
  2300.    CLEAR
  2301.    @ 1,0 GET ARow    PICTURE "99"
  2302.    @ 2,0 GET ACol    PICTURE "99"
  2303.    @ 3,0 GET Height  PICTURE "99"
  2304.    @ 4,0 GET Width   PICTURE "99"
  2305.    READ
  2306.    IF ARow = 0
  2307.       EXIT
  2308.    ENDIF
  2309.    SET DEVICE TO PRINT
  2310.    @ 0,0 SAY Esc + "*p0x0Y"
  2311.    CIRCLE(ARow, ACol, Height, Width)
  2312. EJECT
  2313. ENDDO
  2314. SET DEVICE TO SCREEN
  2315.  
  2316. FUNCTION CIRCLE
  2317. *╔════════════════════════════════════════════════════╗
  2318. *║ Program...: CIRCLE                                 ║
  2319. *║ Author....: Phil Steele - President                ║
  2320. *║             Phillipps Computer Systems Inc.        ║
  2321. *║ Address...: 52 Hook Mountain Road,                 ║
  2322. *║             Montville NJ 07045                     ║
  2323. *║ Phone.....: (201) 575-8575                         ║
  2324. *║ Date......: 03/22/88                               ║
  2325. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2326. *║             All Rights Reserved.                   ║
  2327. *║ Notes.....: This function draws a circle or an     ║
  2328. *║             ellipse on a laser printer using HP    ║
  2329. *║             laser jet codes.                       ║
  2330. *║ Parameters: ARow -   The row in inches for the     ║
  2331. *║                      center of the circle.         ║
  2332. *║             ACol -   The column in inches for the  ║
  2333. *║                      center of the circle.         ║
  2334. *║             Height - The height of the circle in   ║
  2335. *║                      inches.                       ║
  2336. *║             Width  - The width of the circle in    ║
  2337. *║                      inches.                       ║
  2338. *║ Addition Notes: If the height of the circle does   ║
  2339. *║                 not equal the width you get an     ║
  2340. *║                 ellipse.                           ║
  2341. *║                 This UDF is NOT fast.              ║
  2342. *╚════════════════════════════════════════════════════╝
  2343. PARAMETERS ARow, ACol, Height, Width
  2344. PRIVATE J, Y, Z, K, L, M, R, Point
  2345. Esc = CHR(27)
  2346. FOR R = 5 TO -5 STEP -.005
  2347.    J = 30 * R
  2348.    Y = ((1-J*J)^.5)
  2349.    Z = -Y
  2350.    IF Y <> 0
  2351.       K = J * Height * 300 + (ARow * 300)
  2352.       L = Y * Width  * 300 + (ACol * 300)
  2353.       M = Z * Width  * 300 + (ACol * 300)
  2354.       Point = Esc + "*p" + STR(K,5,0) + "y" +;
  2355.               STR(L,5,0) + "X" + Esc + "*c2a2b0P"
  2356.       @ J,0 SAY "&Point"
  2357.       Point = Esc + "*p" + STR(K,5,0) + "y" +;
  2358.               STR(M,5,0) + "X" + Esc + "*c2a2b0P"
  2359.       @ J,0 SAY "&Point"
  2360.    ENDIF
  2361. NEXT
  2362. RETURN(.T.)
  2363. ************************************************************************
  2364. * SAMPLE2
  2365. * ...
  2366. CLEAR
  2367. USE TEST
  2368. * File contains: ... PAUL, SAM, ZELDA ...
  2369. INDEX ON NAME TO FName
  2370. Key = "PHIL"
  2371. SEEK Key
  2372. ? RECNO()
  2373. ? NAME
  2374. SOFTSEEK(Key)
  2375. ? RECNO()
  2376. ? NAME
  2377. * ...
  2378.  
  2379. FUNCTION SOFTSEEK
  2380. *╔════════════════════════════════════════════════════╗
  2381. *║ Program...: SOFTSEEK                               ║
  2382. *║ Author....: Phil Steele - President                ║
  2383. *║             Phillipps Computer Systems Inc.        ║
  2384. *║ Address...: 52 Hook Mountain Road,                 ║
  2385. *║             Montville NJ 07045                     ║
  2386. *║ Phone.....: (201) 575-8575                         ║
  2387. *║ Date......: 03/22/88                               ║
  2388. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2389. *║             All Rights Reserved.                   ║
  2390. *║ Notes.....: This function returns a record equal to║
  2391. *║             or just after the seek key.            ║
  2392. *║ Parameters: NewSeek - The value to SEEK on.        ║
  2393. *╚════════════════════════════════════════════════════╝
  2394. PARAMETERS NewSeek
  2395. PRIVATE    NewSeek, FirstChar
  2396. FirstChar = SUBSTR(NewSeek,1,1)
  2397. SEEK NewSeek
  2398. DO WHILE EOF()
  2399.    IF LEN(NewSeek) > 1
  2400.       NewSeek = SUBSTR(NewSeek,1,LEN(NewSeek)-1)
  2401.    ELSE
  2402.       NewSeek   = CHR(ASC(FirstChar) + 1)
  2403.       FirstChar = NewSeek
  2404.       IF ASC(NewSeek) > 90             && ASC 90 = Z
  2405.          GOTO BOTTOM
  2406.          EXIT
  2407.       ENDIF
  2408.    ENDIF
  2409.    SEEK NewSeek
  2410. ENDDO
  2411. RETURN(.T.)
  2412. ************************************************************************
  2413. * SAMPLE2
  2414. * ...
  2415. SET COLOR TO W+/B,N/W
  2416. CLEAR
  2417. X = "THIS IS A TEST"
  2418. @ 2,2 CLEAR TO 22,70
  2419. @ 2,2       TO 22,70 DOUBLE
  2420. @ 12,12 SAY X
  2421. WAIT
  2422. BoxColor(2,2,22,70,"R/W","D")
  2423. @ 14,12 SAY X
  2424. WAIT
  2425. * ...
  2426.  
  2427. FUNCTION BOXCOLOR
  2428. *╔════════════════════════════════════════════════════╗
  2429. *║ Program...: BOXCOLOR                               ║
  2430. *║ Author....: Phil Steele - President                ║
  2431. *║             Phillipps Computer Systems Inc.        ║
  2432. *║ Address...: 52 Hook Mountain Road,                 ║
  2433. *║             Montville NJ 07045                     ║
  2434. *║ Phone.....: (201) 575-8575                         ║
  2435. *║ Date......: 03/22/88                               ║
  2436. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2437. *║             All Rights Reserved.                   ║
  2438. *║ Notes.....: This function changes the color of a   ║
  2439. *║             single or double line box around a     ║
  2440. *║             message without changing the color of  ║
  2441. *║             the message.                           ║
  2442. *║ Parameters: T  - The top row of the box.           ║
  2443. *║             L  - The top column of the box.        ║
  2444. *║             B  - The bottom row of the box.        ║
  2445. *║             R  - The bottom column of the box.     ║
  2446. *║             C  - The new color for the box.        ║
  2447. *║             SD - "S" = a single box and            ║
  2448. *║                  "D" = a double box.               ║
  2449. *╚════════════════════════════════════════════════════╝
  2450. PARAMETERS T,L,B,R,C,SD
  2451. PRIVATE    T,L,B,R,C,SD,OldC
  2452. OldC = SETCOLOR()
  2453. SET COLOR TO &C
  2454. IF UPPER(SD) = "D"
  2455.    @ T,L TO B,R DOUBLE
  2456. ELSE
  2457.    @ T,L TO B,R
  2458. ENDIF
  2459. SET COLOR TO &OldC
  2460. RETURN(.T.)
  2461. ************************************************************************
  2462. * SAMPLE2
  2463. * ...
  2464. SET COLOR TO W+/B,N/W
  2465. CLEAR
  2466. X = "THIS IS A TEST"
  2467. @ 2,2 CLEAR TO 22,70
  2468. @ 2,2       TO 22,70 DOUBLE
  2469. @ 16,12 SAY X
  2470. WAIT
  2471.  
  2472. MessCol(16,12,X,"G/R")
  2473. @ 16,12 SAY X
  2474. WAIT
  2475. * ...
  2476.  
  2477. FUNCTION MESSCOL
  2478. *╔════════════════════════════════════════════════════╗
  2479. *║ Program...: MESSCOL                                ║
  2480. *║ Author....: Phil Steele - President                ║
  2481. *║             Phillipps Computer Systems Inc.        ║
  2482. *║ Address...: 52 Hook Mountain Road,                 ║
  2483. *║             Montville NJ 07045                     ║
  2484. *║ Phone.....: (201) 575-8575                         ║
  2485. *║ Date......: 03/22/88                               ║
  2486. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2487. *║             All Rights Reserved.                   ║
  2488. *║ Notes.....: This function changes the color of a   ║
  2489. *║             message without affecting any other    ║
  2490. *║             colors.                                ║
  2491. *║ Parameters: R  - The row the message starts on.    ║
  2492. *║             C  - The column the message starts on. ║
  2493. *║             M  - The message.                      ║
  2494. *║             NC - The new color for the message.    ║
  2495. *╚════════════════════════════════════════════════════╝
  2496. PARAMETERS R,C,M,NC
  2497. PRIVATE    R,C,M,NC,OldC
  2498. OldC = SETCOLOR()
  2499. SET COLOR TO &NC
  2500. @ R,C SAY M
  2501. SET COLOR TO &OldC
  2502. RETURN(.T.)
  2503. ************************************************************************
  2504. * SAMPLE2
  2505. * ...
  2506. CLEAR
  2507. X = 123456.7
  2508. Y = Dollars(X)
  2509. ? Y
  2510. X = -23456.7
  2511. Y = Dollars(X)
  2512. ? Y
  2513. * ...
  2514.  
  2515. FUNCTION DOLLARS
  2516. *╔════════════════════════════════════════════════════╗
  2517. *║ Program...: DOLLARS                                ║
  2518. *║ Author....: Phil Steele - President                ║
  2519. *║             Phillipps Computer Systems Inc.        ║
  2520. *║ Address...: 52 Hook Mountain Road,                 ║
  2521. *║             Montville NJ 07045                     ║
  2522. *║ Phone.....: (201) 575-8575                         ║
  2523. *║ Date......: 03/22/88                               ║
  2524. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2525. *║             All Rights Reserved.                   ║
  2526. *║ Notes.....: This function displays a number as a   ║
  2527. *║             dollar amount.                         ║
  2528. *║ Parameters: X  - The number to display as a dollar ║
  2529. *║                  amount.                           ║
  2530. *╚════════════════════════════════════════════════════╝
  2531. PARAMETERS X
  2532. PRIVATE Z
  2533. Z = LTRIM(TRANSFORM(X, "999,999,999,999.99"))
  2534. Z = IIF(X>0, "$"+Z, "-$"+SUBSTR(Z,2))
  2535. RETURN (Z)
  2536. ************************************************************************
  2537. * SAMPLE2
  2538. * ...
  2539. CLEAR
  2540. X = TIME()
  2541. ? X
  2542. Y = NonMilt(X)
  2543. ? Y
  2544. * ...
  2545.  
  2546. FUNCTION NONMILT
  2547. *╔════════════════════════════════════════════════════╗
  2548. *║ Program...: NONMILT                                ║
  2549. *║ Author....: Phil Steele - President                ║
  2550. *║             Phillipps Computer Systems Inc.        ║
  2551. *║ Address...: 52 Hook Mountain Road,                 ║
  2552. *║             Montville NJ 07045                     ║
  2553. *║ Phone.....: (201) 575-8575                         ║
  2554. *║ Date......: 03/22/88                               ║
  2555. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2556. *║             All Rights Reserved.                   ║
  2557. *║ Notes.....: This function displays military time   ║
  2558. *║             as a normal time with AM and PM.       ║
  2559. *║             14:22:22 is displayed  as 2:22:22 PM   ║
  2560. *║ Parameters: X  - The military time to be displayed.║
  2561. *╚════════════════════════════════════════════════════╝
  2562. PARAMETERS X
  2563. PRIVATE    Y, Z
  2564. Y = VAL(LEFT(X,2))
  2565. Z = IIF(Y<12, X+" AM", STR(Y-12,2,0)+SUBSTR(X,3)+" PM")
  2566. RETURN(Z)
  2567. ************************************************************************
  2568. * SAMPLE2
  2569. * ...
  2570. CLEAR
  2571. X = "14:32:21"        && Time1
  2572. Y = "17:18:06"        && Time2
  2573. Z = ElapTime(X,Y)
  2574. ?Z
  2575. * ...
  2576.  
  2577. FUNCTION ELAPTIME
  2578. *╔════════════════════════════════════════════════════╗
  2579. *║ Program...: ELAPTIME                               ║
  2580. *║ Author....: Phil Steele - President                ║
  2581. *║             Phillipps Computer Systems Inc.        ║
  2582. *║ Address...: 52 Hook Mountain Road,                 ║
  2583. *║             Montville NJ 07045                     ║
  2584. *║ Phone.....: (201) 575-8575                         ║
  2585. *║ Date......: 03/22/88                               ║
  2586. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2587. *║             All Rights Reserved.                   ║
  2588. *║ Notes.....: This function computes the difference  ║
  2589. *║             between time one and time two.         ║
  2590. *║ Parameters: X  - Time one.                         ║
  2591. *║             Y  - Time two.                         ║
  2592. *╚════════════════════════════════════════════════════╝
  2593. PARAMETERS X, Y
  2594. PRIVATE  Time1, Time2, Z, Hrs, Min, Sec
  2595. Time1 = (VAL(SUBSTR(X,1,2)) * 3600) +;
  2596.         (VAL(SUBSTR(X,4,2)) * 60) + (VAL(SUBSTR(X,7)))
  2597. Time2 = (VAL(SUBSTR(Y,1,2)) * 3600) +;
  2598.         (VAL(SUBSTR(Y,4,2)) * 60) + (VAL(SUBSTR(Y,7)))
  2599. Z   =   ABS(Time1 - Time2)
  2600. Hrs =   INT(Z / 3600)
  2601. Min =   INT((Z - Hrs * 3600) / 60)
  2602. Sec =   Z - (Hrs * 3600) - (Min * 60)
  2603. RETURN (LTRIM(STR(Hrs,4,0) + ":" + STR(Min,2,0) + ":" + Str(Sec,2,0)))
  2604. ************************************************************************
  2605. * SAMPLE2
  2606. * ...
  2607. CLEAR
  2608. X = 14.87
  2609. A = NLen(X)
  2610. ? A
  2611. X = -1314.87
  2612. A = NLen(X)
  2613. ? A
  2614. * ...
  2615.  
  2616. FUNCTION NLEN
  2617. *╔════════════════════════════════════════════════════╗
  2618. *║ Program...: NLEN                                   ║
  2619. *║ Author....: Phil Steele - President                ║
  2620. *║             Phillipps Computer Systems Inc.        ║
  2621. *║ Address...: 52 Hook Mountain Road,                 ║
  2622. *║             Montville NJ 07045                     ║
  2623. *║ Phone.....: (201) 575-8575                         ║
  2624. *║ Date......: 03/22/88                               ║
  2625. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2626. *║             All Rights Reserved.                   ║
  2627. *║ Notes.....: This function returns the length of a  ║
  2628. *║             numeric field.                         ║
  2629. *║ Parameters: X  - The numeric field.                ║
  2630. *╚════════════════════════════════════════════════════╝
  2631. PARAMETERS X
  2632. RETURN (LEN(ALLTRIM(STR(X))))
  2633. ************************************************************************
  2634. * SAMPLE2
  2635. * ...
  2636. CLEAR
  2637. X = 0
  2638. Y = " "
  2639. Z = CTOD("  /  /  ")
  2640. @ 12,12 GET X PICTURE "9" VALID AnyThing(X)
  2641. @ 13,12 GET Y PICTURE "!" VALID AnyThing(Y)
  2642. @ 14,12 GET Z             VALID AnyThing(Z)
  2643. READ
  2644. * ...
  2645.  
  2646. FUNCTION ANYTHING
  2647. *╔════════════════════════════════════════════════════╗
  2648. *║ Program...: ANYTHING                               ║
  2649. *║ Author....: Phil Steele - President                ║
  2650. *║             Phillipps Computer Systems Inc.        ║
  2651. *║ Address...: 52 Hook Mountain Road,                 ║
  2652. *║             Montville NJ 07045                     ║
  2653. *║ Phone.....: (201) 575-8575                         ║
  2654. *║ Date......: 03/22/88                               ║
  2655. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2656. *║             All Rights Reserved.                   ║
  2657. *║ Notes.....: This function returns a .F. if a data  ║
  2658. *║             entry field contains blanks or a null. ║
  2659. *║ Parameters: X  - The variable to check for a blank ║
  2660. *║                  or a null.                        ║
  2661. *╚════════════════════════════════════════════════════╝
  2662. PARAMETERS X
  2663. IF EMPTY(X)
  2664.    RETURN(.F.)
  2665. ELSE
  2666.    RETURN(.T.)
  2667. ENDIF
  2668. ************************************************************************
  2669. FUNCTION METFOOT
  2670. *╔════════════════════════════════════════════════════╗
  2671. *║ Program...: METFOOT                                ║
  2672. *║ Author....: Phil Steele - President                ║
  2673. *║             Phillipps Computer Systems Inc.        ║
  2674. *║ Address...: 52 Hook Mountain Road,                 ║
  2675. *║             Montville NJ 07045                     ║
  2676. *║ Phone.....: (201) 575-8575                         ║
  2677. *║ Date......: 03/22/88                               ║
  2678. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2679. *║             All Rights Reserved.                   ║
  2680. *║ Notes.....: This function converts meters to feet  ║
  2681. *║             and feet to meters.                    ║
  2682. *║ Parameters: X  - The variable to be converted from ║
  2683. *║                  metric or American to the other.  ║
  2684. *║             MA - "M" = convert to metric;          ║
  2685. *║                  "A" = convert to American.        ║
  2686. *╚════════════════════════════════════════════════════╝
  2687. PARAMETERS X, MA
  2688. PRIVATE    FactorM, FactorA, Factor
  2689. Meter_Foot  = 3.280833333
  2690. Foot_Meter  = 0.3048006096
  2691. FactorM     = Meter_Foot
  2692. FactorA     = Foot_Meter
  2693. Factor      = IIF(UPPER(MA)="A", FactorM, FactorA)
  2694. RETURN (X * Factor)
  2695. ************************************************************************
  2696. * SAMPLE2
  2697. * ...
  2698. CLEAR
  2699. X = 1
  2700. NewValue = KmMile(X,"A")
  2701. ? X
  2702. ? NewValue
  2703. * ...
  2704.  
  2705. FUNCTION KMMILE
  2706. *╔════════════════════════════════════════════════════╗
  2707. *║ Program...: KMMILE                                 ║
  2708. *║ Author....: Phil Steele - President                ║
  2709. *║             Phillipps Computer Systems Inc.        ║
  2710. *║ Address...: 52 Hook Mountain Road,                 ║
  2711. *║             Montville NJ 07045                     ║
  2712. *║ Phone.....: (201) 575-8575                         ║
  2713. *║ Date......: 03/22/88                               ║
  2714. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2715. *║             All Rights Reserved.                   ║
  2716. *║ Notes.....: This function converts kilometers to   ║
  2717. *║             miles and miles to kilometers.         ║
  2718. *║ Parameters: X  - The variable to be converted from ║
  2719. *║                  metric or American to the other.  ║
  2720. *║             MA - "M" = convert to metric;          ║
  2721. *║                  "A" = convert to American.        ║
  2722. *╚════════════════════════════════════════════════════╝
  2723. PARAMETERS X, MA
  2724. PRIVATE    FactorM, FactorA, Factor
  2725. KMeter_Miles = 0.6213699495
  2726. Miles_KMeter = 1.609347219
  2727. FactorM      = KMeter_Miles
  2728. FactorA      = Miles_KMeter
  2729. Factor       = IIF(UPPER(MA)="A", FactorM, FactorA)
  2730. RETURN (X * Factor)
  2731. RETURN (X * Factor)
  2732. ************************************************************************
  2733. * SAMPLE2
  2734. * ...
  2735. CLEAR
  2736. X = 1
  2737. NewValue = KmMPH(X,"A")
  2738. ? X
  2739. ? NewValue
  2740. * ...
  2741.  
  2742. FUNCTION KMMPH
  2743. *╔════════════════════════════════════════════════════╗
  2744. *║ Program...: KMMPH                                  ║
  2745. *║ Author....: Phil Steele - President                ║
  2746. *║             Phillipps Computer Systems Inc.        ║
  2747. *║ Address...: 52 Hook Mountain Road,                 ║
  2748. *║             Montville NJ 07045                     ║
  2749. *║ Phone.....: (201) 575-8575                         ║
  2750. *║ Date......: 03/22/88                               ║
  2751. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2752. *║             All Rights Reserved.                   ║
  2753. *║ Notes.....: This function converts kilometers per  ║
  2754. *║             minute to miles per hour and miles per ║
  2755. *║             hour to kilometers per minute.         ║
  2756. *║ Parameters: X  - The variable to be converted from ║
  2757. *║                  metric or American to the other.  ║
  2758. *║             MA - "M" = convert to metric;          ║
  2759. *║                  "A" = convert to American.        ║
  2760. *╚════════════════════════════════════════════════════╝
  2761. PARAMETERS X, MA
  2762. PRIVATE    FactorM, FactorA, Factor
  2763. KMetMin_MPH = 37.2822
  2764. MPH_KMetMin = 0.026822
  2765. FactorM     = KMetMin_MPH
  2766. FactorA     = MPH_KMetMin
  2767. Factor      = IIF(UPPER(MA)="A", FactorM, FactorA)
  2768. RETURN (X * Factor)
  2769. ************************************************************************
  2770. * SAMPLE2
  2771. * ...
  2772. CLEAR
  2773. X = 1
  2774. NewValue = CentIn(X,"M")
  2775. ? X
  2776. ? NewValue
  2777. * ...
  2778.  
  2779. FUNCTION CENTIN
  2780. *╔════════════════════════════════════════════════════╗
  2781. *║ Program...: CENTIN                                 ║
  2782. *║ Author....: Phil Steele - President                ║
  2783. *║             Phillipps Computer Systems Inc.        ║
  2784. *║ Address...: 52 Hook Mountain Road,                 ║
  2785. *║             Montville NJ 07045                     ║
  2786. *║ Phone.....: (201) 575-8575                         ║
  2787. *║ Date......: 03/22/88                               ║
  2788. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2789. *║             All Rights Reserved.                   ║
  2790. *║ Notes.....: This function converts centimeters to  ║
  2791. *║             inches and inches to centimeters.      ║
  2792. *║ Parameters: X  - The variable to be converted from ║
  2793. *║                  metric or American to the other.  ║
  2794. *║             MA - "M" = convert to metric;          ║
  2795. *║                  "A" = convert to American.        ║
  2796. *╚════════════════════════════════════════════════════╝
  2797. PARAMETERS X, MA
  2798. PRIVATE    FactorM, FactorA, Factor
  2799. Cm_Inch = 0.3937
  2800. Inch_Cm = 2.54000508
  2801. FactorM = Cm_Inch
  2802. FactorA = Inch_Cm
  2803. Factor  = IIF(UPPER(MA)="A", FactorM, FactorA)
  2804. RETURN (X * Factor)
  2805. ************************************************************************
  2806. * SAMPLE2
  2807. * ...
  2808. CLEAR
  2809. X = 1
  2810. NewValue = KiloLbs(X,"M")
  2811. ? X
  2812. ? NewValue
  2813. * ...
  2814.  
  2815. FUNCTION KILOLBS
  2816. *╔════════════════════════════════════════════════════╗
  2817. *║ Program...: KILOLBS                                ║
  2818. *║ Author....: Phil Steele - President                ║
  2819. *║             Phillipps Computer Systems Inc.        ║
  2820. *║ Address...: 52 Hook Mountain Road,                 ║
  2821. *║             Montville NJ 07045                     ║
  2822. *║ Phone.....: (201) 575-8575                         ║
  2823. *║ Date......: 03/22/88                               ║
  2824. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2825. *║             All Rights Reserved.                   ║
  2826. *║ Notes.....: This function converts kilograms to    ║
  2827. *║             pounds and pounds to kilograms.        ║
  2828. *║ Parameters: X  - The variable to be converted from ║
  2829. *║                  metric or American to the other.  ║
  2830. *║             MA - "M" = convert to metric;          ║
  2831. *║                  "A" = convert to American.        ║
  2832. *╚════════════════════════════════════════════════════╝
  2833. PARAMETERS X, MA
  2834. PRIVATE    FactorM, FactorA, Factor
  2835. KGram_Lbs = 2.204622341
  2836. Lbs_KGram = 0.4535924277
  2837. FactorM   = KGram_Lbs
  2838. FactorA   = Lbs_KGram
  2839. Factor    = IIF(UPPER(MA)="A", FactorM, FactorA)
  2840. RETURN (X * Factor)
  2841. ************************************************************************
  2842. * SAMPLE2
  2843. * ...
  2844. CLEAR
  2845. X = 1
  2846. NewValue = GramOz(X,"M")
  2847. ? X
  2848. ? NewValue
  2849. * ...
  2850.  
  2851. FUNCTION GRAMOZ
  2852. *╔════════════════════════════════════════════════════╗
  2853. *║ Program...: GRAMOZ                                 ║
  2854. *║ Author....: Phil Steele - President                ║
  2855. *║             Phillipps Computer Systems Inc.        ║
  2856. *║ Address...: 52 Hook Mountain Road,                 ║
  2857. *║             Montville NJ 07045                     ║
  2858. *║ Phone.....: (201) 575-8575                         ║
  2859. *║ Date......: 03/22/88                               ║
  2860. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2861. *║             All Rights Reserved.                   ║
  2862. *║ Notes.....: This function converts grams to ounces ║
  2863. *║             and ounces to grams.                   ║
  2864. *║ Parameters: X  - The variable to be converted from ║
  2865. *║                  metric or American to the other.  ║
  2866. *║             MA - "M" = convert to metric;          ║
  2867. *║                  "A" = convert to American.        ║
  2868. *╚════════════════════════════════════════════════════╝
  2869. PARAMETERS X, MA
  2870. PRIVATE    FactorM, FactorA, Factor
  2871. Gram_Oz = 0.0352739
  2872. Oz_Gram = 28.349527
  2873. FactorM = Gram_Oz
  2874. FactorA = Oz_Gram
  2875. Factor  = IIF(UPPER(MA)="A", FactorM, FactorA)
  2876. RETURN (X * Factor)
  2877. ************************************************************************
  2878. * SAMPLE2
  2879. * ...
  2880. CLEAR
  2881. X = 1
  2882. NewValue = LiterGal(X,"M")
  2883. ? X
  2884. ? NewValue
  2885. * ...
  2886.  
  2887. FUNCTION LITERGAL
  2888. *╔════════════════════════════════════════════════════╗
  2889. *║ Program...: LITERGAL                               ║
  2890. *║ Author....: Phil Steele - President                ║
  2891. *║             Phillipps Computer Systems Inc.        ║
  2892. *║ Address...: 52 Hook Mountain Road,                 ║
  2893. *║             Montville NJ 07045                     ║
  2894. *║ Phone.....: (201) 575-8575                         ║
  2895. *║ Date......: 03/22/88                               ║
  2896. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2897. *║             All Rights Reserved.                   ║
  2898. *║ Notes.....: This function converts liters to       ║
  2899. *║             gallons and gallons to liters.         ║
  2900. *║ Parameters: X  - The variable to be converted from ║
  2901. *║                  metric or American to the other.  ║
  2902. *║             MA - "M" = convert to metric;          ║
  2903. *║                  "A" = convert to American.        ║
  2904. *╚════════════════════════════════════════════════════╝
  2905. PARAMETERS X, MA
  2906. PRIVATE    FactorM, FactorA, Factor
  2907. Liter_Gal = 0.219976
  2908. Gal_Liter = 3.78533
  2909. FactorM   = Liter_Gal
  2910. FactorA   = Gal_Liter
  2911. Factor    = IIF(UPPER(MA)="A", FactorM, FactorA)
  2912. RETURN (X * Factor)
  2913. ************************************************************************
  2914. * SAMPLE2
  2915. * ...
  2916. CLEAR
  2917. X = 1
  2918. NewValue = CentF(X,"M")
  2919. ? X
  2920. ? NewValue
  2921. * ...
  2922.  
  2923. FUNCTION CENTF
  2924. *╔════════════════════════════════════════════════════╗
  2925. *║ Program...: CENTF                                  ║
  2926. *║ Author....: Phil Steele - President                ║
  2927. *║             Phillipps Computer Systems Inc.        ║
  2928. *║ Address...: 52 Hook Mountain Road,                 ║
  2929. *║             Montville NJ 07045                     ║
  2930. *║ Phone.....: (201) 575-8575                         ║
  2931. *║ Date......: 03/22/88                               ║
  2932. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2933. *║             All Rights Reserved.                   ║
  2934. *║ Notes.....: This function converts centigrade to   ║
  2935. *║             Fahrenheit and Fahrenheit to           ║
  2936. *║             centigrade.                            ║
  2937. *║ Parameters: X  - The variable to be converted from ║
  2938. *║                  metric or American to the other.  ║
  2939. *║             MA - "M" = convert to metric;          ║
  2940. *║                  "A" = convert to American.        ║
  2941. *╚════════════════════════════════════════════════════╝
  2942. PARAMETERS X, MA
  2943. PRIVATE    FactorM, FactorA, Factor
  2944. Centigrade = (F - 32) * 5 / 9
  2945. Fahrenheit = (C * 9 /5) + 32
  2946. FactorM    = Centigrade
  2947. FactorA    = Fahrenheit
  2948. Factor     = IIF(UPPER(MA)="A", FactorM, FactorA)
  2949. RETURN (X * Factor)
  2950. ************************************************************************
  2951. * SAMPLE2
  2952. * ...
  2953. CLEAR
  2954. X = 1
  2955. NewValue = CalBTU(X,"A")
  2956. ? X
  2957. ? NewValue
  2958. * ...
  2959.  
  2960. FUNCTION CALBTU
  2961. *╔════════════════════════════════════════════════════╗
  2962. *║ Program...: CALBTU                                 ║
  2963. *║ Author....: Phil Steele - President                ║
  2964. *║             Phillipps Computer Systems Inc.        ║
  2965. *║ Address...: 52 Hook Mountain Road,                 ║
  2966. *║             Montville NJ 07045                     ║
  2967. *║ Phone.....: (201) 575-8575                         ║
  2968. *║ Date......: 03/22/88                               ║
  2969. *║ Notice....: Copyright 1988  Philip Steele,         ║
  2970. *║             All Rights Reserved.                   ║
  2971. *║ Notes.....: This function converts kilocalories to ║
  2972. *║             BTUs and BTUs to kilocalories.         ║
  2973. *║             centigrade.                            ║
  2974. *║ Parameters: X  - The variable to be converted from ║
  2975. *║                  metric or American to the other.  ║
  2976. *║             MA - "M" = convert to metric;          ║
  2977. *║                  "A" = convert to American.        ║
  2978. *╚════════════════════════════════════════════════════╝
  2979. PARAMETERS X, MA
  2980. PRIVATE    FactorM, FactorA, Factor
  2981. CalK_BTU = 3.9685
  2982. BTU_CalK = 0.025198
  2983. FactorM  = CalK_BTU
  2984. FactorA  = BTU_CalK
  2985. Factor   = IIF(UPPER(MA)="A", FactorM, FactorA)
  2986. RETURN (X * Factor)
  2987.  
  2988. ************************************************************************
  2989. * SAMPLE2
  2990. * ...
  2991. CLEAR
  2992. X = 1
  2993. NewValue = JouCal(X,"A")
  2994. ? X
  2995. ? NewValue
  2996. * ...
  2997.  
  2998. FUNCTION JOLCAL
  2999. *╔════════════════════════════════════════════════════╗
  3000. *║ Program...: JOLCAL                                 ║
  3001. *║ Author....: Phil Steele - President                ║
  3002. *║             Phillipps Computer Systems Inc.        ║
  3003. *║ Address...: 52 Hook Mountain Road,                 ║
  3004. *║             Montville NJ 07045                     ║
  3005. *║ Phone.....: (201) 575-8575                         ║
  3006. *║ Date......: 03/22/88                               ║
  3007. *║ Notice....: Copyright 1988  Philip Steele,         ║
  3008. *║             All Rights Reserved.                   ║
  3009. *║ Notes.....: This function converts Joules to       ║
  3010. *║             kilocalories and kilocalories to Joules║
  3011. *║ Parameters: X  - The variable to be converted from ║
  3012. *║                  metric or American to the other.  ║
  3013. *║             MA - "M" = convert to metric;          ║
  3014. *║                  "A" = convert to American.        ║
  3015. *╚════════════════════════════════════════════════════╝
  3016. PARAMETERS X, MA
  3017. PRIVATE    FactorM, FactorA, Factor
  3018. Joule_CalK = 0.00023918
  3019. CalK_Joule = 4186
  3020. FactorM    = Joule_CalK
  3021. FactorA    = CalK_Joule
  3022. Factor     = IIF(UPPER(MA)="A", FactorM, FactorA)
  3023. RETURN (X * Factor)
  3024. ************************************************************************
  3025. * SAMPLE2
  3026. * ...
  3027. CLEAR
  3028. X = 1
  3029. NewValue = MetFrl(X,"A")
  3030. ? X
  3031. ? NewValue
  3032. * ...
  3033.  
  3034. FUNCTION METFRL
  3035. *╔════════════════════════════════════════════════════╗
  3036. *║ Program...: METFRL                                 ║
  3037. *║ Author....: Phil Steele - President                ║
  3038. *║             Phillipps Computer Systems Inc.        ║
  3039. *║ Address...: 52 Hook Mountain Road,                 ║
  3040. *║             Montville NJ 07045                     ║
  3041. *║ Phone.....: (201) 575-8575                         ║
  3042. *║ Date......: 03/22/88                               ║
  3043. *║ Notice....: Copyright 1988  Philip Steele,         ║
  3044. *║             All Rights Reserved.                   ║
  3045. *║ Notes.....: This function converts meters to       ║
  3046. *║             furlongs and furlongs to meters.       ║
  3047. *║ Parameters: X  - The variable to be converted from ║
  3048. *║                  metric or American to the other.  ║
  3049. *║             MA - "M" = convert to metric;          ║
  3050. *║                  "A" = convert to American.        ║
  3051. *╚════════════════════════════════════════════════════╝
  3052. PARAMETERS X, MA
  3053. PRIVATE    FactorM, FactorA, Factor
  3054. Meter_Furlng = 0.00497096
  3055. Furlng_Meter = 201.168
  3056. FactorM      = Meter_Furlng
  3057. FactorA      = Furlng_Meter
  3058. Factor       = IIF(UPPER(MA)="A", FactorM, FactorA)
  3059. RETURN (X * Factor)
  3060. ************************************************************************
  3061. * SAMPLE2
  3062. * ...
  3063. CLEAR
  3064. X = 1
  3065. NewValue = MetFat(X,"A")
  3066. ? X
  3067. ? NewValue
  3068. * ...
  3069.  
  3070. FUNCTION METFAT
  3071. *╔════════════════════════════════════════════════════╗
  3072. *║ Program...: METFAT                                 ║
  3073. *║ Author....: Phil Steele - President                ║
  3074. *║             Phillipps Computer Systems Inc.        ║
  3075. *║ Address...: 52 Hook Mountain Road,                 ║
  3076. *║             Montville NJ 07045                     ║
  3077. *║ Phone.....: (201) 575-8575                         ║
  3078. *║ Date......: 03/22/88                               ║
  3079. *║ Notice....: Copyright 1988  Philip Steele,         ║
  3080. *║             All Rights Reserved.                   ║
  3081. *║ Notes.....: This function converts meters to       ║
  3082. *║             fathoms and fathoms to meters.         ║
  3083. *║ Parameters: X  - The variable to be converted from ║
  3084. *║                  metric or American to the other.  ║
  3085. *║             MA - "M" = convert to metric;          ║
  3086. *║                  "A" = convert to American.        ║
  3087. *╚════════════════════════════════════════════════════╝
  3088. PARAMETERS X, MA
  3089. PRIVATE    FactorM, FactorA, Factor
  3090. Meter_Fathom = 0.546806
  3091. Fathom_Meter = 1.828804
  3092. FactorM      = Meter_Fathom
  3093. FactorA      = Fathom_Meter
  3094. Factor       = IIF(UPPER(MA)="A", FactorM, FactorA)
  3095. RETURN (X * Factor)
  3096. ************************************************************************
  3097. * SAMPLE2
  3098. * ...
  3099. CLEAR
  3100. X = 1
  3101. NewValue = FatFt(X,1)
  3102. ? X
  3103. ? NewValue
  3104. * ...
  3105.  
  3106. FUNCTION FATFT
  3107. *╔════════════════════════════════════════════════════╗
  3108. *║ Program...: FATFT                                  ║
  3109. *║ Author....: Phil Steele - President                ║
  3110. *║             Phillipps Computer Systems Inc.        ║
  3111. *║ Address...: 52 Hook Mountain Road,                 ║
  3112. *║             Montville NJ 07045                     ║
  3113. *║ Phone.....: (201) 575-8575                         ║
  3114. *║ Date......: 03/22/88                               ║
  3115. *║ Notice....: Copyright 1988  Philip Steele,         ║
  3116. *║             All Rights Reserved.                   ║
  3117. *║ Notes.....: This function converts fathoms to feet ║
  3118. *║             and feet to fathoms.                   ║
  3119. *║ Parameters: X  -  The variable to be converted     ║
  3120. *║                   from one measure to the other.   ║
  3121. *║             Ord - 1 Forward direction from title.  ║
  3122. *║                   2 Reverse direction from title.  ║
  3123. *╚════════════════════════════════════════════════════╝
  3124. PARAMETERS X, Ord
  3125. PRIVATE    FactorF, FactorB, Factor
  3126. Fathom_Ft = 6
  3127. Ft_Fathom = 1 / 6
  3128. FactorF   = Fathom_Ft
  3129. FactorB   = Ft_Fathom
  3130. Factor    = IIF(Ord=1, FactorF, FactorB)
  3131. RETURN (X * Factor)
  3132. ************************************************************************
  3133. * SAMPLE2
  3134. * ...
  3135. CLEAR
  3136. X = 1
  3137. NewValue = FurMile(X,1)
  3138. ? X
  3139. ? NewValue
  3140. * ...
  3141.  
  3142. FUNCTION FURMILE
  3143. *╔════════════════════════════════════════════════════╗
  3144. *║ Program...: FURMILE                                ║
  3145. *║ Author....: Phil Steele - President                ║
  3146. *║             Phillipps Computer Systems Inc.        ║
  3147. *║ Address...: 52 Hook Mountain Road,                 ║
  3148. *║             Montville NJ 07045                     ║
  3149. *║ Phone.....: (201) 575-8575                         ║
  3150. *║ Date......: 03/22/88                               ║
  3151. *║ Notice....: Copyright 1988  Philip Steele,         ║
  3152. *║             All Rights Reserved.                   ║
  3153. *║ Notes.....: This function converts furlongs to     ║
  3154. *║             miles and miles to furlongs.           ║
  3155. *║ Parameters: X  -  The variable to be converted     ║
  3156. *║                   from one measure to the other.   ║
  3157. *║             Ord - 1 Forward direction from title.  ║
  3158. *║                   2 Reverse direction from title.  ║
  3159. *╚════════════════════════════════════════════════════╝
  3160. PARAMETERS X, Ord
  3161. PRIVATE    FactorF, FactorB, Factor
  3162. Furlong_Mile = 0.125
  3163. Mile_Furlong = 8
  3164. FactorF      = Furlong_Mile
  3165. FactorB      = Mile_Furlong
  3166. Factor       = IIF(Ord=1, FactorF, FactorB)
  3167. RETURN (X * Factor)
  3168. ************************************************************************
  3169. * SAMPLE2
  3170. * ...
  3171. CLEAR
  3172. X = 1
  3173. NewValue = LCalHP(X,1)
  3174. ? X
  3175. ? NewValue
  3176. * ...
  3177.  
  3178. FUNCTION KCALHP
  3179. *╔════════════════════════════════════════════════════╗
  3180. *║ Program...: KCALHP                                 ║
  3181. *║ Author....: Phil Steele - President                ║
  3182. *║             Phillipps Computer Systems Inc.        ║
  3183. *║ Address...: 52 Hook Mountain Road,                 ║
  3184. *║             Montville NJ 07045                     ║
  3185. *║ Phone.....: (201) 575-8575                         ║
  3186. *║ Date......: 03/22/88                               ║
  3187. *║ Notice....: Copyright 1988  Philip Steele,         ║
  3188. *║             All Rights Reserved.                   ║
  3189. *║ Notes.....: This function converts kilocalories to ║
  3190. *║             horsepower hours and horsepower hours  ║
  3191. *║             to kilocalories.                       ║
  3192. *║ Parameters: X  -  The variable to be converted     ║
  3193. *║                   from one measure to the other.   ║
  3194. *║             Ord - 1 Forward direction from title.  ║
  3195. *║                   2 Reverse direction from title.  ║
  3196. *╚════════════════════════════════════════════════════╝
  3197. PARAMETERS X, Ord
  3198. PRIVATE    FactorF, FactorB, Factor
  3199. CalK_HPHrs = 0.0015593
  3200. HPHrs_CalK = 641.304
  3201. FactorF    = CalK_HPHrs
  3202. FactorB    = HPHrs_CalK
  3203. Factor     = IIF(Ord=1, FactorF, FactorB)
  3204. RETURN (X * Factor)
  3205. ************************************************************************
  3206. * SAMPLE2
  3207. * ...
  3208. CLEAR
  3209. X = 1
  3210. NewValue = KWHP(X,1)
  3211. ? X
  3212. ? NewValue
  3213. * ...
  3214.  
  3215. FUNCTION KWHP
  3216. *╔════════════════════════════════════════════════════╗
  3217. *║ Program...: KWHP                                   ║
  3218. *║ Author....: Phil Steele - President                ║
  3219. *║             Phillipps Computer Systems Inc.        ║
  3220. *║ Address...: 52 Hook Mountain Road,                 ║
  3221. *║             Montville NJ 07045                     ║
  3222. *║ Phone.....: (201) 575-8575                         ║
  3223. *║ Date......: 03/22/88                               ║
  3224. *║ Notice....: Copyright 1988  Philip Steele,         ║
  3225. *║             All Rights Reserved.                   ║
  3226. *║ Notes.....: This function converts kilowatts to    ║
  3227. *║             horsepower and horsepower to kilowatts.║
  3228. *║ Parameters: X  -  The variable to be converted     ║
  3229. *║                   from one measure to the other.   ║
  3230. *║             Ord - 1 Forward direction from title.  ║
  3231. *║                   2 Reverse direction from title.  ║
  3232. *╚════════════════════════════════════════════════════╝
  3233. PARAMETERS X, Ord
  3234. PRIVATE    FactorF, FactorB, Factor
  3235. HP_KWatts = 0.74570
  3236. KWatts_HP = 1.3410
  3237. FactorF   = HP_KWatts
  3238. FactorB   = KWatts_HP
  3239. Factor    = IIF(Ord=1, FactorF, FactorB)
  3240. RETURN (X * Factor)
  3241.