Tweet
DECLARE FUNCTION PxGetMONEY$ (BYVAL a##, BYVAL chars&, BYVAL DEC&, BYVAL fchr&)
' a## may be passed as a%,a!,a#,a##,[email protected],[email protected]@
DECLARE FUNCTION PxNumberDesc$ (Number$,BYVAL [email protected]@)
' [email protected]@ may be passed as a%,a!,a#,a##,[email protected],[email protected]@
FUNCTION PBMAIN() AS LONG
COLOR 15,1 ' some example code
CLS
a#=12345.6
PRINT PxGetMoney$(a#,10,2,32) ' 10 chars long, 2 dec places, space fille
PRINT PxGetMoney$(a#,-1,2,32) ' return string not padded
PRINT PxGetMoney$(a#,10,2,42) '42=check protection with ****xxx.xx**
PRINT PxNumberDesc$("",a#) ' pass value not string
PRINT PxNumberDesc$(PxGetMoney$(a#,10,2,42),a#) ' pass string not value
PRINT PxNumberDesc$("akdd123982.346kxx",0) 'pass a bad string
PRINT PxNumberDesc$("akddkxx",0) 'pass a real bad string
PRINT PxGetMoney$(a#/9,10,4,32) ' get 4 dec places
PRINT PxGetMoney$(a#/900,-1,8,32) ' get 8 dec places,-1=forces full result
PRINT PxGetMoney$(a#/900,20,10,32)
a#=.3 ' small change
PRINT PxGetMoney$(a#,10,2,32)
PRINT PxGetMoney$(a#,10,2,42) ' check protect
PRINT PxNumberDesc$("",a#)
LINE INPUT "Press <cr> ";kk$
END FUNCTION
FUNCTION PxGetMONEY$ (BYVAL a##, BYVAL chars&, BYVAL DEC&, BYVAL fchr&)
LOCAL c$,rsp$
SFORMAT$ = "########################"
IF fchr& = 0 THEN fchr& = 32
IF DEC& THEN SFORMAT$ = SFORMAT$ + LEFT$(".##########", DEC& + 1)
rsp$=RIGHT$(SPACE$(LEN(Sformat$))+FORMAT$(a##,sformat$),LEN(sformat$))
IF DEC& AND (VAL(rsp$) >= 0 AND VAL(rsp$) < 1) THEN
rsp$ = SPACE$(24) + RIGHT$(rsp$, DEC& + 1)
END IF
c$="":IF fchr&=42 THEN c$="**"
PxGetMoney$ = RIGHT$(STRING$(chars&,fchr&)+LTRIM$(rsp$), chars&)+c$
END FUNCTION
FUNCTION PxNumberDesc$ (Number$,BYVAL [email protected]@)
' either pass number$ string or number$ as null
' if number$ is null, then function will use [email protected]@
LOCAL Work$,ThisPart$,Temp$,Value&,Pass&,[email protected]@,n1&
IF LEN(number$) THEN [email protected]@=VAL(MID$(number$,INSTR(1,number$,ANY "0123456789."))) ELSE [email protected]@[email protected]@
Work$=TRIM$(STR$([email protected]@,18))
N1& = INSTR(1, Work$,".") 'Make sure two decimal places
IF N1& THEN Work$ = LEFT$(Work$ + "00", N1& + 2) ELSE Work$ = Work$ + ".00"
IF VAL(Work$) = 0 THEN Temp$ = "Void Void Void Void":GOTO MoneyEnd
DO
Pass& = Pass& + 1 'So we know what multiplier
IF Pass& = 1 THEN ' to use.
Value& = VAL(RIGHT$(Work$, 2)) 'This handles the decimal
IF Value& = 0 THEN ' portion (cents).
ThisPart$ = "NO"
ELSE
ThisPart$=MID$(STR$(Value&),2)
END IF
Temp$ = "and " + ThisPart$ + "/100" 'Build the string
Work$ = LEFT$(Work$, LEN(Work$) - 3) 'Truncate our Work$
IF Work$="" THEN temp$="No Dollars "+Temp$
ELSE
Value& = VAL(RIGHT$(Work$, 3)) 'Works with $ portion of
SSSLen& = LEN(Work$) 'the amount, three digits
IF SSSLen& >= 3 THEN 'at a time.
Work$ = LEFT$(Work$, LEN(Work$) - 3)
ELSE
Work$ = ""
END IF
IF Value& THEN 'If non-zero then get the
GOSUB ThreeDigits 'description for this part.
SELECT CASE Pass& 'What multiplier to use?
CASE 3 'Thousands
Multiplier$ = " thousand "
CASE 4 'Millions
Multiplier$ = " million "
CASE 5 'Billions
Multiplier$ = " billion " 'If you need multipliers
CASE 6 'greater than a trillion, add
Multiplier$ = " trillion " 'another CASE here.
CASE ELSE
Multiplier$ = " "
END SELECT
'Put it all together.
Temp$ = ThisPart$ + Multiplier$ + Temp$
END IF
END IF
LOOP WHILE LEN(Work$) 'Keep looping until Work$=""
MoneyEnd:
'Make first letter upper-case
Temp$=UCASE$(LEFT$(temp$,1))+MID$(Temp$,2)
PxNumberDesc$ = Temp$
EXIT FUNCTION
ThreeDigits:
'Words for three digit number in Value& to string
ThisPart$ = ""
IF Value& >= 100 THEN 'How many hundreds?
N1& = Value& MOD 100
ThisPart$ = READ$((Value& - N1&) \ 100) + " hundred "
Value& = N1&
END IF
IF Value& > 20 THEN 'How many tens above 20?
N1& = Value& MOD 10
ThisPart$ = ThisPart$ + READ$(((Value& - N1&) \ 10) + 18)
Value& = N1&
IF Value& > 0 THEN
ThisPart$ = ThisPart$ + "-"
END IF
END IF
IF Value& > 0 THEN
ThisPart$ = ThisPart$ + READ$(Value&) 'How many ones?
END IF
RETURN
MoneyData:
DATA one,two,three,four,five,six,seven,eight,nine,ten
DATA eleven,twelve,thirteen,fourteen,fifteen,sixteen,seventeen,eighteen
DATA nineteen,twenty,thirty,forty,fifty,sixty,seventy,eighty,ninety
END FUNCTION
Comment