home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
progmisc
/
dblib201.zip
/
CONVERT.PRG
< prev
next >
Wrap
Text File
|
1993-04-19
|
54KB
|
1,352 lines
*-------------------------------------------------------------------------------
*-- Program...: CONVERT.PRG
*-- Programmer: Ken Mayer (CIS: 71333,1030)
*-- Date......: 02/23/1993
*-- Notes.....: This is a complete overhaul of the CONVERT program in LIBxxx.ZIP
*-- Jay went through it and did massive work ...
*-- For details on this file (and others in the library) see
*-- README.TXT.
*-------------------------------------------------------------------------------
FUNCTION Roman
*-------------------------------------------------------------------------------
*-- Programmer..: Nick Carlin
*-- Date........: 04/26/1992
*-- Notes.......: A function designed to return a Roman Numeral based on
*-- an Arabic Numeral input ...
*-- Written for.: dBASE III+
*-- Rev. History: 04/13/1988 - original function.
*-- 07/25/1991 - Ken Mayer - 1) modified for dBASE IV, 1.1,
*-- 2) updated to a function, and 3) the procedure
*-- GetRoman was done away with (combined into the
*-- function).
*-- 04/26/1992 - Jay Parsons - shortened (seriously ...)
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Roman(<nArabic>)
*-- Example.....: ? Roman(32)
*-- Returns.....: Roman Numeral (character string) equivalent of Arabic numeral
*-- passed to it. In example: XXXII
*-- Parameters..: nArabic = Arabic number to be converted to Roman
*-------------------------------------------------------------------------------
parameters nArabic
private cLetrs,nCount,nValue,cRoman,cGroup,nMod
cLetrs ="MWYCDMXLCIVX" && Roman digits
cRoman = "" && this is the returned value
nCount = 0 && init counter
do while nCount < 4 && loop four times, once for thousands, once
&& for each of hundreds, tens and singles
nValue = mod( int( nArabic / 10 ^ ( 3 - nCount ) ), 10 )
cGroup = substr( cLetrs, nCount * 3 + 1, 3 )
nMod = mod( nValue, 5 )
if nMod = 4
if nValue = 9 && 9
cRoman = cRoman + left( cGroup, 1 ) + right( cGroup, 1 )
else && 4
cRoman = cRoman + left( cGroup, 2 )
endif
else
if nValue > 4 && 5 - 8
cRoman = cRoman + substr( cGroup, 2, 1 )
endif
if nMod > 0 && 1 - 3 and 6 - 8
cRoman = cRoman + replicate( left( cGroup, 1 ), nMod )
endif
endif
nCount = nCount + 1
enddo && while nCounter < 4
RETURN cRoman
*-- EoF: Roman()
FUNCTION Arabic
*-------------------------------------------------------------------------------
*-- Programmer..: Ken Mayer (CIS: 71333,1030)
*-- Date........: 04/26/1992
*-- Notes.......: This function converts a Roman Numeral to an arabic one.
*-- It parses the roman numeral into an array, and checks each
*-- character ... if the previous character causes the value to
*-- subtract (for example, IX = 9, not 10) we subtract that value,
*-- and then set the previous value to 0, otherwise we would get
*-- some odd values in return.
*-- So far, it works fine.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 07/15/1991 - original function.
*-- 04/26/1992 - Jay Parsons - shortened.
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Arabic(<cRoman>)
*-- Example.....: ?Arabic("XXIV")
*-- Returns.....: Arabic number (from example, 24)
*-- Parameters..: cRoman = character string containing roman numeral to be
*-- converted.
*-------------------------------------------------------------------------------
parameters cRoman
private cRom,cLetrs,nLast,nAt,nVal,cChar,nArabic
cRom = ltrim(trim(upper(cRoman))) && convert to all caps in case ...
cLetrs = "IVXLCDMWY"
nArabic = 0
nLast = 0
do while len( cRom ) > 0
cChar = right( cRom, 1 )
nAt = at( cChar, cLetrs )
nVal= 10 ^ int( nAt/2 ) / iif(nAt/2 = int(nAt/2),2,1)
do case
case nAt = 0
nArabic = 0
exit
case nAt >= nLast
nArabic = nArabic + nVal
nLast = nAt
otherwise
if nAt/2 = int( nAt / 2 )
nArabic = 0
exit
else
nArabic = nArabic - nVal
endif
endcase
cRom = left( cRom, len( cRom ) - 1 )
enddo
RETURN nArabic
*-- EoF: Arabic()
FUNCTION Factorial
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Factorial of a number; returns -1 if number is not a
*-- positive integer.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Factorial(<nNumber>)
*-- Example.....: ? Factorial( 6 )
*-- Returns.....: Numeric = number factorial <in example, 6! or 720>
*-- Parameters..: nNumber = number for which factorial is to be determined
*-------------------------------------------------------------------------------
parameters nNumber
private nNext, nProduct
if nNumber # int( nNumber ) .or. nNumber < 1
RETURN -1
endif
nProduct = 1
nNext = nNumber
do while nNext > 1
nProduct = nProduct * nNext
nNext = nNext - 1
enddo
RETURN nProduct
*-- Eof: Factorial()
FUNCTION IsPrime
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 08/11/1992
*-- Notes.......: Returns .t. if argument is prime positive integer, or .f.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/11/92 - original function.
*-- : 08/11/92 - revised to return .T. for 2. ( Tea for two? )
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: IsPrime(<nNumber>)
*-- Example.....: ? IsPrime( 628321 )
*-- Returns.....: Logical = .t. if prime
*-- Parameters..: nNumber = positive integer to test for being prime
*-------------------------------------------------------------------------------
parameters nNumber
private nFactor, nLimit, lResult
if nNumber < 1 .or. nNumber # int( nNumber ) ;
.or. ( nNumber > 2 .AND. mod( nNumber, 2 ) = 0 )
RETURN .f.
endif
nFactor = 3
nLimit = sqrt( nNumber )
lResult = .t.
do while nFactor <= nLimit
if mod( nNumber, nFactor ) = 0
lResult = .f.
exit
endif
nFactor = nFactor + 2
enddo
RETURN lResult
*-- Eof: IsPrime()
FUNCTION BankRound
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Rounds numeric argument to given number of places,
*-- which if positive are decimal places, otherwise
*-- trailing zeroes before the decimal, in accordance
*-- with the special banker's rule that if the value
*-- lost by rounding is exactly halfway between two
*-- possible digits, the final digit expressed will be even.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: BankRound(<nNumber>,<nPlaces>)
*-- Example.....: ? BankRound( 357.725, 2 )
*-- Returns.....: Numeric = rounded value ( 357.72 in example )
*-- Parameters..: nNumber = numeric value to round
*-- nPlaces = decimal places, negative being powers of 10
*-------------------------------------------------------------------------------
parameters nNumber, nPlaces
private nTemp
nTemp = nNumber * 10 ^ nPlaces +.5
if nTemp = int( nTemp ) .and. nTemp / 2 # int( nTemp / 2 )
nTemp = nTemp - 1
endif
RETURN int( nTemp ) / 10 ^ nPlaces
*-- Eof: BankRound()
FUNCTION Dec2Hex
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Converts an unsigned integer ( in decimal notation)
*-- to a hexadecimal string
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Dec2Hex(<nDecimal>)
*-- Example.....: ? Dec2Hex( 118 )
*-- Returns.....: Character = Hexadecimal equivalent ( "F6" in example )
*-- Parameters..: nDecimal = number to convert
*-------------------------------------------------------------------------------
parameters nDecimal
private nD, cH
nD = int( nDecimal )
cH= ""
do while nD > 0
cH = substr( "0123456789ABCDEF", mod( nD, 16 ) + 1 , 1 ) + cH
nD = int( nD / 16 )
enddo
RETURN iif( "" = cH, "0", cH )
*-- Eof: Dec2Hex()
FUNCTION Hex2Dec
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 11/26/1992
*-- Notes.......: Converts a hexadecimal character string representing
*-- an unsigned integer to its numeric (decimal) equivalent
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/92 - original function.
*-- 11/26/92 - modified to eliminate usually-harmless
*-- "substring out of range" error, Jay Parsons
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Hex2Dec(<cHex>)
*-- Example.....: ? Hex2Dec( "F6" )
*-- Returns.....: Numeric = equivalent ( 118 in example )
*-- Parameters..: cHex = character string to convert
*-------------------------------------------------------------------------------
parameters cHex
private nD, cH
cH = upper( trim( ltrim ( cHex ) ) ) + "!"
nD = 0
do while len( cH ) > 1
nD = nD * 16 + at( left( cH, 1 ), "123456789ABCDEF" )
cH = substr( cH, 2 )
enddo
RETURN nD
*-- Eof: Hex2Dec()
FUNCTION Hex2Bin
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 12/01/1992
*-- Notes.......: Converts a hexadecimal character string representing
*-- an unsigned integer to its binary string equivalent
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/92 - original function.
*-- 12/01/92 - modified to eliminate usually-harmless
*-- "substring out of range" error, Jay Parsons
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Hex2Bin(<cHex>)
*-- Example.....: ? Hex2Bin( "F6" )
*-- Returns.....: Character = binary string ( "1111 0110" in example )
*-- Parameters..: cHex = character string to convert
*-------------------------------------------------------------------------------
parameters cHex
private cH, cBits, cNybbles, cVal
cH = upper( trim( ltrim( cHex ) ) ) + "!"
cBits = ""
cNybbles = "00000001001000110100010101100111" ;
+"10001001101010111100110111101111"
do while len( cH ) > 1
cVal = left( cH, 1 )
if cVal # " "
cBits = cBits + " " + substr( cNybbles, ;
at ( cVal, "123456789ABCDEF" ) * 4 + 1, 4 )
endif
cH = substr( cH, 2 )
enddo
RETURN iif( "" = cBits, "0", ltrim( cBits ) )
*-- Eof: Hex2Bin()
FUNCTION Bin2Hex
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Converts a binary character string representing
*-- an unsigned integer to its hexadecimal string equivalent
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Bin2Hex(<cBin>)
*-- Example.....: ? Bin2Hex( "1111 0110" )
*-- Returns.....: Character = hexadecimal string ( "F6" in example )
*-- Parameters..: cBin = character string to convert
*-------------------------------------------------------------------------------
parameters cBin
private cH, cBits, nBits, nBval, cNext
cBits = trim( ltrim( cBin ) )
nBits = len( cBits ) - 1
do while nBits > 0
if substr( cBits, nBits, 1 ) $ ", "
nBval = mod( 4 - mod( len( cBits ) - nBits, 4 ), 4 )
cBits = stuff( cBits, nBits, 1, replicate( "0", nBval ) )
endif
nBits = nBits - 1
enddo
cH = ""
do while "" # cBits
store 0 to nBits, nBval
do while nBits < 4
cNext = right( cBits, 1 )
nBval = nBval + iif( cNext = "1", 2 ^ nBits, 0 )
cBits = left( cBits, len( cBits ) - 1 )
if "" = cBits
exit
endif
nBits = nBits + 1
enddo
cH = substr( "0123456789ABCDEF", nBval + 1, 1 ) + cH
enddo
RETURN iif( "" = cH, "0", cH )
*-- Eof: Bin2Hex()
FUNCTION Dec2Oct
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Converts an unsigned integer to its octal string equivalent
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Dec2Oct(<nDec>)
*-- Example.....: ? Dec2Oct( 118 )
*-- Returns.....: Character = octal string ( "166" in example )
*-- Parameters..: nDec = number to convert
*-------------------------------------------------------------------------------
parameters nDec
private nD, cO
nD = int( nDec )
cO = ""
do while nD > 0
cO = substr( "01234567", mod( nD, 8 ) + 1 , 1 ) + cO
nD = int( nD / 8 )
enddo
RETURN iif( "" = cO, "0", cO )
*-- Eof: Dec2Oct()
FUNCTION Oct2Dec
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 12/01/1992
*-- Notes.......: Converts an unsigned number in octal, or its string
*-- representation, to a numeric (decimal) value
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/92 - original function.
*-- 12/01/92 - modified to eliminate usually-harmless
*-- "substring out of range" error, Jay Parsons
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Oct2Dect(<xOct>)
*-- Example.....: ? Oct2Dec( 166 )
*-- Returns.....: Numeric = decimal equivalent ( 118 in example )
*-- Parameters..: xOct = octal character string or number to convert
*-------------------------------------------------------------------------------
parameters xOct
private nD, cO, cVal
if type( "xOct" ) $ "NF"
cO = str( xOct )
else
cO = xOct
endif
cO = upper( trim( ltrim( cO ) ) ) + "!"
nD = 0
do while len( cO ) > 1
cVal = left( cO, 1 )
if cVal # " "
nD = nD * 8 + at( cVal, "1234567" )
endif
cO = substr( cO, 2 )
enddo
RETURN nD
*-- Eof: Oct2Dec()
FUNCTION Cash2Check
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Converts a number of dollars and cents to a string of words
*-- appropriate for writing checks.
*-- To correctly evaluate values over 16 decimal places,
*-- SET PRECISION TO a value larger than the default of 16
*-- before calling this function.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: NUM2WORDS() Function in CONVERT.PRG
*-- THOU2WORDS() Function in CONVERT.PRG
*-- Called by...: Any
*-- Usage.......: Cash2Check(<nCash>)
*-- Example.....: ? Cash2Check( 348.27 )
*-- Returns.....: Character string equivalent
*-- Parameters..: nCash = money value to convert
*-------------------------------------------------------------------------------
parameters nCash
private nDollars, nCents, cResult
nDollars = int( nCash )
nCents = 100 * round( nCash - nDollars, 2 )
cResult = trim( Num2Words( nDollars ) )
if left( cResult, 1 ) = "C" && deals with oversize number
RETURN cResult
endif
cResult = cResult + " dollar" + iif( nDollars # 1, "s", "" ) + " and "
if nCents # 0
RETURN cResult + Thou2Words( nCents ) + " cent" + iif( nCents # 1, "s", "" )
else
RETURN cResult + "no cents"
endif
*-- Eof: Cash2Check()
FUNCTION Num2Words
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Converts an integer to a string of words. Limited, due to
*-- 254-character limit of dBASE strings, to numbers less than
*-- 10 ^ 15
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: THOU2WORDS() Function in CONVERT.PRG
*-- Called by...: Any
*-- Usage.......: Num2Words(<nNum>)
*-- Example.....: ? Num2Words( 4321568357 )
*-- Returns.....: Character string equivalent
*-- Parameters..: nNum = numeric integer to convert
*-------------------------------------------------------------------------------
parameters nNum
private nNumleft, nScale, nGroup, cResult
nNumleft = int( nNum )
do case
case abs( nNumleft ) >= 10 ^ 15
RETURN "Cannot convert a number in or above the quadrillions."
case nNumleft = 0
RETURN "zero"
case nNumleft < 0
cResult = "minus "
nNumleft = -nNumleft
otherwise
cResult = ""
endcase
do while nNumleft > 0
nScale = int( log10( nNumleft ) / 3 )
nGroup = int( nNumleft / 10 ^ ( 3 * nScale ) )
nNumleft = mod( nNumleft, 10 ^ ( 3 * nScale ) )
cResult = cResult + Thou2Words( nGroup )
if nScale > 0
cResult = cResult + " " ;
+ trim( substr( "thousandmillion billion trillion", nScale * 8 - 7, 8 ) )
if nNumleft > 0
cResult = cResult + ", "
endif
endif
enddo
RETURN cResult
*-- Eof: Num2Words()
FUNCTION Thou2Words
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Converts a positive integer less than 1000 to a string
*-- of characters.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Thou2Words(<nNum>)
*-- Example.....: ? Thou2Words( 834 )
*-- Returns.....: Character string equivalent
*-- Parameters..: nNum = numeric integer to convert
*-------------------------------------------------------------------------------
parameters nNum
private cUnits, cTens, nN, cResult
cUnits = "one two " ;
+ "three four " ;
+ "five six " ;
+ "seven eight " ;
+ "nine ten " ;
+ "eleven twelve " ;
+ "thirteen fourteen " ;
+ "fifteen sixteen " ;
+ "seventeeneighteen " ;
+ "nineteen "
cTens = "twen thir for fif six seveneigh nine "
nN = int( nNum )
if nN = 0
RETURN "zero"
endif
cResult = ""
if nNum > 99
cResult = trim( substr(cUnits, int(nNum / 100 ) * 9 - 8, 9 ) ) + " hundred"
nN = mod( nN, 100 )
if nN = 0
RETURN cResult
else
cResult = cResult + " "
endif
endif
if nN > 19
cResult = cResult + trim( substr( cTens, int( nN / 10 ) * 5 - 9, 5 ) ) + "ty"
nN = mod( nN, 10 )
if nN = 0
RETURN cResult
else
cResult = cResult + "-"
endif
endif
RETURN cResult + trim( substr( cUnits, nN * 9 - 8, 9 ) )
*-- Eof: Thou2Words()
FUNCTION Ord
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Converts an integer to ordinal representation by adding
*-- "st", "nd", "rd" or "th" after its digit(s)
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Ord(<nNum>)
*-- Example.....: ? Ord( 11 )
*-- Returns.....: Character ordinal string equivalent ( "11th" in example )
*-- Parameters..: nNum = numeric integer to convert
*-------------------------------------------------------------------------------
parameters nNum
private nD
nD = mod( nNum, 100 ) - 1 && the -1 just happens to simplify what follows
RETURN str( nNum ) + iif( mod( nD, 10 ) > 2 .or. abs( nD - 11 ) < 2, ;
"th", substr( "stndrd", mod( nD, 10 ) * 2 + 1, 2 ) )
*-- Eof: Ord()
FUNCTION Dec2Bin
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Converts an unsigned number to a character
*-- string giving its ASCII binary representation.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Dec2Bin(<nNum>,<nPlaces>)
*-- Example.....: ? Dec2Bin( 35, 8 )
*-- Returns.....: Character binary equivalent ( "0010 0011", in example )
*-- Parameters..: nNum = number to convert
*-- nPlaces = number of binary places number is to occupy
*-------------------------------------------------------------------------------
parameters nNum, nPlaces
private cBits, nN
cBits= ""
nN = nNum
do while len(cBits) < nPlaces
if nN > 0
cBits = str( mod( nN, 2 ), 1 ) + cBits
nN = int( nN / 2 )
else
cBits = "0" +cBits
endif
enddo
RETURN cBits
*-- Eof: Dec2Bin()
FUNCTION Frac2Bin
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 03/01/1992
*-- Notes.......: Converts the fractional part of an unsigned number
*-- to a character string giving its ASCII binary representation.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/01/1992 -- Original Release
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Frac2Bin(<nNum>,<nPlaces>)
*-- Example.....: ? Frac2Bin( .35, 8 )
*-- Returns.....: Character binary equivalent
*-- Parameters..: nNum = number to convert
*-- nPlaces = number of binary places number is to occupy
*-------------------------------------------------------------------------------
parameters nNum, nPlaces
private cBits, nN
cBits = ""
nN = nNum
do while len( cBits ) < nPlaces
if nN > 0
nN = 2 * nN
cBits = cBits + str( int( nN ), 1 )
nN = nN - int( nN )
else
cBits = cBits + "0"
endif
enddo
RETURN cBits
*-- Eof: Frac2Bin()
FUNCTION Num2Real
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 11/26/1992
*-- Notes.......: Converts a number to the ASCII representation of
*-- its storage in IEEE 4 or 8-byte real format, with least
*-- significant byte (lowest in memory) first. Provided
*-- for checking the values in .MEM files, or in memory
*-- float-type variables if peeking.
*-- Written for.: dBASE IV Version 1.5
*-- ( may be adapted to earlier versions by requiring fixed
*-- number of parameters.)
*-- Rev. History: 03/01/92 - original function
*-- 11/26/92 - revised to call Dec2Mkd(), etc., Jay Parsons
*-- The parameters of the revised version are not the same
*-- as those of the original.
*-- Calls.......: Dec2Mkd() Function in CONVERT.PRG
*-- Dec2Mks() Function in CONVERT.PRG
*-- Dec2Hex() Function in CONVERT.PRG
*-- Called by...: Any
*-- Usage.......: Num2Real(<nNum> [,<nBytes>] )
*-- Example.....: ? Num2Real( 10E100, 8 )
*-- Returns.....: Character string equivalent ( of a blank date, in example )
*-- Parameters..: nNum = number to convert
*-- nBytes = number of bytes in conversion. Optional,
*-- will be considered 8 ( long real ) unless
*-- 4 is specified.
*-------------------------------------------------------------------------------
parameters nNum, nBytes
private cStr, nB, nX, MK
nB = iif( type( "nBytes" ) = "N" .AND. nBytes = 4, 4, 8 )
declare MK[ nB ]
cStr = ""
if "" # iif( nB = 8, Dec2Mkd( nNum, "MK" ), Dec2Mks( nNum, "MK" ) )
nX = 1
do while nX <= nB
cNext = Dec2Hex( asc( MK[ nX ] ) )
cStr = cStr + right( "0" + Dec2Hex( asc( MK[ nX ] ) ), 2 ) + " "
nX = nX + 1
enddo
endif
RETURN trim( cStr )
*-- Eof: Num2Real()
FUNCTION Bin2Dec
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 11/25/1992
*-- Notes.......: Converts a string containing a binary value
*-- to its numeric (decimal) equivalent. Any characters
*-- in the string other than "0" or "1" are ignored.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/25/1992 -- original function
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Bin2Dec( <cStr )
*-- Example.....: ? Bin2Dec( "1000 0011" )
*-- Returns.....: Numeric = equivalent ( 131 in example )
*-- Parameters..: cStr1 = string holding binary value to convert
*-------------------------------------------------------------------------------
parameters cStr
private cLeft, cChar, nVal
nVal = 0
cLeft = cStr + "!"
do while len( cLeft ) > 1
cChar = left( cLeft, 1 )
cLeft = substr( cLeft, 2 )
if cChar $ "01"
nVal = 2 * nVal + val( cChar )
endif
enddo
RETURN nVal
*-- Eof: Bin2Dec()
FUNCTION Dec2Mkd
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 11/26/1992
*-- Notes.......: Converts a numeric value to eight chr() values in array.
*-- See notes to Dec2Mki().
*-- Returns null string if array not declared or declared
*-- with too few elements.
*-- This is roughly equivalent to MKD$() in BASIC.
*-- Concatenation of the array elements gives the value
*-- in IEEE long real format ( low-order byte first.)
*-- From high to low, the 64 bits are:
*-- 1 bit sign, 1 = negative
*-- 11 bits exponent base 2 + 1023
*-- 23 bits mantissa with initial "1." omitted as
*-- understood.
*-- dBASE uses this format for floats and dates internally
*-- and in .MEM files; obviously, the dBASE float() function
*-- will make the same conversion more quickly, but creates
*-- difficulties in accessing the bytes as converted.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/26/1992 -- original function
*-- Calls.......: Bin2Dec() - Function in Convert.prg
*-- Dec2Bin() - Function in Convert.prg
*-- Frac2Bin() - Function in Convert.prg
*-- Called by...: Any
*-- Usage.......: Dec2Mkd( nVar, cName )
*-- Example.....: ? Dec2Mkd( -1, "MK" )
*-- Returns.....: name of array of which elements [ 1 ] - [ 8 ] contain
*-- chr() values equivalent to bytes of value; or null string.
*-- Parameters..: nVar = number to convert
*-- cName = name of array to use, which must be public and
*-- previously declared with enough elements
*-- Side effects: Alters contents of array
*-------------------------------------------------------------------------------
parameters nVar, cName
private cStr, cBin, nVal, nExp, nMant, nX
cStr = ""
if type( "&cName.[ 8 ]" ) # "U"
cStr = cName
if nVar = 0
nX = 1
do while nX < 9
&cStr.[ nX ] = chr( 0 )
nX = nX + 1
enddo
else
cBin = iif( nVar < 0, "1", "0" )
nVal = abs( nVar )
nExp = int( log( nVar ) / log( 2 ) )
nMant = nVal / 2 ^ nExp - 1
cBin = cBin + Dec2Bin( nExp + 1023, 11 ) + Frac2Bin( nMant, 52 )
nX = 1
do while nX < 9
&cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 65 - nX * 8, 8 ) ) )
nX = nX + 1
enddo
endif
endif
RETURN cStr
*-- EoF: Dec2Mkd()
FUNCTION Dec2Mki
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 11/26/1992
*-- Notes.......: Converts an integer in the range -32,768 to +32,767
*-- to two chr() values equivalent to the two bytes created
*-- by the BASIC MKI$ function.
*-- Because of the impossibility of storing a null,
*-- chr( 0 ), as a character in a dBASE string, the chr()
*-- values are stored in the first two elements of an array,
*-- with the low-order byte as element[ 1 ]. Array name must
*-- be passed as second parameter. Array name will
*-- be returned unless the parameter is out of range or
*-- array has too few elements, in which case the null
*-- string is returned.
*-- Concatenation of the array elements such as by
*-- fwrite( <nHandle>,<Arrayname>[ 1 ] )
*-- fwrite( <nHandle>,<Arrayname>[ 2 ] )
*-- writes the same value as the BASIC MKI$ function.
*-- The same format is used by dBASE for internal storage
*-- of integers within the range, and by C as a signed int.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/26/1992 -- original function
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Dec2Mki( nInt, cName )
*-- Example.....: ? Dec2Mki( -1, "MK" )
*-- Returns.....: name of array of which elements contain char equivalents,
*-- chr( 255) and chr( 255 ) in example; or null string.
*-- Parameters..: nInt = integer to convert
*-- cName = name of array to use, which must be public and
*-- previously declared with enough elements
*-- Side effects: Alters contents of array
*-------------------------------------------------------------------------------
parameters nInt, cName
private nVal, cStr, nX
cStr = ""
if type( "&cName.[ 2 ]" ) # "U"
cStr = cName
if nInt = int( nInt ) .AND. nInt >= -32768 .AND. nInt <= 32767
nVal = nInt + iif( nInt < 0, 65536, 0 )
nX = 1
do while nX < 3
&cStr.[ nX ] = chr( mod( nVal, 256 ) )
nVal = int( nVal / 256 )
nX = nX + 1
enddo
endif
endif
RETURN cStr
*-- EoF: Dec2Mki()
FUNCTION Dec2Mkl
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 11/26/1992
*-- Notes.......: Converts an integer in the range -2^31 to +2^31 - 1
*-- to four chr() values in array. See notes to Dec2Mki().
*-- Returns null string if parameter is out of range or
*-- array not declared or declared with too few elements.
*-- This is mostly equivalent to MKL$() in BASIC.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/26/1992 -- original function
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Dec2Mkl( nInt, cName )
*-- Example.....: ? Dec2Mkl( -1, "MK" )
*-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
*-- chr() values equivalent to bytes of value; or null string.
*-- Parameters..: nInt = integer to convert
*-- cName = name of array to use, which must be public and
*-- previously declared with enough elements
*-- Side effects: Alters contents of array
*-------------------------------------------------------------------------------
parameters nInt, cName
private nVal, cStr, nX
cStr = ""
if type( "&cName.[ 4 ]" ) # "U"
cStr = cName
if nInt = int( nInt ) .AND. nInt >= -2 ^ 31 .AND. nInt < 2 ^ 31
nVal = nInt + iif( nInt < 0, 2 ^ 32, 0 )
nX = 1
do while nX < 5
&cStr.[ nX ] = chr( mod( nVal, 256 ) )
nVal = int( nVal / 256 )
nX = nX + 1
enddo
endif
endif
RETURN cStr
*-- EoF: Dec2Mkl()
FUNCTION Dec2Mks
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 11/26/1992
*-- Notes.......: Converts a numeric value to four chr() values in array.
*-- See notes to Dec2Mki().
*-- Returns null string if array not declared or declared
*-- with too few elements.
*-- This is mostly equivalent to MKS$() in BASIC.
*-- Concatenation of the array elements gives the value
*-- in IEEE short real format ( low-order byte first.)
*-- From high to low, the 32 bits are:
*-- 1 bit sign, 1 = negative
*-- 8 bits exponent base 2 + 127
*-- 23 bits mantissa with initial "1." omitted as
*-- understood.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/26/1992 -- original function
*-- Calls.......: Bin2Dec() - Function in Convert.prg
*-- Dec2Bin() - Function in Convert.prg
*-- Frac2Bin() - Function in Convert.prg
*-- Called by...: Any
*-- Usage.......: Dec2Mks( nVar, cName )
*-- Example.....: ? Dec2Mks( -1, "MK" )
*-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
*-- chr() values equivalent to bytes of value; or null string.
*-- Parameters..: nVar = number to convert
*-- cName = name of array to use, which must be public and
*-- previously declared with enough elements
*-- Side effects: Alters contents of array
*-------------------------------------------------------------------------------
parameters nVar, cName
private cStr, cBin, nVal, nExp, nMant, nX
cStr = ""
if type( "&cName.[ 4 ]" ) # "U"
cStr = cName
if nVar = 0
nX = 1
do while nX < 5
&cStr.[ nX ] = chr( 0 )
nX = nX + 1
enddo
else
cBin = iif( nVar < 0, "1", "0" )
nVal = abs( nVar )
nExp = int( log( nVar ) / log( 2 ) )
nMant = nVal / 2 ^ nExp - 1
cBin = cBin + Dec2Bin( nExp + 127, 8 ) + Frac2Bin( nMant, 23 )
nX = 1
do while nX < 5
&cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 33 - nX * 8, 8 ) ) )
nX = nX + 1
enddo
endif
endif
RETURN cStr
*-- EoF: Dec2Mks()
FUNCTION Dec2MSks
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 12/01/1992
*-- Notes.......: Converts a numeric value to four chr() values in array.
*-- See notes to Dec2Mki(). USES OBSOLETE MICROSOFT FORMAT.
*-- Returns null string if array not declared or declared
*-- with too few elements.
*-- This is mostly equivalent to MKS$() in old Microsoft BASIC.
*-- Concatenation of the array elements gives the value
*-- as stored in old MicroSoft four-byte real format.
*-- From high to low, the 32 bits are:
*-- 8 bits exponent base 2 + 128
*-- 1 bit sign, 1 = negative
*-- 23 bits mantissa with initial ".1" omitted as
*-- understood.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 12/01/1992 -- original function
*-- Calls.......: Bin2Dec() - Function in Convert.prg
*-- Dec2Bin() - Function in Convert.prg
*-- Frac2Bin() - Function in Convert.prg
*-- Called by...: Any
*-- Usage.......: Dec2MSks( nVar, cName )
*-- Example.....: ? Dec2MSks( -1, "MK" )
*-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
*-- chr() values equivalent to bytes of value; or null string.
*-- Parameters..: nVar = number to convert
*-- cName = name of array to use, which must be public and
*-- previously declared with enough elements
*-- Side effects: Alters contents of array
*-------------------------------------------------------------------------------
parameters nVar, cName
private cStr, cBin, nVal, nExp, nMant, nX
cStr = ""
if type( "&cName.[ 4 ]" ) # "U"
cStr = cName
if nVar = 0
nX = 1
do while nX < 5
&cStr.[ nX ] = chr( 0 )
nX = nX + 1
enddo
else
cBin = iif( nVar < 0, "1", "0" )
nVal = abs( nVar )
nExp = int( log( nVar ) / log( 2 ) )
nMant = nVal / 2 ^ nExp - 1
cBin = Dec2Bin( nExp + 129, 8 ) + cBin + Frac2Bin( nMant, 23 )
nX = 1
do while nX < 5
&cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 33 - nX * 8, 8 ) ) )
nX = nX + 1
enddo
endif
endif
RETURN cStr
*-- EoF: Dec2MSks()
FUNCTION Mki2Dec
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 11/25/1992
*-- Notes.......: Converts two bytes storing a signed short integer
*-- ( as saved by the BASIC MKI$ function, e. g. )
*-- to its numeric (decimal) equivalent. The format
*-- accommodates values from 8000 ( -32,768 ) to
*-- 7FFF ( +32,767 ); the low-order byte is stored first
*-- and is expected as the first parameter.
*-- This is the equivalent of CVI() in BASIC.
*-- While this could easily be modified to accept
*-- a two-character string as the parameter, dBASE and
*-- particularly fread() will have trouble with such a
*-- string that contains a null ( chr( 0 ) ).
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/25/1992 -- original function
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Mki2Dec( <c1>, <c2> )
*-- Example.....: ? Mki2Dec( chr( 255 ), chr( 255 ) )
*-- Returns.....: Numeric = equivalent ( -1 in example )
*-- Parameters..: c1, c2 = chars holding value to convert
*-------------------------------------------------------------------------------
parameters c1, c2
private nVal
nVal = asc( c1 ) + 256 * asc( c2 )
if nVal > 32767
nVal = nVal - 65536
endif
RETURN nVal
*-- EoF: Mki2Dec()
FUNCTION Mkl2Dec
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 11/26/1992
*-- Notes.......: Converts four bytes storing a signed long integer
*-- ( as saved by the BASIC MKL$ function, e. g. )
*-- to its numeric (decimal) equivalent. The low-order
*-- byte is stored first and is expected as the first
*-- parameter.
*-- This is the equivalent of CVL() in BASIC.
*-- While this could easily be modified to accept
*-- a four-character string as the parameter, dBASE and
*-- particularly fread() will have trouble with such a
*-- string that contains a null ( chr( 0 ) ).
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/26/1992 -- original function
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Mkl2Dec( <c1>, <c2>, <c3>, <c4> )
*-- Example.....: ? Mkl2Dec( chr( 255 ), chr( 255 ), chr(255 ), chr( 255) )
*-- Returns.....: Numeric = equivalent ( -1 in example )
*-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
*-------------------------------------------------------------------------------
parameters c1, c2, c3, c4
private nVal, nX, cVar
nVal = 0
nX = 4
do while nX > 0
cVar = "c" + str( nX, 1 )
nVal = 256 * nVal + asc( &cVar )
nX = nX - 1
enddo
if nVal >= 2 ^ 31
nVal = nVal - 2 ^ 32
endif
RETURN nVal
*-- EoF: Mkl2Dec()
FUNCTION Num2Str
*-------------------------------------------------------------------------------
*-- Programmer..: Angus Scott-Fleming (CIS: 75500,3223)
*-- Date........: 06/09/1992
*-- Notes.......: Converts a number to a string like str(), storing all
*-- decimal places. Does not require knowing the number of
*-- decimal places first.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 06/09/1992 -- Angus took Jay's routine and overhauled it.
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Num2Str(<nNumber>)
*-- Example.....: ? Num2Str( 415.25000000000001 )
*-- Returns.....: Character = representation of number ( "415.2500000000001"
*-- in example )
*-- Parameters..: nNumber = number to represent
*-------------------------------------------------------------------------------
parameters nNumber
private nInteger, nFraction, cFracstr, nDec
nInteger = int( nNumber )
nFraction = abs( nNumber - nInteger )
if nFraction = 0
cFracStr = ""
else
*-- note that the maximum # of decimals is 18
cFracStr = ltrim(str(nFraction,19,18))
do while right(cFracStr,1) = "0"
cFracstr = left(cFracStr,len(cFracStr)-1)
enddo
endif
RETURN ltrim( str( nInteger ) ) + cFracstr
*-- Eof: Num2Str()
FUNCTION Mkd2Dec
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 04/12/1993
*-- Notes.......: Converts eight bytes storing an IEEE long real value
*-- ( as saved by the BASIC MKD$ function, e. g. )
*-- to its numeric (decimal) equivalent. As usual, the
*-- eight bytes of the value are stored low-order to high-
*-- order, and are expected as parameters in that order.
*-- From high to low, the 64 bits are:
*-- 1 bit sign, 1 = negative
*-- 11 bits exponent base 2 + 1023
*-- 52 bits mantissa with initial "1." omitted as
*-- understood.
*-- The function is written to require eight separate
*-- parameters rather than an eight-character string because
*-- fread() will choke on reading the value as a single
*-- string if it contains nulls ( chr( 0 ) ).
*-- This is the equivalent of CVD() in BASIC.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/26/1992 -- original function
*-- 04/12/1993 -- changed to work around dBASE IV 2.0 mod()
*-- bug, Jay Parsons
*-- Calls.......: Bin2Dec() - Function in Convert.prg
*-- Called by...: Any
*-- Usage.......: Mkd2Dec( <c1>, . . . <c8> )
*-- Example.....: ? Mkd2Dec( chr( 0 ), chr( 0 ), chr( 0 ), chr( 0 ), ;
*-- chr( 0 ), chr( 0 ), chr( 248 ), chr( 3 )
*-- Returns.....: Numeric = equivalent ( 1 in example )
*-- Parameters..: c1 . . . c8 = chars holding value to convert
*-------------------------------------------------------------------------------
parameters c1, c2, c3, c4, c5, c6, c7, c8
private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal, nZ
nX = 8
nZ = 0
cBin = ""
do while nX > 0
cVar = "c" + str( nX, 1 )
nVal = asc( &cVar )
nZ = nZ + nVal
nY = 7
do while nY >=0
cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" )
nVal = iif( nVal = 0, 0, mod( nVal, 2 ^ nY ) )
nY = nY - 1
enddo
nX = nX - 1
enddo
if nZ = 0
nVal = 0
else
nSign = iif( left( cBin, 1 ) = "1", -1, 1 )
nExp = Bin2Dec( substr( cBin, 2, 11) ) - 1023
cMant = "1" + right( cBin, 52 )
nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 52 ) * nSign
endif
RETURN nVal
*-- EoF: Mkd2Dec()
FUNCTION Mks2Dec
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 04/12/1993
*-- Notes.......: Converts four bytes storing an IEEE short real value
*-- ( as saved by the BASIC MKS$ function, e. g. )
*-- to its numeric (decimal) equivalent. As usual, the
*-- four bytes of the value are stored low-order to high-
*-- order, and are expected as parameters in that order.
*-- From high to low, the 32 bits are:
*-- 1 bit sign, 1 = negative
*-- 8 bits exponent base 2 + 127
*-- 23 bits mantissa with initial "1." omitted as
*-- understood.
*-- The function is written to require four separate
*-- parameters rather than a four-character string because
*-- fread() will choke on reading the value as a single
*-- string if it contains nulls ( chr( 0 ) ).
*-- This is the equivalent of CVS() in BASIC.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/25/1992 -- original function
*-- 04/12/1993 -- changed to work around dBASE IV 2.0 mod()
*-- bug, Jay Parsons
*-- Calls.......: Bin2Dec() - Function in Convert.prg
*-- Called by...: Any
*-- Usage.......: Mks2Dec( <c1>, <c2>, <c3>, <c4> )
*-- Example.....: ? Mks2Dec( chr( 0 ), chr( 0 ), chr( 128 ), chr( 63 ) )
*-- Returns.....: Numeric = equivalent ( 1 in example )
*-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
*-------------------------------------------------------------------------------
parameters c1, c2, c3, c4
private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal
if asc( c1 ) + asc( c2 ) + asc( c3 ) + asc( c4 ) = 0
nVal = 0
else
nX = 4
cBin = ""
do while nX > 0
cVar = "c" + str( nX, 1 )
nVal = asc( &cVar )
nY = 7
do while nY >=0
cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" )
nVal = iif( nVal = 0, 0, mod( nVal, 2 ^ nY ) )
nY = nY - 1
enddo
nX = nX - 1
enddo
nSign = iif( left( cBin, 1 ) = "1", -1, 1 )
nExp = Bin2Dec( substr( cBin, 2, 8 ) ) - 127
cMant = "1" + right( cBin, 23 )
nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 23 ) * nSign
endif
RETURN nVal
*-- EoF: Mks2Dec()
FUNCTION MSks2Dec
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (CIS: 70160,340)
*-- Date........: 04/12/1993
*-- Notes.......: Converts four bytes storing an old-style Microsoft
*-- short real value ( as saved by the BASIC MKS$ function,
*-- e. g. ) to its numeric (decimal) equivalent. As usual,
*-- the four bytes of the value are stored low-order to high-
*-- order, and are expected as parameters in that order.
*-- From high to low, the 32 bits are:
*-- 8 bits exponent base 2 + 128
*-- 1 bit sign, 1 = negative
*-- 23 bits mantissa with initial ".1" omitted as
*-- understood.
*-- The function is written to require four separate
*-- parameters rather than a four-character string because
*-- fread() will choke on reading the value as a single
*-- string if it contains nulls ( chr( 0 ) ).
*-- This is the equivalent of CVS() in old Microsoft BASIC.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/28/1992 -- original function
*-- 04/12/1993 -- changed to work around dBASE IV 2.0 mod()
*-- bug, Jay Parsons
*-- Calls.......: Bin2Dec() - Function in Convert.prg
*-- Called by...: Any
*-- Usage.......: MSks2Dec( <c1>, <c2>, <c3>, <c4> )
*-- Example.....: ? MSks2Dec( chr( 0 ), chr( 0 ), chr( 128 ), chr( 63 ) )
*-- Returns.....: Numeric = equivalent ( 1 in example )
*-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
*-------------------------------------------------------------------------------
parameters c1, c2, c3, c4
private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal
if asc( c1 ) + asc( c2 ) + asc( c3 ) + asc( c4 ) = 0
nVal = 0
else
nX = 4
cBin = ""
do while nX > 0
cVar = "c" + str( nX, 1 )
nVal = asc( &cVar )
nY = 7
do while nY >=0
cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" )
nVal = iif( nVal = 0, 0, mod( nVal, 2 ^ nY ) )
nY = nY - 1
enddo
nX = nX - 1
enddo
nSign = iif( substr( cBin, 9, 1 ) = "1", -1, 1 )
nExp = Bin2Dec( left( cBin, 8 ) ) - 128
cMant = "1" + right( cBin, 23 )
nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 24 ) * nSign
endif
RETURN nVal
*-- EoF: MSks2Dec()
FUNCTION Ordinal
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (USSBBS, CIS 70160,340)
*-- Date........: 12/03/1992
*-- Notes.......: Returns ordinal string for a positive integer < 100.
*-- For higher numbers, use Num2Words on int( n/100 ), then
*-- use this on mod( n, 100 ) or if mod( n, 100 ) = 0, add "th" ).
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 11/19/1992 - original function
*-- 12/03/1992 - Jay Parsons - changed notes and variable names,
*-- replaced five lines with an "iif" line
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Ordinal( <nNum> )
*-- Example.....: ? Ordinal( 31 ) && returns "thirty-first"
*-- Returns.....: String giving ordinal value ( position ) of number, or null
*-- Parameters..: nNum = integer > 0 and < 100
*-------------------------------------------------------------------------------
parameters nNum
private cUnits, cTeens, cDecades, nRest, cOrd
*-- 6 123456123456123456123456123456123456123456123456123456
cUnits = " four fif six seven eigh nin ten eleventwelf "
*-- 5 1234512345123451234512345123451234512345
cTeens = " thir four fif six seveneigh nine "
cDecades = " twen thir for fif six seveneigh nine"
nRest = nNum
cOrd = ""
if nRest # int( nRet ) .OR. nRest < 1 .OR. nRest > 99
nRest = 0
endif
if nRest > 19
cOrd = trim( substr( cDecades, 5 * ( int( nRest / 10 ) - 1 ), 5 ) ) ;
+ "t"
nRest = mod( nRest, 10 )
cOrd = cOrd + iif( nRest = 0, "ieth", "y-" )
endif
do case
case nRest > 12
cOrd = cOrd + trim( substr( cTeens, 5 * ( nRest - 12 ), 5 ) ) ;
+ "teenth"
case nRest > 3
cOrd = cOrd + trim( substr( cUnits, 6 * ( nRest - 3 ), 6 ) ) + "th"
case nRest > 0
cOrd = cOrd ;
+ trim( substr( " first secondthird ", 6 * nRest, 6 ) )
endcase
RETURN cOrd
*-- EoF() Ordinal
*-------------------------------------------------------------------------------
*-- EoP: CONVERT.PRG
*-------------------------------------------------------------------------------