[Liberty BASIC] getallen voluit schrijven

[anoniem]

Naar aanleiding van een vraag of er een functie bestaat in VB om getallen uit te schrijven, heb ik in Liberty BASIC een programma uit 1981 bewerkt. [code:1:86f23b69da]'mei 2006 Abcott 'uit een oud tijdschrift DIM G(20),A$(33) FOR N = 1 TO 33:READ dummy$ :A$(N) = dummy$ :NEXT DATA "EEN","TWEE","DRIE","VIER","VIJF","ZES","ZEVEN","ACHT","NEGEN" DATA "TIEN","ELF","TWAALF","DERTIEN","VEERTIEN","VIJFTIEN","ZESTIEN" DATA "ZEVENTIEN","ACHTTIEN","NEGENTIEN","TWINTIG","DERTIG","VEERTIG" DATA "VIJFTIG","ZESTIG","ZEVENTIG","TACHTIG","NEGENTIG","HONDERD" DATA "DUIZEND","MILJOEN","MILJARD","BILJOEN","BILJARD" [180] INPUT "UIT TE SPREKEN GETAL "; A$ IF VAL(A$)=0 THEN PRINT "..IS NIET UIT TE SPREKEN.." :GOTO [180] K=0 FOR N =1 TO LEN(A$) IF MID$(A$,N,1)="." THEN K=N NEXT N D=N-1 IF K=0 THEN A=N-1 ELSE A=K-1 END IF IF A >18 THEN PRINT "..DIT IS TE GROOT" :GOTO [180] B$=LEFT$(A$,A) FOR N = 1 TO A G(N)= VAL(MID$(B$,A-N+1,1)) NEXT N [310] REM *** GETAL UITGESPLITST BEGIN MET UITSPRAAK *** IF A=0 THEN GOTO [710] IF A>4 THEN GOTO [520] SELECT CASE A CASE 1 GOTO [340] CASE 2 GOTO [360] CASE 3 GOTO [420] CASE 4 GOTO [460] END SELECT [340] REM *** A=1 *** IF G(A)=0 THEN GOTO [710] ELSE PRINT A$(G(A)); :GOTO [710] END IF [360] REM *** A=2 *** IF G(A)=0 AND G(A-1)=0 THEN GOTO [710] IF G(1)=0 THEN PRINT A$(18+G(A));: GOTO [710] IF G(A)=1 THEN PRINT A$(G(A)*10+G(A-1)); :GOTO [710] IF G(A)=0 THEN A=A-1:GOTO [310] PRINT A$(G(1));"EN ";A$(18+G(A));:GOTO [710] [420] REM *** A=3 *** IF G(A)=0 THEN A=2 :GOTO [310] IF G(A)=1 THEN GOTO [450] ELSE PRINT A$(G(A)); END IF [450] PRINT " HONDERD "; :A=2 :GOTO [310] [460] REM *** A=4 *** IF G(4)=0 THEN A=3: GOTO [310] IF G(3)=0 THEN PRINT A$(G(A));"DUIZEND ";:A=3: GOTO [310] IF G(4)=1 THEN PRINT A$(G(4)*10+G(3));:GOTO [510] PRINT A$(G(3));"EN ";A$(18+G(4)); [510] PRINT " HONDERD ";:A=2: GOTO [310] [520] REM *** ALS GROTER DAN 4 *** REM *** BEPALEN WELK GROEPJE VAN DRIE HET IS *** Z=INT((A-.5)/3) REM *** BEPALEN WELK CIJFER IN GROEPJE VAN 3 *** M=A-3*Z SELECT CASE M CASE 1 GOTO [580] CASE 2 GOTO [610] CASE 3 GOTO [670] END SELECT [580] REM *** LAATSTE CIJFER IN GROEP *t* IF G(A) THEN PRINT A$(G(A)); [600] A = A-1: PRINT " ";A$(28+Z);" ";: GOTO [310] [610] REM *** MIDDELSTE CIJFER IN GROEP *** I=G(A):J=G(A-1) IF I=0 THEN A=A-1:GOTO [310] IF I=1 THEN PRINT A$(10+J); :A=A-1 :GOTO [600] IF J THEN PRINT A$(J);" EN "; PRINT A$(18+I);:A=A-1 :GOTO [600] [670] REM *** VOORSTE CIJFER IN GROEP *** IF G(A)=0 THEN A=A-1:GOTO [310] IF G(A)>1 THEN PRINT A$(G(A)); PRINT " HONDERD ";:A=A-1:GOTO [310] [710] REM *** HIER ALS IETS ACHTER DE KOMMA *** IF K=0 THEN PRINT :GOTO [180] : REM *** NIETS ACHTER KOMMA *** Z=D-K :REM *** AANTAL DECIMALEN *** IF Z>5 THEN Z=5 :REM *** BEPERK DECIMALEN *** C$=MID$(A$,K+1,Z) :REM *** EERSTE Z DECIMALEN *** IF VAL(C$)=0 THEN PRINT :GOTO [180] PRINT" KOMMA "; FOR N =1 TO Z :D(N)=VAL(MID$(C$,N,1)):NEXT N IF Z=2 THEN GOTO [820] FOR N =1 TO Z :PRINT A$(D(N));" "; :NEXT N PRINT :GOTO [180] [820] REM *** TWEE DECIMALEN HEBBEN EIGEN UITSPRAAK *** I=D(1):J=D(2) IF I=0 THEN PRINT "NUL ";A$(J):GOTO [180] IF I=1 THEN PRINT A$(10*I+J):GOTO [180] IF J THEN PRINT A$(J);" EN "; PRINT A$(18+I):GOTO [180] [/code:1:86f23b69da] Abcott

[anoniem]

En dit is dus niet de bedoeling, nog ff en iedereen maakt een nieuw topic aan met de oplossing van een ander topic in zijn/haar favoriete taal...