Announcement

Collapse
No announcement yet.

Writing Checks

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Phil Tippit
    replied
    Keith,

    Here are two functions which should help.
    I have them in a PBDLL but they work in PBCC or PBDOS

    Phil

    Code:
    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
    ------------------

    Leave a comment:


  • Lance Edmonds
    replied
    this bbs holds a host of all sorts of free code in the 30,000+ messages...

    take a look at:
    http://www.powerbasic.com/support/pb...ad.php?t=18337



    ------------------
    lance
    powerbasic support
    mailto:[email protected][email protected]</a>

    Leave a comment:


  • Keith E. Black
    started a topic Writing Checks

    Writing Checks

    Does any one know of any code snippet that I can use to write the check amount out in words. I have started doing this one number at a time, but there must be a better way.
    Please Help.
    Thanks, Keith

    ------------------
Working...
X