home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / dblib201.zip / CONVERT.PRG < prev    next >
Text File  |  1993-04-19  |  54KB  |  1,352 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: CONVERT.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 02/23/1993
  5. *-- Notes.....: This is a complete overhaul of the CONVERT program in LIBxxx.ZIP
  6. *--             Jay went through it and did massive work ...
  7. *--             For details on this file (and others in the library) see 
  8. *--             README.TXT.
  9. *-------------------------------------------------------------------------------
  10.  
  11. FUNCTION Roman
  12. *-------------------------------------------------------------------------------
  13. *-- Programmer..: Nick Carlin
  14. *-- Date........: 04/26/1992
  15. *-- Notes.......: A function designed to return a Roman Numeral based on
  16. *--               an Arabic Numeral input ...
  17. *-- Written for.: dBASE III+
  18. *-- Rev. History: 04/13/1988 - original function.
  19. *--               07/25/1991 - Ken Mayer - 1) modified for dBASE IV, 1.1,
  20. *--                             2) updated to a function, and 3) the procedure
  21. *--                             GetRoman was done away with (combined into the
  22. *--                             function).
  23. *--               04/26/1992 - Jay Parsons - shortened (seriously ...)
  24. *-- Calls.......: None
  25. *-- Called by...: Any
  26. *-- Usage.......: Roman(<nArabic>)
  27. *-- Example.....: ? Roman(32)
  28. *-- Returns.....: Roman Numeral (character string) equivalent of Arabic numeral
  29. *--               passed to it. In example:  XXXII
  30. *-- Parameters..: nArabic = Arabic number to be converted to Roman
  31. *-------------------------------------------------------------------------------
  32.  
  33.    parameters nArabic
  34.    private cLetrs,nCount,nValue,cRoman,cGroup,nMod
  35.     
  36.    cLetrs ="MWYCDMXLCIVX"      && Roman digits
  37.    cRoman = ""                 && this is the returned value
  38.    nCount = 0                  && init counter
  39.    do while nCount < 4         && loop four times, once for thousands, once
  40.                                && for each of hundreds, tens and singles
  41.       nValue = mod( int( nArabic /  10 ^ ( 3 - nCount ) ), 10 )
  42.       cGroup = substr( cLetrs, nCount * 3 + 1, 3 )
  43.       nMod = mod( nValue, 5 )
  44.       if nMod = 4
  45.          if nValue = 9                 && 9
  46.             cRoman = cRoman + left( cGroup, 1 ) + right( cGroup, 1 )
  47.          else                          && 4
  48.             cRoman = cRoman + left( cGroup, 2 )
  49.          endif
  50.       else
  51.          if nValue > 4                 && 5 - 8
  52.             cRoman = cRoman + substr( cGroup, 2, 1 )
  53.          endif
  54.          if nMod > 0                   && 1 - 3 and 6 - 8
  55.             cRoman = cRoman + replicate( left( cGroup, 1 ), nMod )
  56.          endif
  57.       endif
  58.       nCount = nCount + 1
  59.    enddo  && while nCounter < 4
  60.     
  61. RETURN cRoman
  62. *-- EoF: Roman()
  63.  
  64. FUNCTION Arabic
  65. *-------------------------------------------------------------------------------
  66. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  67. *-- Date........: 04/26/1992
  68. *-- Notes.......: This function converts a Roman Numeral to an arabic one.
  69. *--               It parses the roman numeral into an array, and checks each 
  70. *--               character ... if the previous character causes the value to 
  71. *--               subtract (for example, IX = 9, not 10) we subtract that value, 
  72. *--               and then set the previous value to 0, otherwise we would get 
  73. *--               some odd values in return.
  74. *--               So far, it works fine.
  75. *-- Written for.: dBASE IV, 1.1
  76. *-- Rev. History: 07/15/1991 - original function.
  77. *--               04/26/1992 - Jay Parsons - shortened.
  78. *-- Calls.......: None
  79. *-- Called by...: Any
  80. *-- Usage.......: Arabic(<cRoman>)
  81. *-- Example.....: ?Arabic("XXIV")
  82. *-- Returns.....: Arabic number (from example, 24)
  83. *-- Parameters..: cRoman = character string containing roman numeral to be
  84. *--               converted.
  85. *-------------------------------------------------------------------------------
  86.  
  87.   parameters cRoman
  88.   private cRom,cLetrs,nLast,nAt,nVal,cChar,nArabic
  89.     
  90.    cRom = ltrim(trim(upper(cRoman))) && convert to all caps in case ...
  91.    cLetrs = "IVXLCDMWY"
  92.    nArabic = 0
  93.    nLast = 0
  94.    do while len( cRom ) > 0
  95.       cChar = right( cRom, 1 )
  96.       nAt = at( cChar, cLetrs )
  97.       nVal= 10 ^ int( nAt/2 ) / iif(nAt/2 = int(nAt/2),2,1)
  98.       do case
  99.          case nAt = 0
  100.             nArabic = 0
  101.             exit
  102.          case nAt >= nLast
  103.             nArabic = nArabic + nVal
  104.             nLast = nAt
  105.          otherwise
  106.             if nAt/2 = int( nAt / 2 )
  107.                nArabic = 0
  108.                exit
  109.             else
  110.                nArabic = nArabic - nVal
  111.             endif
  112.       endcase
  113.       cRom = left( cRom, len( cRom ) - 1 )
  114.    enddo
  115.     
  116. RETURN nArabic
  117. *-- EoF: Arabic()
  118.  
  119. FUNCTION Factorial
  120. *-------------------------------------------------------------------------------
  121. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  122. *-- Date........: 03/01/1992
  123. *-- Notes.......: Factorial of a number; returns -1 if number is not a
  124. *--               positive integer.
  125. *-- Written for.: dBASE IV, 1.1
  126. *-- Rev. History: 03/01/1992
  127. *-- Calls.......: None
  128. *-- Called by...: Any
  129. *-- Usage.......: Factorial(<nNumber>)
  130. *-- Example.....: ? Factorial( 6 )
  131. *-- Returns.....: Numeric = number factorial <in example, 6! or 720>
  132. *-- Parameters..: nNumber = number for which factorial is to be determined
  133. *-------------------------------------------------------------------------------
  134.  
  135.     parameters nNumber
  136.     private nNext, nProduct
  137.     if nNumber # int( nNumber ) .or. nNumber < 1
  138.       RETURN -1
  139.     endif
  140.     nProduct = 1
  141.     nNext = nNumber
  142.     do while nNext > 1
  143.       nProduct = nProduct * nNext
  144.       nNext = nNext - 1
  145.     enddo
  146.     
  147. RETURN nProduct
  148. *-- Eof: Factorial()
  149.                                  
  150. FUNCTION IsPrime
  151. *-------------------------------------------------------------------------------
  152. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  153. *-- Date........: 08/11/1992
  154. *-- Notes.......: Returns .t. if argument is prime positive integer, or .f.
  155. *-- Written for.: dBASE IV, 1.1
  156. *-- Rev. History: 03/11/92 - original function.
  157. *--             : 08/11/92 - revised to return .T. for 2. ( Tea for two? )
  158. *-- Calls.......: None
  159. *-- Called by...: Any
  160. *-- Usage.......: IsPrime(<nNumber>)
  161. *-- Example.....: ? IsPrime( 628321 )
  162. *-- Returns.....: Logical = .t. if prime
  163. *-- Parameters..: nNumber = positive integer to test for being prime
  164. *-------------------------------------------------------------------------------
  165.  
  166.    parameters nNumber
  167.    private nFactor, nLimit, lResult
  168.    if nNumber < 1 .or. nNumber # int( nNumber ) ;
  169.       .or. ( nNumber > 2 .AND. mod( nNumber, 2 ) = 0 )
  170.       RETURN .f.
  171.    endif
  172.    nFactor = 3
  173.    nLimit = sqrt( nNumber )
  174.    lResult = .t.
  175.    do while nFactor <= nLimit
  176.       if mod( nNumber, nFactor ) = 0
  177.          lResult = .f.
  178.          exit
  179.       endif
  180.       nFactor = nFactor + 2
  181.    enddo
  182.  
  183. RETURN lResult
  184. *-- Eof: IsPrime()
  185.  
  186. FUNCTION BankRound
  187. *-------------------------------------------------------------------------------
  188. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  189. *-- Date........: 03/01/1992
  190. *-- Notes.......: Rounds numeric argument to given number of places,
  191. *--               which if positive are decimal places, otherwise
  192. *--               trailing zeroes before the decimal, in accordance
  193. *--               with the special banker's rule that if the value
  194. *--               lost by rounding is exactly halfway between two
  195. *--               possible digits, the final digit expressed will be even.
  196. *-- Written for.: dBASE IV, 1.1
  197. *-- Rev. History: 03/01/1992
  198. *-- Calls.......: None
  199. *-- Called by...: Any
  200. *-- Usage.......: BankRound(<nNumber>,<nPlaces>)
  201. *-- Example.....: ? BankRound( 357.725, 2 )
  202. *-- Returns.....: Numeric = rounded value ( 357.72 in example )
  203. *-- Parameters..: nNumber = numeric value to round
  204. *--               nPlaces = decimal places, negative being powers of 10
  205. *-------------------------------------------------------------------------------
  206.  
  207.     parameters nNumber, nPlaces
  208.     private nTemp
  209.     nTemp = nNumber * 10 ^ nPlaces +.5
  210.     if nTemp = int( nTemp ) .and. nTemp / 2 # int( nTemp / 2 )
  211.       nTemp = nTemp - 1
  212.     endif
  213.     
  214. RETURN int( nTemp ) / 10 ^ nPlaces
  215. *-- Eof: BankRound()
  216.  
  217. FUNCTION Dec2Hex
  218. *-------------------------------------------------------------------------------
  219. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  220. *-- Date........: 03/01/1992
  221. *-- Notes.......: Converts an unsigned integer ( in decimal notation)
  222. *--               to a hexadecimal string
  223. *-- Written for.: dBASE IV, 1.1
  224. *-- Rev. History: 03/01/1992
  225. *-- Calls.......: None
  226. *-- Called by...: Any
  227. *-- Usage.......: Dec2Hex(<nDecimal>)
  228. *-- Example.....: ? Dec2Hex( 118 )
  229. *-- Returns.....: Character = Hexadecimal equivalent ( "F6" in example )
  230. *-- Parameters..: nDecimal = number to convert
  231. *-------------------------------------------------------------------------------
  232.     
  233.     parameters nDecimal
  234.     private nD, cH
  235.     nD = int( nDecimal )
  236.     cH= ""
  237.     do while nD > 0
  238.       cH = substr( "0123456789ABCDEF", mod( nD, 16 ) + 1 , 1 ) + cH
  239.       nD = int( nD / 16 )
  240.     enddo
  241.     
  242. RETURN iif( "" = cH, "0", cH )
  243. *-- Eof: Dec2Hex()
  244.  
  245. FUNCTION Hex2Dec
  246. *-------------------------------------------------------------------------------
  247. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  248. *-- Date........: 11/26/1992
  249. *-- Notes.......: Converts a hexadecimal character string representing
  250. *--               an unsigned integer to its numeric (decimal) equivalent
  251. *-- Written for.: dBASE IV, 1.1
  252. *-- Rev. History: 03/01/92 - original function.
  253. *--               11/26/92 - modified to eliminate usually-harmless
  254. *--               "substring out of range" error, Jay Parsons
  255. *-- Calls.......: None
  256. *-- Called by...: Any
  257. *-- Usage.......: Hex2Dec(<cHex>)
  258. *-- Example.....: ? Hex2Dec( "F6" )
  259. *-- Returns.....: Numeric = equivalent ( 118 in example )
  260. *-- Parameters..: cHex = character string to convert
  261. *-------------------------------------------------------------------------------
  262.     
  263.     parameters cHex
  264.     private nD, cH
  265.         cH = upper( trim( ltrim ( cHex ) ) ) + "!"
  266.     nD = 0
  267.         do while len( cH ) > 1
  268.       nD = nD * 16 + at( left( cH, 1 ), "123456789ABCDEF" )
  269.       cH = substr( cH, 2 )
  270.     enddo
  271.     
  272. RETURN nD
  273. *-- Eof: Hex2Dec()
  274.  
  275. FUNCTION Hex2Bin
  276. *-------------------------------------------------------------------------------
  277. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  278. *-- Date........: 12/01/1992
  279. *-- Notes.......: Converts a hexadecimal character string representing
  280. *--               an unsigned integer to its binary string equivalent
  281. *-- Written for.: dBASE IV, 1.1
  282. *-- Rev. History: 03/01/92 - original function.
  283. *--               12/01/92 - modified to eliminate usually-harmless
  284. *--               "substring out of range" error, Jay Parsons
  285. *-- Calls.......: None
  286. *-- Called by...: Any
  287. *-- Usage.......: Hex2Bin(<cHex>)
  288. *-- Example.....: ? Hex2Bin( "F6" )
  289. *-- Returns.....: Character = binary string ( "1111 0110" in example )
  290. *-- Parameters..: cHex = character string to convert
  291. *-------------------------------------------------------------------------------
  292.     
  293.     parameters cHex
  294.     private cH, cBits, cNybbles, cVal
  295.         cH = upper( trim( ltrim( cHex ) ) ) + "!"
  296.     cBits = ""
  297.     cNybbles = "00000001001000110100010101100111" ;
  298.               +"10001001101010111100110111101111"
  299.         do while len( cH ) > 1
  300.       cVal = left( cH, 1 )
  301.       if cVal # " "
  302.         cBits = cBits + " " + substr( cNybbles, ;
  303.           at ( cVal, "123456789ABCDEF" ) * 4 + 1, 4 )
  304.       endif
  305.       cH = substr( cH, 2 )
  306.     enddo
  307.     
  308. RETURN iif( "" = cBits, "0", ltrim( cBits ) )
  309. *-- Eof: Hex2Bin()
  310.  
  311. FUNCTION Bin2Hex
  312. *-------------------------------------------------------------------------------
  313. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  314. *-- Date........: 03/01/1992
  315. *-- Notes.......: Converts a binary character string representing
  316. *--               an unsigned integer to its hexadecimal string equivalent
  317. *-- Written for.: dBASE IV, 1.1
  318. *-- Rev. History: 03/01/1992
  319. *-- Calls.......: None
  320. *-- Called by...: Any
  321. *-- Usage.......: Bin2Hex(<cBin>)
  322. *-- Example.....: ? Bin2Hex( "1111 0110" )
  323. *-- Returns.....: Character = hexadecimal string ( "F6" in example )
  324. *-- Parameters..: cBin = character string to convert
  325. *-------------------------------------------------------------------------------
  326.     
  327.     parameters cBin
  328.     private cH, cBits, nBits, nBval, cNext
  329.     cBits = trim( ltrim( cBin ) )
  330.     nBits = len( cBits ) - 1
  331.     do while nBits > 0
  332.       if substr( cBits, nBits, 1 ) $ ", "
  333.         nBval = mod( 4 - mod( len( cBits ) - nBits, 4 ), 4 )
  334.         cBits = stuff( cBits, nBits, 1, replicate( "0", nBval ) )
  335.       endif
  336.       nBits = nBits - 1
  337.     enddo
  338.     cH = ""
  339.     do while "" # cBits
  340.       store 0 to nBits, nBval
  341.       do while nBits < 4
  342.         cNext = right( cBits, 1 )
  343.         nBval = nBval + iif( cNext = "1", 2 ^ nBits, 0 )
  344.         cBits = left( cBits, len( cBits ) - 1 )
  345.         if "" = cBits
  346.           exit
  347.         endif
  348.         nBits = nBits + 1
  349.       enddo
  350.       cH = substr( "0123456789ABCDEF", nBval + 1, 1 ) + cH
  351.     enddo
  352.     
  353. RETURN iif( "" = cH, "0", cH )
  354. *-- Eof: Bin2Hex()
  355.  
  356. FUNCTION Dec2Oct
  357. *-------------------------------------------------------------------------------
  358. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  359. *-- Date........: 03/01/1992
  360. *-- Notes.......: Converts an unsigned integer to its octal string equivalent
  361. *-- Written for.: dBASE IV, 1.1
  362. *-- Rev. History: 03/01/1992
  363. *-- Calls.......: None
  364. *-- Called by...: Any
  365. *-- Usage.......: Dec2Oct(<nDec>)
  366. *-- Example.....: ? Dec2Oct( 118 )
  367. *-- Returns.....: Character = octal string ( "166" in example )
  368. *-- Parameters..: nDec = number to convert
  369. *-------------------------------------------------------------------------------
  370.     
  371.     parameters nDec
  372.     private nD, cO
  373.     nD = int( nDec )
  374.     cO = ""
  375.     do while nD > 0
  376.       cO = substr( "01234567", mod( nD, 8 ) + 1 , 1 ) + cO
  377.       nD = int( nD / 8 )
  378.     enddo
  379.  
  380. RETURN iif( "" = cO, "0", cO )
  381. *-- Eof: Dec2Oct()
  382.  
  383. FUNCTION Oct2Dec
  384. *-------------------------------------------------------------------------------
  385. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  386. *-- Date........: 12/01/1992
  387. *-- Notes.......: Converts an unsigned number in octal, or its string
  388. *--               representation, to a numeric (decimal) value
  389. *-- Written for.: dBASE IV, 1.1
  390. *-- Rev. History: 03/01/92 - original function.
  391. *--               12/01/92 - modified to eliminate usually-harmless
  392. *--               "substring out of range" error, Jay Parsons
  393. *-- Calls.......: None
  394. *-- Called by...: Any
  395. *-- Usage.......: Oct2Dect(<xOct>)
  396. *-- Example.....: ? Oct2Dec( 166 )
  397. *-- Returns.....: Numeric = decimal equivalent ( 118 in example )
  398. *-- Parameters..: xOct = octal character string or number to convert
  399. *-------------------------------------------------------------------------------
  400.     
  401.     parameters xOct
  402.     private nD, cO, cVal
  403.     if type( "xOct" ) $ "NF"
  404.       cO = str( xOct )
  405.     else
  406.       cO = xOct
  407.     endif
  408.         cO = upper( trim( ltrim( cO ) ) ) + "!"
  409.     nD = 0
  410.         do while len( cO ) > 1
  411.       cVal = left( cO, 1 )
  412.       if cVal # " "
  413.         nD = nD * 8 + at( cVal, "1234567" )
  414.       endif
  415.       cO = substr( cO, 2 )
  416.     enddo
  417.     
  418. RETURN nD
  419. *-- Eof: Oct2Dec()
  420.  
  421. FUNCTION Cash2Check
  422. *-------------------------------------------------------------------------------
  423. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  424. *-- Date........: 03/01/1992
  425. *-- Notes.......: Converts a number of dollars and cents to a string of words
  426. *--               appropriate for writing checks.
  427. *--               To correctly evaluate values over 16 decimal places,
  428. *--               SET PRECISION TO a value larger than the default of 16
  429. *--               before calling this function.
  430. *-- Written for.: dBASE IV, 1.1
  431. *-- Rev. History: 03/01/1992 -- Original Release
  432. *-- Calls.......: NUM2WORDS()          Function in CONVERT.PRG
  433. *--               THOU2WORDS()         Function in CONVERT.PRG
  434. *-- Called by...: Any
  435. *-- Usage.......: Cash2Check(<nCash>)
  436. *-- Example.....: ? Cash2Check( 348.27 )
  437. *-- Returns.....: Character string equivalent
  438. *-- Parameters..: nCash = money value to convert
  439. *-------------------------------------------------------------------------------
  440.  
  441.     parameters nCash
  442.     private nDollars, nCents, cResult
  443.     nDollars = int( nCash )
  444.     nCents = 100 * round( nCash - nDollars, 2 )
  445.     cResult = trim( Num2Words( nDollars ) )
  446.     if left( cResult, 1 ) = "C"               && deals with oversize number
  447.       RETURN cResult
  448.     endif
  449.     cResult = cResult + " dollar" + iif( nDollars # 1, "s", "" ) + " and "
  450.     if nCents # 0
  451.       RETURN cResult + Thou2Words( nCents )  + " cent" + iif( nCents # 1, "s", "" )
  452.     else
  453.       RETURN cResult + "no cents"
  454.     endif
  455.     
  456. *-- Eof: Cash2Check()
  457.  
  458. FUNCTION Num2Words
  459. *-------------------------------------------------------------------------------
  460. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  461. *-- Date........: 03/01/1992
  462. *-- Notes.......: Converts an integer to a string of words.  Limited, due to
  463. *--               254-character limit of dBASE strings, to numbers less than
  464. *--               10 ^ 15
  465. *-- Written for.: dBASE IV, 1.1
  466. *-- Rev. History: 03/01/1992 -- Original Release
  467. *-- Calls.......: THOU2WORDS()         Function in CONVERT.PRG
  468. *-- Called by...: Any
  469. *-- Usage.......: Num2Words(<nNum>)
  470. *-- Example.....: ? Num2Words( 4321568357 )
  471. *-- Returns.....: Character string equivalent
  472. *-- Parameters..: nNum = numeric integer to convert
  473. *-------------------------------------------------------------------------------
  474.     
  475.     parameters nNum
  476.     private nNumleft, nScale, nGroup, cResult
  477.     nNumleft = int( nNum )
  478.     do case
  479.       case abs( nNumleft ) >= 10 ^ 15
  480.         RETURN "Cannot convert a number in or above the quadrillions."    
  481.       case nNumleft = 0
  482.         RETURN "zero"
  483.       case nNumleft < 0
  484.         cResult = "minus "
  485.         nNumleft = -nNumleft
  486.       otherwise 
  487.         cResult = ""
  488.     endcase
  489.     do while nNumleft > 0
  490.       nScale = int( log10( nNumleft ) / 3 )
  491.       nGroup = int( nNumleft / 10 ^ ( 3 * nScale ) )
  492.       nNumleft = mod( nNumleft, 10 ^ ( 3 * nScale ) )
  493.       cResult = cResult + Thou2Words( nGroup )
  494.       if nScale > 0
  495.         cResult = cResult + " " ;
  496.           + trim( substr( "thousandmillion billion trillion", nScale * 8 - 7, 8 ) )
  497.         if nNumleft > 0
  498.           cResult = cResult + ", "
  499.         endif
  500.       endif
  501.     enddo           
  502.     
  503. RETURN cResult
  504. *-- Eof: Num2Words()
  505.  
  506. FUNCTION Thou2Words
  507. *-------------------------------------------------------------------------------
  508. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  509. *-- Date........: 03/01/1992
  510. *-- Notes.......: Converts a positive integer less than 1000 to a string
  511. *--               of characters.
  512. *-- Written for.: dBASE IV, 1.1
  513. *-- Rev. History: 03/01/1992 -- Original Release
  514. *-- Calls.......: None
  515. *-- Called by...: Any
  516. *-- Usage.......: Thou2Words(<nNum>)
  517. *-- Example.....: ? Thou2Words( 834 )
  518. *-- Returns.....: Character string equivalent
  519. *-- Parameters..: nNum = numeric integer to convert
  520. *-------------------------------------------------------------------------------
  521.     
  522.     parameters nNum
  523.     private cUnits, cTens, nN, cResult
  524.     cUnits = "one      two      " ;
  525.            + "three    four     " ;
  526.            + "five     six      " ;
  527.            + "seven    eight    " ;
  528.            + "nine     ten      " ;
  529.            + "eleven   twelve   " ;
  530.            + "thirteen fourteen " ;
  531.            + "fifteen  sixteen  " ;
  532.            + "seventeeneighteen " ;
  533.            + "nineteen "
  534.     cTens = "twen thir for  fif  six  seveneigh nine "
  535.     nN = int( nNum )
  536.     if nN = 0
  537.       RETURN "zero"
  538.     endif
  539.     cResult = ""
  540.     if nNum > 99
  541.       cResult = trim( substr(cUnits, int(nNum / 100 ) * 9 - 8, 9 ) ) + " hundred"
  542.       nN = mod( nN, 100 )
  543.       if nN = 0
  544.         RETURN cResult
  545.       else
  546.         cResult = cResult + " "
  547.       endif
  548.     endif
  549.     if nN > 19
  550.       cResult = cResult + trim( substr( cTens, int( nN / 10 ) * 5 - 9, 5 ) ) + "ty"
  551.       nN = mod( nN, 10 )
  552.       if nN = 0
  553.         RETURN cResult
  554.       else
  555.         cResult = cResult + "-"
  556.       endif
  557.     endif
  558.     
  559. RETURN cResult + trim( substr( cUnits, nN * 9 - 8, 9 ) )
  560. *-- Eof: Thou2Words()
  561.  
  562. FUNCTION Ord
  563. *-------------------------------------------------------------------------------
  564. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  565. *-- Date........: 03/01/1992
  566. *-- Notes.......: Converts an integer to ordinal representation by adding
  567. *--               "st", "nd", "rd" or "th" after its digit(s)
  568. *-- Written for.: dBASE IV, 1.1
  569. *-- Rev. History: 03/01/1992 -- Original Release
  570. *-- Calls.......: None
  571. *-- Called by...: Any
  572. *-- Usage.......: Ord(<nNum>)
  573. *-- Example.....: ? Ord( 11 )
  574. *-- Returns.....: Character ordinal string equivalent ( "11th" in example )
  575. *-- Parameters..: nNum = numeric integer to convert
  576. *-------------------------------------------------------------------------------
  577.     
  578.     parameters nNum
  579.     private nD
  580.     nD = mod( nNum, 100 ) - 1     && the -1 just happens to simplify what follows
  581.     
  582. RETURN str( nNum ) + iif( mod( nD, 10 ) > 2 .or. abs( nD - 11 ) < 2, ;
  583.    "th", substr( "stndrd", mod( nD, 10 ) * 2 + 1, 2 ) )
  584. *-- Eof: Ord()
  585.  
  586. FUNCTION Dec2Bin
  587. *-------------------------------------------------------------------------------
  588. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  589. *-- Date........: 03/01/1992
  590. *-- Notes.......: Converts an unsigned number to a character
  591. *--               string giving its ASCII binary representation.
  592. *-- Written for.: dBASE IV, 1.1
  593. *-- Rev. History: 03/01/1992 -- Original Release
  594. *-- Calls.......: None
  595. *-- Called by...: Any
  596. *-- Usage.......: Dec2Bin(<nNum>,<nPlaces>)
  597. *-- Example.....: ? Dec2Bin( 35, 8 )
  598. *-- Returns.....: Character binary equivalent ( "0010 0011", in example )
  599. *-- Parameters..: nNum = number to convert
  600. *--               nPlaces = number of binary places number is to occupy
  601. *-------------------------------------------------------------------------------
  602.     
  603.     parameters nNum, nPlaces
  604.     private cBits, nN
  605.     cBits= ""
  606.     nN = nNum
  607.     do while len(cBits) < nPlaces
  608.       if nN > 0
  609.         cBits = str( mod( nN, 2 ), 1 ) + cBits
  610.         nN = int( nN / 2 )
  611.       else
  612.         cBits = "0" +cBits
  613.       endif
  614.     enddo
  615.     
  616. RETURN cBits
  617. *-- Eof: Dec2Bin()
  618.  
  619. FUNCTION Frac2Bin
  620. *-------------------------------------------------------------------------------
  621. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  622. *-- Date........: 03/01/1992
  623. *-- Notes.......: Converts the fractional part of an unsigned number
  624. *--               to a character string giving its ASCII binary representation.
  625. *-- Written for.: dBASE IV, 1.1
  626. *-- Rev. History: 03/01/1992 -- Original Release
  627. *-- Calls.......: None
  628. *-- Called by...: Any
  629. *-- Usage.......: Frac2Bin(<nNum>,<nPlaces>)
  630. *-- Example.....: ? Frac2Bin( .35, 8 )
  631. *-- Returns.....: Character binary equivalent
  632. *-- Parameters..: nNum = number to convert
  633. *--               nPlaces = number of binary places number is to occupy
  634. *-------------------------------------------------------------------------------
  635.  
  636.     parameters nNum, nPlaces
  637.     private cBits, nN
  638.     cBits = ""
  639.     nN = nNum
  640.     do while len( cBits ) < nPlaces
  641.       if nN > 0
  642.         nN = 2 * nN
  643.         cBits = cBits + str( int( nN ), 1 )
  644.         nN = nN - int( nN )
  645.       else
  646.         cBits = cBits + "0"
  647.       endif
  648.     enddo
  649.     
  650. RETURN cBits
  651. *-- Eof: Frac2Bin()
  652.  
  653. FUNCTION Num2Real
  654. *-------------------------------------------------------------------------------
  655. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  656. *-- Date........: 11/26/1992
  657. *-- Notes.......: Converts a number to the ASCII representation of
  658. *--               its storage in IEEE 4 or 8-byte real format, with least
  659. *--               significant byte (lowest in memory) first.  Provided
  660. *--               for checking the values in .MEM files, or in memory
  661. *--               float-type variables if peeking.
  662. *-- Written for.: dBASE IV Version 1.5
  663. *--               ( may be adapted to earlier versions by requiring fixed
  664. *--               number of parameters.)
  665. *-- Rev. History: 03/01/92 - original function
  666. *--               11/26/92 - revised to call Dec2Mkd(), etc., Jay Parsons
  667. *--               The parameters of the revised version are not the same
  668. *--               as those of the original.
  669. *-- Calls.......: Dec2Mkd()            Function in CONVERT.PRG
  670. *--               Dec2Mks()            Function in CONVERT.PRG
  671. *--               Dec2Hex()            Function in CONVERT.PRG
  672. *-- Called by...: Any
  673. *-- Usage.......: Num2Real(<nNum> [,<nBytes>] )
  674. *-- Example.....: ? Num2Real( 10E100, 8 )
  675. *-- Returns.....: Character string equivalent ( of a blank date, in example )
  676. *-- Parameters..: nNum = number to convert
  677. *--               nBytes = number of bytes in conversion.  Optional,
  678. *--                        will be considered 8 ( long real ) unless
  679. *--                        4 is specified.
  680. *-------------------------------------------------------------------------------
  681.     
  682.         parameters nNum, nBytes
  683.         private cStr, nB, nX, MK
  684.         nB = iif( type( "nBytes" ) = "N" .AND. nBytes = 4, 4, 8 )
  685.         declare MK[ nB ]
  686.         cStr = ""
  687.         if "" # iif( nB = 8, Dec2Mkd( nNum, "MK" ), Dec2Mks( nNum, "MK" ) )
  688.           nX = 1
  689.           do while nX <= nB
  690.             cNext = Dec2Hex( asc( MK[ nX ] ) )
  691.             cStr = cStr + right( "0" + Dec2Hex( asc( MK[ nX ] ) ), 2 ) + " "
  692.             nX = nX + 1
  693.           enddo
  694.         endif
  695.  
  696. RETURN trim( cStr )
  697. *-- Eof: Num2Real()
  698.  
  699. FUNCTION Bin2Dec
  700. *-------------------------------------------------------------------------------
  701. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  702. *-- Date........: 11/25/1992
  703. *-- Notes.......: Converts a string containing a binary value
  704. *--               to its numeric (decimal) equivalent.  Any characters
  705. *--               in the string other than "0" or "1" are ignored.
  706. *-- Written for.: dBASE IV, 1.1
  707. *-- Rev. History: 11/25/1992 -- original function
  708. *-- Calls.......: None
  709. *-- Called by...: Any
  710. *-- Usage.......: Bin2Dec( <cStr )
  711. *-- Example.....: ? Bin2Dec( "1000 0011" )
  712. *-- Returns.....: Numeric = equivalent ( 131 in example )
  713. *-- Parameters..: cStr1 = string holding binary value to convert
  714. *-------------------------------------------------------------------------------
  715.  
  716.         parameters cStr
  717.         private cLeft, cChar, nVal
  718.         nVal = 0
  719.         cLeft = cStr + "!"
  720.         do while len( cLeft ) > 1
  721.           cChar = left( cLeft, 1 )
  722.           cLeft  = substr( cLeft, 2 )
  723.           if cChar $ "01"
  724.             nVal = 2 * nVal + val( cChar )
  725.           endif
  726.         enddo
  727.  
  728. RETURN nVal
  729. *-- Eof: Bin2Dec()
  730.  
  731. FUNCTION Dec2Mkd
  732. *-------------------------------------------------------------------------------
  733. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  734. *-- Date........: 11/26/1992
  735. *-- Notes.......: Converts a numeric value to eight chr() values in array.
  736. *--               See notes to Dec2Mki().
  737. *--               Returns null string if array not declared or declared
  738. *--               with too few elements.
  739. *--               This is roughly equivalent to MKD$() in BASIC.
  740. *--               Concatenation of the array elements gives the value
  741. *--               in IEEE long real format ( low-order byte first.)
  742. *--               From high to low, the 64 bits are:
  743. *--                     1 bit sign, 1 = negative
  744. *--                    11 bits exponent base 2 + 1023
  745. *--                    23 bits mantissa with initial "1." omitted as
  746. *--                             understood.
  747. *--               dBASE uses this format for floats and dates internally
  748. *--               and in .MEM files; obviously, the dBASE float() function
  749. *--               will make the same conversion more quickly, but creates
  750. *--               difficulties in accessing the bytes as converted.
  751. *-- Written for.: dBASE IV, 1.1
  752. *-- Rev. History: 11/26/1992 -- original function
  753. *-- Calls.......: Bin2Dec()  - Function in Convert.prg
  754. *--               Dec2Bin()  - Function in Convert.prg
  755. *--               Frac2Bin() - Function in Convert.prg
  756. *-- Called by...: Any
  757. *-- Usage.......: Dec2Mkd( nVar, cName )
  758. *-- Example.....: ? Dec2Mkd( -1, "MK" )
  759. *-- Returns.....: name of array of which elements [ 1 ] - [ 8 ] contain
  760. *--               chr() values equivalent to bytes of value; or null string.
  761. *-- Parameters..: nVar  = number to convert
  762. *--               cName = name of array to use, which must be public and
  763. *--                       previously declared with enough elements
  764. *-- Side effects: Alters contents of array
  765. *-------------------------------------------------------------------------------
  766.  
  767.         parameters nVar, cName
  768.         private cStr, cBin, nVal, nExp, nMant, nX
  769.         cStr = ""
  770.         if type( "&cName.[ 8 ]" ) # "U"
  771.           cStr = cName
  772.           if nVar = 0
  773.             nX = 1
  774.             do while nX < 9
  775.               &cStr.[ nX ] = chr( 0 )
  776.               nX = nX + 1
  777.             enddo
  778.           else
  779.             cBin = iif( nVar < 0, "1", "0" )
  780.             nVal = abs( nVar )
  781.             nExp = int( log( nVar ) / log( 2 ) )
  782.             nMant = nVal / 2 ^ nExp - 1
  783.             cBin = cBin + Dec2Bin( nExp + 1023, 11 ) + Frac2Bin( nMant, 52 )
  784.             nX = 1
  785.             do while nX < 9
  786.               &cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 65 - nX * 8, 8 ) ) )
  787.               nX = nX + 1
  788.             enddo
  789.           endif
  790.         endif
  791.  
  792. RETURN cStr
  793. *-- EoF: Dec2Mkd()
  794.  
  795. FUNCTION Dec2Mki
  796. *-------------------------------------------------------------------------------
  797. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  798. *-- Date........: 11/26/1992
  799. *-- Notes.......: Converts an integer in the range -32,768 to +32,767
  800. *--               to two chr() values equivalent to the two bytes created
  801. *--               by the BASIC MKI$ function.
  802. *--                     Because of the impossibility of storing a null,
  803. *--               chr( 0 ), as a character in a dBASE string, the chr()
  804. *--               values are stored in the first two elements of an array,
  805. *--               with the low-order byte as element[ 1 ].  Array name must
  806. *--               be passed as second parameter.  Array name will
  807. *--               be returned unless the parameter is out of range or
  808. *--               array has too few elements, in which case the null
  809. *--               string is returned.
  810. *--                     Concatenation of the array elements such as by
  811. *--                 fwrite( <nHandle>,<Arrayname>[ 1 ] )
  812. *--                 fwrite( <nHandle>,<Arrayname>[ 2 ] )
  813. *--               writes the same value as the BASIC MKI$ function.
  814. *--               The same format is used by dBASE for internal storage
  815. *--               of integers within the range, and by C as a signed int.
  816. *-- Written for.: dBASE IV, 1.1
  817. *-- Rev. History: 11/26/1992 -- original function
  818. *-- Calls.......: None
  819. *-- Called by...: Any
  820. *-- Usage.......: Dec2Mki( nInt, cName )
  821. *-- Example.....: ? Dec2Mki( -1, "MK" )
  822. *-- Returns.....: name of array of which elements contain char equivalents,
  823. *--               chr( 255) and chr( 255 ) in example; or null string.
  824. *-- Parameters..: nInt = integer to convert
  825. *--               cName = name of array to use, which must be public and
  826. *--                       previously declared with enough elements
  827. *-- Side effects: Alters contents of array
  828. *-------------------------------------------------------------------------------
  829.  
  830.         parameters nInt, cName
  831.         private nVal, cStr, nX
  832.         cStr = ""
  833.         if type( "&cName.[ 2 ]" ) # "U"
  834.           cStr = cName
  835.           if nInt = int( nInt ) .AND. nInt >= -32768 .AND. nInt <= 32767
  836.             nVal = nInt + iif( nInt < 0, 65536, 0 )
  837.             nX = 1
  838.             do while nX < 3
  839.               &cStr.[ nX ] = chr( mod( nVal, 256 ) )
  840.               nVal = int( nVal / 256 )
  841.               nX = nX + 1
  842.             enddo
  843.           endif
  844.         endif
  845.  
  846. RETURN cStr
  847. *-- EoF: Dec2Mki()
  848.  
  849. FUNCTION Dec2Mkl
  850. *-------------------------------------------------------------------------------
  851. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  852. *-- Date........: 11/26/1992
  853. *-- Notes.......: Converts an integer in the range -2^31 to +2^31 - 1
  854. *--               to four chr() values in array.  See notes to Dec2Mki().
  855. *--               Returns null string if parameter is out of range or
  856. *--               array not declared or declared with too few elements.
  857. *--               This is mostly equivalent to MKL$() in BASIC.
  858. *-- Written for.: dBASE IV, 1.1
  859. *-- Rev. History: 11/26/1992 -- original function
  860. *-- Calls.......: None
  861. *-- Called by...: Any
  862. *-- Usage.......: Dec2Mkl( nInt, cName )
  863. *-- Example.....: ? Dec2Mkl( -1, "MK" )
  864. *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
  865. *--               chr() values equivalent to bytes of value; or null string.
  866. *-- Parameters..: nInt = integer to convert
  867. *--               cName = name of array to use, which must be public and
  868. *--                       previously declared with enough elements
  869. *-- Side effects: Alters contents of array
  870. *-------------------------------------------------------------------------------
  871.  
  872.         parameters nInt, cName
  873.         private nVal, cStr, nX
  874.         cStr = ""
  875.         if type( "&cName.[ 4 ]" ) # "U"
  876.           cStr = cName
  877.           if nInt = int( nInt ) .AND. nInt >= -2 ^ 31 .AND. nInt < 2 ^ 31
  878.             nVal = nInt + iif( nInt < 0, 2 ^ 32, 0 )
  879.             nX = 1
  880.             do while nX < 5
  881.               &cStr.[ nX ] = chr( mod( nVal, 256 ) )
  882.               nVal = int( nVal / 256 )
  883.               nX = nX + 1
  884.             enddo
  885.           endif
  886.         endif
  887.  
  888. RETURN cStr
  889. *-- EoF: Dec2Mkl()
  890.  
  891. FUNCTION Dec2Mks
  892. *-------------------------------------------------------------------------------
  893. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  894. *-- Date........: 11/26/1992
  895. *-- Notes.......: Converts a numeric value to four chr() values in array.
  896. *--               See notes to Dec2Mki().
  897. *--               Returns null string if array not declared or declared
  898. *--               with too few elements.
  899. *--               This is mostly equivalent to MKS$() in BASIC.
  900. *--               Concatenation of the array elements gives the value
  901. *--               in IEEE short real format ( low-order byte first.)
  902. *--               From high to low, the 32 bits are:
  903. *--                     1 bit sign, 1 = negative
  904. *--                     8 bits exponent base 2 + 127
  905. *--                    23 bits mantissa with initial "1." omitted as
  906. *--                             understood.
  907. *-- Written for.: dBASE IV, 1.1
  908. *-- Rev. History: 11/26/1992 -- original function
  909. *-- Calls.......: Bin2Dec()  - Function in Convert.prg
  910. *--               Dec2Bin()  - Function in Convert.prg
  911. *--               Frac2Bin() - Function in Convert.prg
  912. *-- Called by...: Any
  913. *-- Usage.......: Dec2Mks( nVar, cName )
  914. *-- Example.....: ? Dec2Mks( -1, "MK" )
  915. *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
  916. *--               chr() values equivalent to bytes of value; or null string.
  917. *-- Parameters..: nVar  = number to convert
  918. *--               cName = name of array to use, which must be public and
  919. *--                       previously declared with enough elements
  920. *-- Side effects: Alters contents of array
  921. *-------------------------------------------------------------------------------
  922.  
  923.         parameters nVar, cName
  924.         private cStr, cBin, nVal, nExp, nMant, nX
  925.         cStr = ""
  926.         if type( "&cName.[ 4 ]" ) # "U"
  927.           cStr = cName
  928.           if nVar = 0
  929.             nX = 1
  930.             do while nX < 5
  931.               &cStr.[ nX ] = chr( 0 )
  932.               nX = nX + 1
  933.             enddo
  934.           else
  935.             cBin = iif( nVar < 0, "1", "0" )
  936.             nVal = abs( nVar )
  937.             nExp = int( log( nVar ) / log( 2 ) )
  938.             nMant = nVal / 2 ^ nExp - 1
  939.             cBin = cBin + Dec2Bin( nExp + 127, 8 ) + Frac2Bin( nMant, 23 )
  940.             nX = 1
  941.             do while nX < 5
  942.               &cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 33 - nX * 8, 8 ) ) )
  943.               nX = nX + 1
  944.             enddo
  945.           endif
  946.         endif
  947.  
  948. RETURN cStr
  949. *-- EoF: Dec2Mks()
  950.  
  951. FUNCTION Dec2MSks
  952. *-------------------------------------------------------------------------------
  953. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  954. *-- Date........: 12/01/1992
  955. *-- Notes.......: Converts a numeric value to four chr() values in array.
  956. *--               See notes to Dec2Mki().  USES OBSOLETE MICROSOFT FORMAT.
  957. *--               Returns null string if array not declared or declared
  958. *--               with too few elements.
  959. *--               This is mostly equivalent to MKS$() in old Microsoft BASIC.
  960. *--               Concatenation of the array elements gives the value
  961. *--               as stored in old MicroSoft four-byte real format.
  962. *--               From high to low, the 32 bits are:
  963. *--                     8 bits exponent base 2 + 128
  964. *--                     1 bit sign, 1 = negative
  965. *--                    23 bits mantissa with initial ".1" omitted as
  966. *--                             understood.
  967. *-- Written for.: dBASE IV, 1.1
  968. *-- Rev. History: 12/01/1992 -- original function
  969. *-- Calls.......: Bin2Dec()  - Function in Convert.prg
  970. *--               Dec2Bin()  - Function in Convert.prg
  971. *--               Frac2Bin() - Function in Convert.prg
  972. *-- Called by...: Any
  973. *-- Usage.......: Dec2MSks( nVar, cName )
  974. *-- Example.....: ? Dec2MSks( -1, "MK" )
  975. *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
  976. *--               chr() values equivalent to bytes of value; or null string.
  977. *-- Parameters..: nVar  = number to convert
  978. *--               cName = name of array to use, which must be public and
  979. *--                       previously declared with enough elements
  980. *-- Side effects: Alters contents of array
  981. *-------------------------------------------------------------------------------
  982.  
  983.         parameters nVar, cName
  984.         private cStr, cBin, nVal, nExp, nMant, nX
  985.         cStr = ""
  986.         if type( "&cName.[ 4 ]" ) # "U"
  987.           cStr = cName
  988.           if nVar = 0
  989.             nX = 1
  990.             do while nX < 5
  991.               &cStr.[ nX ] = chr( 0 )
  992.               nX = nX + 1
  993.             enddo
  994.           else
  995.             cBin = iif( nVar < 0, "1", "0" )
  996.             nVal = abs( nVar )
  997.             nExp = int( log( nVar ) / log( 2 ) )
  998.             nMant = nVal / 2 ^ nExp - 1
  999.             cBin = Dec2Bin( nExp + 129, 8 ) + cBin + Frac2Bin( nMant, 23 )
  1000.             nX = 1
  1001.             do while nX < 5
  1002.               &cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 33 - nX * 8, 8 ) ) )
  1003.               nX = nX + 1
  1004.             enddo
  1005.           endif
  1006.         endif
  1007. RETURN cStr
  1008. *-- EoF: Dec2MSks()
  1009.  
  1010. FUNCTION Mki2Dec
  1011. *-------------------------------------------------------------------------------
  1012. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1013. *-- Date........: 11/25/1992
  1014. *-- Notes.......: Converts two bytes storing a signed short integer
  1015. *--               ( as saved by the BASIC MKI$ function, e. g. )
  1016. *--               to its numeric (decimal) equivalent.  The format
  1017. *--               accommodates values from 8000 ( -32,768 ) to
  1018. *--               7FFF ( +32,767 ); the low-order byte is stored first
  1019. *--               and is expected as the first parameter.
  1020. *--                     This is the equivalent of CVI() in BASIC.
  1021. *--                     While this could easily be modified to accept
  1022. *--               a two-character string as the parameter, dBASE and
  1023. *--               particularly fread() will have trouble with such a
  1024. *--               string that contains a null ( chr( 0 ) ).
  1025. *-- Written for.: dBASE IV, 1.1
  1026. *-- Rev. History: 11/25/1992 -- original function
  1027. *-- Calls.......: None
  1028. *-- Called by...: Any
  1029. *-- Usage.......: Mki2Dec( <c1>, <c2> )
  1030. *-- Example.....: ? Mki2Dec( chr( 255 ), chr( 255 ) )
  1031. *-- Returns.....: Numeric = equivalent ( -1 in example )
  1032. *-- Parameters..: c1, c2 = chars holding value to convert
  1033. *-------------------------------------------------------------------------------
  1034.         parameters c1, c2
  1035.         private nVal
  1036.         nVal = asc( c1 ) + 256 * asc( c2 )
  1037.         if nVal > 32767
  1038.           nVal = nVal - 65536
  1039.         endif
  1040.  
  1041. RETURN nVal
  1042. *-- EoF: Mki2Dec()
  1043.  
  1044. FUNCTION Mkl2Dec
  1045. *-------------------------------------------------------------------------------
  1046. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1047. *-- Date........: 11/26/1992
  1048. *-- Notes.......: Converts four bytes storing a signed long integer
  1049. *--               ( as saved by the BASIC MKL$ function, e. g. )
  1050. *--               to its numeric (decimal) equivalent.  The low-order
  1051. *--               byte is stored first and is expected as the first
  1052. *--               parameter.
  1053. *--                     This is the equivalent of CVL() in BASIC.
  1054. *--                     While this could easily be modified to accept
  1055. *--               a four-character string as the parameter, dBASE and
  1056. *--               particularly fread() will have trouble with such a
  1057. *--               string that contains a null ( chr( 0 ) ).
  1058. *-- Written for.: dBASE IV, 1.1
  1059. *-- Rev. History: 11/26/1992 -- original function
  1060. *-- Calls.......: None
  1061. *-- Called by...: Any
  1062. *-- Usage.......: Mkl2Dec( <c1>, <c2>, <c3>, <c4> )
  1063. *-- Example.....: ? Mkl2Dec( chr( 255 ), chr( 255 ), chr(255 ), chr( 255) )
  1064. *-- Returns.....: Numeric = equivalent ( -1 in example )
  1065. *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
  1066. *-------------------------------------------------------------------------------
  1067.  
  1068.         parameters c1, c2, c3, c4
  1069.         private nVal, nX, cVar
  1070.         nVal = 0
  1071.         nX = 4
  1072.         do while nX > 0
  1073.           cVar = "c" + str( nX, 1 )
  1074.           nVal = 256 * nVal + asc( &cVar )
  1075.           nX = nX - 1
  1076.         enddo
  1077.         if nVal >= 2 ^ 31
  1078.           nVal = nVal - 2 ^ 32
  1079.         endif
  1080.  
  1081. RETURN nVal
  1082. *-- EoF: Mkl2Dec()
  1083.  
  1084. FUNCTION Num2Str
  1085. *-------------------------------------------------------------------------------
  1086. *-- Programmer..: Angus Scott-Fleming (CIS: 75500,3223)
  1087. *-- Date........: 06/09/1992
  1088. *-- Notes.......: Converts a number to a string like str(), storing all
  1089. *--               decimal places. Does not require knowing the number of
  1090. *--               decimal places first.
  1091. *-- Written for.: dBASE IV, 1.1
  1092. *-- Rev. History: 06/09/1992 -- Angus took Jay's routine and overhauled it.
  1093. *-- Calls.......: None
  1094. *-- Called by...: Any
  1095. *-- Usage.......: Num2Str(<nNumber>)
  1096. *-- Example.....: ? Num2Str( 415.25000000000001 )
  1097. *-- Returns.....: Character = representation of number ( "415.2500000000001" 
  1098. *--                           in example )
  1099. *-- Parameters..: nNumber = number to represent
  1100. *-------------------------------------------------------------------------------
  1101.  
  1102.     parameters nNumber
  1103.     private nInteger, nFraction, cFracstr, nDec
  1104.     nInteger = int( nNumber )
  1105.     nFraction = abs( nNumber - nInteger )
  1106.     if nFraction = 0
  1107.         cFracStr = ""
  1108.     else
  1109.         *-- note that the maximum # of decimals is 18
  1110.         cFracStr = ltrim(str(nFraction,19,18))
  1111.         do while right(cFracStr,1) = "0"
  1112.           cFracstr = left(cFracStr,len(cFracStr)-1)
  1113.        enddo
  1114.     endif
  1115.     
  1116. RETURN ltrim( str( nInteger ) ) + cFracstr
  1117. *-- Eof: Num2Str()
  1118.  
  1119. FUNCTION Mkd2Dec
  1120. *-------------------------------------------------------------------------------
  1121. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1122. *-- Date........: 04/12/1993
  1123. *-- Notes.......: Converts eight bytes storing an IEEE long real value
  1124. *--               ( as saved by the BASIC MKD$ function, e. g. )
  1125. *--               to its numeric (decimal) equivalent.  As usual, the
  1126. *--               eight bytes of the value are stored low-order to high-
  1127. *--               order, and are expected as parameters in that order.
  1128. *--               From high to low, the 64 bits are:
  1129. *--                     1 bit sign, 1 = negative
  1130. *--                    11 bits exponent base 2 + 1023
  1131. *--                    52 bits mantissa with initial "1." omitted as
  1132. *--                             understood.
  1133. *--                    The function is written to require eight separate
  1134. *--               parameters rather than an eight-character string because
  1135. *--               fread() will choke on reading the value as a single
  1136. *--               string if it contains nulls ( chr( 0 ) ).
  1137. *--               This is the equivalent of CVD() in BASIC.
  1138. *-- Written for.: dBASE IV, 1.1
  1139. *-- Rev. History: 11/26/1992 -- original function
  1140. *--               04/12/1993 -- changed to work around dBASE IV 2.0 mod()
  1141. *--                             bug, Jay Parsons
  1142. *-- Calls.......: Bin2Dec() - Function in Convert.prg
  1143. *-- Called by...: Any
  1144. *-- Usage.......: Mkd2Dec( <c1>, . . . <c8> )
  1145. *-- Example.....: ? Mkd2Dec( chr( 0 ), chr( 0 ), chr( 0 ), chr( 0 ), ;
  1146. *--                     chr( 0 ), chr( 0 ), chr( 248 ), chr( 3 )
  1147. *-- Returns.....: Numeric = equivalent ( 1 in example )
  1148. *-- Parameters..: c1 . . . c8 = chars holding value to convert
  1149. *-------------------------------------------------------------------------------
  1150.         parameters c1, c2, c3, c4, c5, c6, c7, c8
  1151.         private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal, nZ
  1152.         nX = 8
  1153.         nZ = 0
  1154.         cBin = ""
  1155.         do while nX > 0
  1156.           cVar = "c" + str( nX, 1 )
  1157.           nVal = asc( &cVar )
  1158.           nZ = nZ + nVal
  1159.           nY = 7
  1160.           do while nY >=0
  1161.             cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" )
  1162.             nVal = iif( nVal = 0, 0, mod( nVal, 2 ^ nY ) )
  1163.             nY = nY - 1
  1164.           enddo
  1165.           nX = nX - 1
  1166.         enddo
  1167.         if nZ = 0
  1168.           nVal = 0
  1169.         else
  1170.           nSign = iif( left( cBin, 1 ) = "1", -1, 1 )
  1171.           nExp = Bin2Dec( substr( cBin, 2, 11) ) - 1023
  1172.           cMant = "1" + right( cBin, 52 )
  1173.           nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 52 ) * nSign
  1174.         endif
  1175.  
  1176. RETURN nVal
  1177. *-- EoF: Mkd2Dec()
  1178.  
  1179. FUNCTION Mks2Dec
  1180. *-------------------------------------------------------------------------------
  1181. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1182. *-- Date........: 04/12/1993
  1183. *-- Notes.......: Converts four bytes storing an IEEE short real value
  1184. *--               ( as saved by the BASIC MKS$ function, e. g. )
  1185. *--               to its numeric (decimal) equivalent.  As usual, the
  1186. *--               four bytes of the value are stored low-order to high-
  1187. *--               order, and are expected as parameters in that order.
  1188. *--               From high to low, the 32 bits are:
  1189. *--                     1 bit sign, 1 = negative
  1190. *--                     8 bits exponent base 2 + 127
  1191. *--                    23 bits mantissa with initial "1." omitted as
  1192. *--                             understood.
  1193. *--                    The function is written to require four separate
  1194. *--               parameters rather than a four-character string because
  1195. *--               fread() will choke on reading the value as a single
  1196. *--               string if it contains nulls ( chr( 0 ) ).
  1197. *--               This is the equivalent of CVS() in BASIC.
  1198. *-- Written for.: dBASE IV, 1.1
  1199. *-- Rev. History: 11/25/1992 -- original function
  1200. *--               04/12/1993 -- changed to work around dBASE IV 2.0 mod()
  1201. *--                             bug, Jay Parsons
  1202. *-- Calls.......: Bin2Dec() - Function in Convert.prg
  1203. *-- Called by...: Any
  1204. *-- Usage.......: Mks2Dec( <c1>, <c2>, <c3>, <c4> )
  1205. *-- Example.....: ? Mks2Dec( chr( 0 ), chr( 0 ), chr( 128 ), chr( 63 ) )
  1206. *-- Returns.....: Numeric = equivalent ( 1 in example )
  1207. *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
  1208. *-------------------------------------------------------------------------------
  1209.  
  1210.         parameters c1, c2, c3, c4
  1211.         private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal
  1212.         if asc( c1 ) + asc( c2 ) + asc( c3 ) + asc( c4 ) = 0
  1213.           nVal = 0
  1214.         else
  1215.           nX = 4
  1216.           cBin = ""
  1217.           do while nX > 0
  1218.             cVar = "c" + str( nX, 1 )
  1219.             nVal = asc( &cVar )
  1220.             nY = 7
  1221.             do while nY >=0
  1222.               cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" )
  1223.               nVal = iif( nVal = 0, 0, mod( nVal, 2 ^ nY ) )
  1224.               nY = nY - 1
  1225.             enddo
  1226.             nX = nX - 1
  1227.           enddo
  1228.           nSign = iif( left( cBin, 1 ) = "1", -1, 1 )
  1229.           nExp = Bin2Dec( substr( cBin, 2, 8 ) ) - 127
  1230.           cMant = "1" + right( cBin, 23 )
  1231.           nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 23 ) * nSign
  1232.         endif
  1233.  
  1234. RETURN nVal
  1235. *-- EoF: Mks2Dec()
  1236.  
  1237. FUNCTION MSks2Dec
  1238. *-------------------------------------------------------------------------------
  1239. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1240. *-- Date........: 04/12/1993
  1241. *-- Notes.......: Converts four bytes storing an old-style Microsoft
  1242. *--               short real value ( as saved by the BASIC MKS$ function,
  1243. *--               e. g. ) to its numeric (decimal) equivalent.  As usual,
  1244. *--               the four bytes of the value are stored low-order to high-
  1245. *--               order, and are expected as parameters in that order.
  1246. *--               From high to low, the 32 bits are:
  1247. *--                     8 bits exponent base 2 + 128
  1248. *--                     1 bit sign, 1 = negative
  1249. *--                    23 bits mantissa with initial ".1" omitted as
  1250. *--                             understood.
  1251. *--                    The function is written to require four separate
  1252. *--               parameters rather than a four-character string because
  1253. *--               fread() will choke on reading the value as a single
  1254. *--               string if it contains nulls ( chr( 0 ) ).
  1255. *--               This is the equivalent of CVS() in old Microsoft BASIC.
  1256. *-- Written for.: dBASE IV, 1.1
  1257. *-- Rev. History: 11/28/1992 -- original function
  1258. *--               04/12/1993 -- changed to work around dBASE IV 2.0 mod()
  1259. *--                             bug, Jay Parsons
  1260. *-- Calls.......: Bin2Dec() - Function in Convert.prg
  1261. *-- Called by...: Any
  1262. *-- Usage.......: MSks2Dec( <c1>, <c2>, <c3>, <c4> )
  1263. *-- Example.....: ? MSks2Dec( chr( 0 ), chr( 0 ), chr( 128 ), chr( 63 ) )
  1264. *-- Returns.....: Numeric = equivalent ( 1 in example )
  1265. *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
  1266. *-------------------------------------------------------------------------------
  1267.  
  1268.         parameters c1, c2, c3, c4
  1269.         private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal
  1270.         if asc( c1 ) + asc( c2 ) + asc( c3 ) + asc( c4 ) = 0
  1271.           nVal = 0
  1272.         else
  1273.           nX = 4
  1274.           cBin = ""
  1275.           do while nX > 0
  1276.             cVar = "c" + str( nX, 1 )
  1277.             nVal = asc( &cVar )
  1278.             nY = 7
  1279.             do while nY >=0
  1280.               cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" )
  1281.               nVal = iif( nVal = 0, 0, mod( nVal, 2 ^ nY ) )
  1282.               nY = nY - 1
  1283.             enddo
  1284.             nX = nX - 1
  1285.           enddo
  1286.           nSign = iif( substr( cBin, 9, 1 ) = "1", -1, 1 )
  1287.           nExp = Bin2Dec( left( cBin, 8 ) ) - 128
  1288.           cMant = "1" + right( cBin, 23 )
  1289.           nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 24 ) * nSign
  1290.         endif
  1291.  
  1292. RETURN nVal
  1293. *-- EoF: MSks2Dec()
  1294.  
  1295. FUNCTION Ordinal
  1296. *-------------------------------------------------------------------------------
  1297. *-- Programmer..: Jay Parsons (USSBBS, CIS 70160,340)
  1298. *-- Date........: 12/03/1992
  1299. *-- Notes.......: Returns ordinal string for a positive integer < 100.
  1300. *--               For higher numbers, use Num2Words on int( n/100 ), then
  1301. *--               use this on mod( n, 100 ) or if mod( n, 100 ) = 0, add "th" ).
  1302. *-- Written for.: dBASE IV, 1.1
  1303. *-- Rev. History: 11/19/1992 - original function
  1304. *--               12/03/1992 - Jay Parsons - changed notes and variable names,
  1305. *--                            replaced five lines with an "iif" line
  1306. *-- Calls.......: None
  1307. *-- Called by...: Any
  1308. *-- Usage.......: Ordinal( <nNum> )
  1309. *-- Example.....: ? Ordinal( 31 )          && returns "thirty-first"
  1310. *-- Returns.....: String giving ordinal value ( position ) of number, or null
  1311. *-- Parameters..: nNum = integer > 0 and < 100
  1312. *-------------------------------------------------------------------------------
  1313.  
  1314.     parameters nNum
  1315.     private cUnits, cTeens, cDecades, nRest, cOrd
  1316.     *-- 6       123456123456123456123456123456123456123456123456123456
  1317.     cUnits =   "     four  fif   six   seven eigh  nin   ten   eleventwelf "
  1318.     *-- 5       1234512345123451234512345123451234512345
  1319.     cTeens =   "    thir four fif  six  seveneigh nine  "
  1320.     cDecades = "    twen thir for  fif  six  seveneigh nine"
  1321.  
  1322.     nRest = nNum
  1323.     cOrd = ""
  1324.     if nRest # int( nRet ) .OR. nRest < 1 .OR. nRest > 99
  1325.         nRest = 0
  1326.     endif
  1327.  
  1328.     if nRest > 19
  1329.         cOrd = trim( substr( cDecades, 5 * ( int( nRest / 10 ) - 1 ), 5 ) ) ;
  1330.                + "t"
  1331.         nRest = mod( nRest, 10 )
  1332.         cOrd = cOrd + iif( nRest = 0, "ieth", "y-" )
  1333.     endif
  1334.  
  1335.     do case
  1336.         case nRest > 12
  1337.             cOrd = cOrd + trim( substr( cTeens, 5 * ( nRest - 12 ), 5 ) ) ;
  1338.                    + "teenth"
  1339.         case nRest > 3
  1340.             cOrd = cOrd + trim( substr( cUnits, 6 * ( nRest - 3 ), 6 ) ) + "th"
  1341.         case nRest > 0
  1342.             cOrd = cOrd ;
  1343.                    + trim( substr( "     first secondthird ", 6 * nRest, 6 ) )
  1344.      endcase
  1345.  
  1346. RETURN cOrd
  1347. *-- EoF() Ordinal
  1348.  
  1349. *-------------------------------------------------------------------------------
  1350. *-- EoP: CONVERT.PRG
  1351. *-------------------------------------------------------------------------------
  1352.