I have a old program that needs to be update.
I also have 2 power point information on what code needs to be changed from and to.
I known how to cut and paste the code. How do I attach the power point information into the form?
I have some code that needs to be fixed
-
Destructosoft
- Posts: 88
- Joined: Apr 03, 2011 3:44
- Location: Inside the bomb
- Contact:
Open the program and type this:
Then copy and paste some text information into the space between. Base that information on the content of the powerpoint.
Code: Select all
/'
'/New code that needs to be changed listed
The below flow chart will show you'll the new changes that need to be made.
I'm not a programer at could some please help me fix this code.
The code will be listed after the new flow chart.
(Special note the (.) period is used for spacing only.)
--------------------------------------------------------------------
Progress Chart for Kabbalah
H01 ------------------------------------->H02
^
|
|--------D01<-----------------|
........................................|
|------ >D01<-----|............|
|.........................|............|
|.........................|............|
|..........C01..........|............|
|..........^..^.........|............|
|........./.....\.........|............|
|......../.......\........|............|
|......./.........\.......|...........|
|....B01.......B02....|...........|
|....^..^......^^.....|...........|
|.../.....\..... /..\.....|...........|
|../.......\..../....\...|............|
|/..........\../......\..|............|
A01 -->A02 -->A03 ------>A04
...\......../.\....../................^
....\....../...\..../.................|
.....\..../.....\../..................|
...... V.V.....V.V..................|
|----E01.....E02--|.............|
|.......\........ /.....|.............|
|........\......./......|............|
|.........V....V.......|............|
|..........F.0.1.......|...........|
|.............|..........|...........|
|.............V..........|...........|
|------->G01<-----|...........|
...............|------------------|
Formula for the Kabbalah
---------------------------------------------------------------------------------
A01 – Month of birth ?? change to a single digit
A02 – Day of birth ?? change to a single digit
A03 – Year of birth ???? change to single digit
A04 – Total of A01 add A02 add A03 = ?? change to single digit
---------------------------------------------------------------------------------
B01 – Total of A01 # add A02 # = ?? change to a single digit
B02 – Total of A02 # add A03 # = ?? change to a single digit
---------------------------------------------------------------------------------
C01 – Total of B01 # add B02 # = ?? change to a single digit
---------------------------------------------------------------------------------
D01 – Total of A01 # add A03 # = ?? change to a single digit
---------------------------------------------------------------------------------
E01 – Total of A01 # subtract A02 # = ?? or A02 # subtract A01 # = ?? change to a single digit
Example: A01 (12) subtract A02 (31) Must have formula that will always subtract
A02 (31) subtract A01 (12) = 19. Now add 1 add 9 = 10. Now reduce it to (1) for E01
E02 – Total of A02 # subtract A03 # or = A03 # subtract A02 # = ?? change to a single digit
“Same formula used above.”
---------------------------------------------------------------------------------
F01 – Total of E01 # subtract E02 # = ?? change to a single digit
“Same formula used above.”
---------------------------------------------------------------------------------
G01 – Total of E01 # add E02 # add F01 = ?? change to a single digit
---------------------------------------------------------------------------------
H01 – Total of G01 # add A04 # add D01 = ?? change to a single digit
---------------------------------------------------------------------------------
H02 – Double H01 = ?? change to a single digit
==============================================
Code that needs to be changed to work like above.
I'm not a programer at could some please help me fix this code.
The code will be listed after the new flow chart.
(Special note the (.) period is used for spacing only.)
--------------------------------------------------------------------
Progress Chart for Kabbalah
H01 ------------------------------------->H02
^
|
|--------D01<-----------------|
........................................|
|------ >D01<-----|............|
|.........................|............|
|.........................|............|
|..........C01..........|............|
|..........^..^.........|............|
|........./.....\.........|............|
|......../.......\........|............|
|......./.........\.......|...........|
|....B01.......B02....|...........|
|....^..^......^^.....|...........|
|.../.....\..... /..\.....|...........|
|../.......\..../....\...|............|
|/..........\../......\..|............|
A01 -->A02 -->A03 ------>A04
...\......../.\....../................^
....\....../...\..../.................|
.....\..../.....\../..................|
...... V.V.....V.V..................|
|----E01.....E02--|.............|
|.......\........ /.....|.............|
|........\......./......|............|
|.........V....V.......|............|
|..........F.0.1.......|...........|
|.............|..........|...........|
|.............V..........|...........|
|------->G01<-----|...........|
...............|------------------|
Formula for the Kabbalah
---------------------------------------------------------------------------------
A01 – Month of birth ?? change to a single digit
A02 – Day of birth ?? change to a single digit
A03 – Year of birth ???? change to single digit
A04 – Total of A01 add A02 add A03 = ?? change to single digit
---------------------------------------------------------------------------------
B01 – Total of A01 # add A02 # = ?? change to a single digit
B02 – Total of A02 # add A03 # = ?? change to a single digit
---------------------------------------------------------------------------------
C01 – Total of B01 # add B02 # = ?? change to a single digit
---------------------------------------------------------------------------------
D01 – Total of A01 # add A03 # = ?? change to a single digit
---------------------------------------------------------------------------------
E01 – Total of A01 # subtract A02 # = ?? or A02 # subtract A01 # = ?? change to a single digit
Example: A01 (12) subtract A02 (31) Must have formula that will always subtract
A02 (31) subtract A01 (12) = 19. Now add 1 add 9 = 10. Now reduce it to (1) for E01
E02 – Total of A02 # subtract A03 # or = A03 # subtract A02 # = ?? change to a single digit
“Same formula used above.”
---------------------------------------------------------------------------------
F01 – Total of E01 # subtract E02 # = ?? change to a single digit
“Same formula used above.”
---------------------------------------------------------------------------------
G01 – Total of E01 # add E02 # add F01 = ?? change to a single digit
---------------------------------------------------------------------------------
H01 – Total of G01 # add A04 # add D01 = ?? change to a single digit
---------------------------------------------------------------------------------
H02 – Double H01 = ?? change to a single digit
==============================================
Code that needs to be changed to work like above.
Code: Select all
10 REM SAVE AS KAB.BAS
20 REM CREATION DATE 01/24/1992
30 REM REVISION DATE 05/02/1992
40 CLS
50 REM 1 2 3 4 5 6 7 8 9
60 REM A B C D E F G H I
70 REM J K L M N O P Q R
80 REM S T U V W X Y Z
90 DIM HD$(12), MO$(12), DYS(12), HD2$(12), PD(31), TPD(31), PM(12), TPM(12), NT$(9)
100 DIM PD$(12, 31), TPD$(12, 31), HD3$(12), NT(9), PNA(3), CPNA(3), VPNA(3)
110 FOR I = 1 TO 3: PNA(I) = 0: CPNA(I) = 0: VPNA(I) = 0: NEXT I
120 CLS: TTL = 0: CNT = 0: GTTL = 0: CTTL = 0: VTTL = 0: FLAG = 0: TNBR = 0: N = 1: C = 1: V = 1
130 C$ = "": N$ = "": V$ = "": NA$ = "": NAM$ = "": MN$ = "": CLR$ = "": LN$ = "": STLN$ = "--"
140 FOR I = 1 TO 60: CLR$ = CLR$ + "*": NEXT I
150 FOR I = 1 TO 77: LN$ = LN$ + "-": NEXT I
160 FOR I = 1 TO 9: NT(I) = 0: NEXT I
170 NBR = 0: X = 1
180 PRINT " NAME ANALYSIS / KABBALAH / COMPATIBILITY": PRINT LN$: PRINT: PRINT
190 INPUT "1. Enter Name ------------------------------ "; A$
200 INPUT "2. Enter Birth Month - (01, 02, ...11, 12) - "; BM$
210 INPUT "3. Enter Birth Day --- (01, 02, ...29, 30) - "; BD$
220 INPUT "4. Enter Birth Year -- (1990, 1991...) ----- "; BY$
230 PRINT: PRINT
240 INPUT "Enter NUMBER to change or RETURN to continue - "; X$: IF X$ = "" GOTO 320
250 IF VAL(X$) = 1 THEN INPUT "1. Enter Name ------------------------------ "; A$
260 IF VAL(X$) = 2 THEN INPUT "2. Enter Birth Month - (01, 02, ...11, 12) - "; BM$
270 IF VAL(X$) = 3 THEN INPUT "3. Enter Birth Day --- (01, 02, ...29, 30) - "; BD$
280 IF VAL(X$) = 4 THEN INPUT "4. Enter Birth Year -- (1940, 1941...) ----- "; BY$
290 PRINT: PRINT
300 INPUT "Enter NUMBER to change or RETURN to continue - "; X$
310 IF X$ > "" GOTO 250
320 IF A$ = "999" THEN END
330 FOR I = 1 TO LEN(A$)
340 B$ = MID$(A$, I, 1)
350 REM ------ ASSIGN VALUED TO LETTERS ------
360 IF B$ = "A" OR B$ = "J" OR B$ = "S" THEN CNT = 1
370 IF B$ = "B" OR B$ = "K" OR B$ = "T" THEN CNT = 2
380 IF B$ = "C" OR B$ = "L" OR B$ = "U" THEN CNT = 3
390 IF B$ = "D" OR B$ = "M" OR B$ = "V" THEN CNT = 4
400 IF B$ = "E" OR B$ = "N" OR B$ = "W" THEN CNT = 5
410 IF B$ = "F" OR B$ = "O" OR B$ = "X" THEN CNT = 6
420 IF B$ = "G" OR B$ = "P" OR B$ = "Y" THEN CNT = 7
430 IF B$ = "H" OR B$ = "Q" OR B$ = "Z" THEN CNT = 8
440 IF B$ = "I" OR B$ = "R" THEN CNT = 9
450 IF B$ = "a" OR B$ = "j" OR B$ = "s" THEN CNT = 1
460 IF B$ = "b" OR B$ = "k" OR B$ = "t" THEN CNT = 2
470 IF B$ = "c" OR B$ = "l" OR B$ = "u" THEN CNT = 3
480 IF B$ = "d" OR B$ = "m" OR B$ = "v" THEN CNT = 4
490 IF B$ = "e" OR B$ = "n" OR B$ = "w" THEN CNT = 5
500 IF B$ = "f" OR B$ = "o" OR B$ = "x" THEN CNT = 6
510 IF B$ = "g" OR B$ = "p" OR B$ = "y" THEN CNT = 7
520 IF B$ = "h" OR B$ = "q" OR B$ = "z" THEN CNT = 8
530 IF B$ = "i" OR B$ = "r" THEN CNT = 9
540 IF FLAG = 1 THEN RETURN
550 IF B$ = " " OR B$ = "." THEN GOTO 570
560 TTL = TTL + CNT: PNA(N) = PNA(N) + CNT: PRINT N; C; V
570 IF B$ = " " OR B$ = "." THEN N$ = N$ + " " ELSE N$ = N$ + STR$(CNT)
580 IF B$ = " " THEN N = N + 1 ELSE GOTO 620
590 C = C + 1
600 V = V + 1
610 STLN$ = " "
620 NA$ = NA$ + " " + B$: LN1$ = LN1$ + STLN$
630 GOSUB 670
640 CNT = 0: STLN$ = "--"
650 NEXT I
660 GOTO 820
670 REM ------ IDENTIFY VOWELS -------
680 IF B$ = "A" OR B$ = "a" THEN GOTO 780
690 IF B$ = "E" OR B$ = "e" THEN GOTO 780
700 IF B$ = "I" OR B$ = "i" THEN GOTO 780
710 IF B$ = "O" OR B$ = "o" THEN GOTO 780
720 IF B$ = "U" OR B$ = "u" THEN GOTO 780
730 IF B$ = "Y" OR B$ = "y" THEN GOTO 780
740 V$ = V$ + " "
750 IF B$ = " " OR B$ = "." THEN C$ = C$ + " " ELSE C$ = C$ + STR$(CNT)
760 CTTL = CTTL + CNT: CPNA(C) = CPNA(C) + CNT
770 RETURN
780 V$ = V$ + STR$(CNT)
790 C$ = C$ + " "
800 VTTL = VTTL + CNT: VPNA(V) = VPNA(V) + CNT
810 RETURN
820 REM ------ IDENTIFY MISSING NUMBERS -------
830 FLAG = 1
840 FOR I = 1 TO 9
850 LOCATE 21, 20: PRINT "PROCESSING --- PLEASE WAIT !!! "; I;
860 NAM$ = ""
870 LOCATE 23, 10: PRINT CLR$;
880 FOR J = 1 TO LEN(NA$)
890 B$ = MID$(NA$, J, 1)
900 GOSUB 350
910 NAM$ = NAM$ + B$: LOCATE 23, 15: PRINT NAM$;
920 IF CNT = I THEN GOTO 950
930 NEXT J
940 MN$ = MN$ + STR$(I) + " "
950 NEXT I
960 GOTO 1080
'970 NEXT I
980 REM ------ REDUCE NUBMER TO A SINGLE DIGIT ------
990 IF NBR <= 9 THEN RETURN
1000 TNBR = 0
1010 NBR$ = STR$(NBR)
1020 FOR J = 1 TO LEN(NBR$)
1030 TNBR = TNBR + VAL(MID$(NBR$, J, 1))
1040 NEXT J
1050 NBR = TNBR
1060 IF TNBR = 11 OR TNBR = 22 OR TNBR = 33 OR TNBR = 44 THEN RETURN
1070 GOTO 980
1080 REM ------------
1090 NBR = TTL: GOSUB 980: GTTL = NBR
1100 NBR = VTTL: GOSUB 980: VGTTL = NBR
1110 NBR = CTTL: GOSUB 980: CGTTL = NBR
1120 REM ------ PRINT DATA -------
1130 CLS
1140 PRINT " "; VPNA(1), VPNA(2), VPNA(3)
1150 PRINT " "; LN1$
1160 PRINT "Vowels : "; V$; " = "; VTTL; " = "; VGTTL: PRINT
1170 PRINT "Name : "; NA$: PRINT
1180 PRINT " "; PNA(1), PNA(2), PNA(3)
1190 PRINT " "; LN1$
1200 PRINT "Numbers : "; N$; " = "; TTL; " = "; GTTL
1210 PRINT " "; CPNA(1), CPNA(2), CPNA(3)
1220 PRINT " "; LN1$
1230 PRINT "Consonants : "; C$; " = "; CTTL; " = "; CGTTL: PRINT
1240 PRINT "Missing No.: "; MN$
1250 REM stop
1260 REM ------ PRINT DATA -------
1261 LPRINT
1270 LPRINT " NAME : "; A$
1280 LPRINT " BIRTHDAY : "; BM$ + "/" + BD$ + "/" + BY$
1290 LPRINT TAB(53); "DATE PRINTED: "; DATE$
1300 LPRINT LN$:
1305 LPRINT " NAME ANALYSIS": LPRINT LN$: LPRINT
1310 LPRINT " Name : "; NA$: LPRINT
1320 LPRINT " Vowels : "; V$; " = "; VTTL; " = "; VGTTL: LPRINT
1330 LPRINT " Numbers : "; N$; " = "; TTL; " = "; GTTL: LPRINT
1340 LPRINT " Consonants : "; C$; " = "; CTTL; " = "; CGTTL: LPRINT
1350 LPRINT " Missing No.: "; MN$: LPRINT
1360 LPRINT LN$
' REM
' REM
1370 REM ------ START OF KABBALAH CALCULATIONS ------
' REM
' REM
1380 CM = VAL(BM$): NBR = CM: GOSUB 1420: A1 = NBR
1390 CD = VAL(BD$): NBR = CD: GOSUB 1420: A2 = NBR
1400 CY = VAL(BY$): NBR = CY: GOSUB 1420: A3 = NBR
1410 GOTO 1510
1420 REM ----- REDUCE DATE TO A SINGLE DIGIT -----
1430 REM
1440 SUM$ = STR$(NBR): NBR = 0
1450 LN = LEN(SUM$)
1460 FOR I = 2 TO LN
1470 NBR = NBR + VAL(MID$(SUM$, I, 1))
1480 NEXT I
1490 IF NBR > 9 THEN GOTO 1430
1500 RETURN
1510 REM --------------
1520 NBR = CD: GOSUB 1420: A2 = NBR
1530 A4 = A1 + A2 + A3: NBR = A4: GOSUB 1420: A4 = NBR
1540 A5 = A1 + A2: NBR = A5: GOSUB 1420: A5 = NBR
1550 A6 = A2 + A3: NBR = A6: GOSUB 1420: A6 = NBR
1560 A7 = A5 + A6: NBR = A7: GOSUB 1420: A7 = NBR
1570 A8 = A1 + A3: NBR = A8: GOSUB 1420: A8 = NBR
1580 A9 = ABS(A1 - A2): NBR = A9: GOSUB 1420: A9 = NBR
1590 A10 = ABS(A2 - A3): NBR = A10: GOSUB 1420: A10 = NBR
1600 A11 = ABS(A9 - A10): NBR = A11: GOSUB 1420: A11 = NBR
1610 A12 = A9 + A10 + A11: NBR = A12: GOSUB 1420: A12 = NBR
1620 A13 = A12 + A4 + A8: NBR = A13: GOSUB 1420: A13 = NBR
1630 A14 = 2 * A13: NBR = A14: GOSUB 1420: A14 = NBR
1640 B1 = A8 + A13: NBR = B1: GOSUB 1420: B1 = NBR
1650 B2 = A8 + A14: NBR = B2: GOSUB 1420: B2 = NBR
1660 B3 = A13 + A12: NBR = B3: GOSUB 1420: B3 = NBR
1670 B4 = A12 + A14: NBR = B4: GOSUB 1420: B4 = NBR
' REM
' REM
1370 REM ------ END OF KABBALAH CALCULATIONS ------
' REM
' REM
' REM ----------------------------------------------------------------------------
' REM
' REM -----------------------Start of output for Kabbalah
' REM
1680 LPRINT " KABBALAH": LPRINT LN$
1690 LPRINT
1700 LPRINT " "; A8
1710 LPRINT " "; B1; " "; B2
1720 LPRINT " "; A7; " |"
1730 LPRINT " "; A5; " "; A6; " |"
1740 LPRINT " "; A1; " "; A2; " "; A3; "| "; A4
1750 LPRINT " "; A13; "-----------+---- "; A14
1760 LPRINT " "; A9; " "; A10; " |"
1770 LPRINT " "; A11; " |"
1780 LPRINT " "; B3; " "; B4
1790 LPRINT " "; A12
1800 LPRINT
' REM
' REM ------------------ End out output for Kabbalah
' REM
' REM
1820 REM ------ COMPATIBILITY MATRIX -------
1830 BT$ = BM$ + BD$ + BY$
1840 FOR I = 1 TO 9
1850 NT$(I) = " *"
1860 FOR J = 1 TO LEN(BT$)
1870 IF VAL(MID$(BT$, J, 1)) = I THEN NT(I) = NT(I) + 1
1880 NEXT J
1890 IF NT(I) = 0 THEN GOTO 1910
1900 NT$(I) = STR$(NT(I))
1910 NEXT I
1912 LPRINT LN$
1915 LPRINT " COMPATIBILITY": LPRINT LN$
1920 LPRINT
1930 LPRINT " (3's) | (6's) | (9's)"
1940 LPRINT " "; NT$(3); " | "; NT$(6); " | "; NT$(9)
1950 LPRINT " | |"
1960 LPRINT " ------+----------+------"
1970 LPRINT " (2's) | (5's) | (8's)"
1980 LPRINT " "; NT$(2); " | "; NT$(5); " | "; NT$(8)
1990 LPRINT " | |"
2000 LPRINT " ------+----------+------"
2010 LPRINT " (1's) | (4's) | (7's)"
2020 LPRINT " "; NT$(1); " | "; NT$(4); " | "; NT$(7)
2030 LPRINT " | |"
2040 LPRINT
'2050 LPRINT
2060 FOR I = 1 TO 13: LPRINT: NEXT I
2070 PRINT: PRINT: PRINT
2080 INPUT "Do you want to do another ? (Y)es (N)o "; ANS$
2090 IF ANS$ = "Y" OR ANS$ = "y" THEN GOTO 120
2100 SYSTEM
2110 ENDHere is a cleaner copy of the above code for anyone who wants to have a go.
Code: Select all
#Lang "QB"
' SAVE As KAB.BAS
' CREATION Date 01/24/1992
' REVISION Date 05/02/1992
Cls
' 1 2 3 4 5 6 7 8 9
' A B C D E F G H I
' J K L M N O P Q R
' S T U V W X Y Z
Dim HD$(12), MO$(12), DYS(12), HD2$(12), PD(31), TPD(31), PM(12), TPM(12), NT$(9)
Dim PD$(12, 31), TPD$(12, 31), HD3$(12), NT(9), PNA(3), CPNA(3), VPNA(3)
For I = 1 To 3
PNA(I) = 0
CPNA(I) = 0
VPNA(I) = 0
Next I
120 '
Cls
TTL = 0
CNT = 0
GTTL = 0
CTTL = 0
VTTL = 0
FLAG = 0
TNBR = 0
N = 1
C = 1
V = 1
C$ = ""
N$ = ""
V$ = ""
NA$ = ""
NAM$ = ""
MN$ = ""
CLR$ = ""
LN$ = ""
STLN$ = "--"
For I = 1 To 60
CLR$ = CLR$ + "*"
Next I
For I = 1 To 77
LN$ = LN$ + "-"
Next I
For I = 1 To 9
NT(I) = 0
Next I
NBR = 0: X = 1
Print " NAME ANALYSIS / KABBALAH / COMPATIBILITY"
Print LN$
Print
Print
Input "1. Enter Name ------------------------------ "; A$
Input "2. Enter Birth Month - (01, 02, ...11, 12) - "; BM$
Input "3. Enter Birth Day --- (01, 02, ...29, 30) - "; BD$
Input "4. Enter Birth Year -- (1990, 1991...) ----- "; BY$
Print: Print
Input "Enter NUMBER to change or RETURN to continue - "; X$: If X$ = "" Goto 320
250 '
If Val(X$) = 1 Then Input "1. Enter Name ------------------------------ "; A$
If Val(X$) = 2 Then Input "2. Enter Birth Month - (01, 02, ...11, 12) - "; BM$
If Val(X$) = 3 Then Input "3. Enter Birth Day --- (01, 02, ...29, 30) - "; BD$
If Val(X$) = 4 Then Input "4. Enter Birth Year -- (1940, 1941...) ----- "; BY$
Print: Print
Input "Enter NUMBER to change or RETURN to continue - "; X$
If X$ > "" Goto 250
320 '
If A$ = "999" Then End
For I = 1 To Len(A$)
B$ = Mid$(A$, I, 1)
350 ' ------ ASSIGN VALUED To LETTERS ------
If B$ = "A" Or B$ = "J" Or B$ = "S" Then CNT = 1
If B$ = "B" Or B$ = "K" Or B$ = "T" Then CNT = 2
If B$ = "C" Or B$ = "L" Or B$ = "U" Then CNT = 3
If B$ = "D" Or B$ = "M" Or B$ = "V" Then CNT = 4
If B$ = "E" Or B$ = "N" Or B$ = "W" Then CNT = 5
If B$ = "F" Or B$ = "O" Or B$ = "X" Then CNT = 6
If B$ = "G" Or B$ = "P" Or B$ = "Y" Then CNT = 7
If B$ = "H" Or B$ = "Q" Or B$ = "Z" Then CNT = 8
If B$ = "I" Or B$ = "R" Then CNT = 9
If B$ = "a" Or B$ = "j" Or B$ = "s" Then CNT = 1
If B$ = "b" Or B$ = "k" Or B$ = "t" Then CNT = 2
If B$ = "c" Or B$ = "l" Or B$ = "u" Then CNT = 3
If B$ = "d" Or B$ = "m" Or B$ = "v" Then CNT = 4
If B$ = "e" Or B$ = "n" Or B$ = "w" Then CNT = 5
If B$ = "f" Or B$ = "o" Or B$ = "x" Then CNT = 6
If B$ = "g" Or B$ = "p" Or B$ = "y" Then CNT = 7
If B$ = "h" Or B$ = "q" Or B$ = "z" Then CNT = 8
If B$ = "i" Or B$ = "r" Then CNT = 9
If FLAG = 1 Then Return
If B$ = " " Or B$ = "." Then Goto 570
TTL = TTL + CNT
PNA(N) = PNA(N) + CNT
Print N; C; V
570 '
If B$ = " " Or B$ = "." Then N$ = N$ + " " Else N$ = N$ + Str$(CNT)
If B$ = " " Then N = N + 1 Else Goto 620
C = C + 1
V = V + 1
STLN$ = " "
620 '
NA$ = NA$ + " " + B$
LN1$ = LN1$ + STLN$
Gosub 670
CNT = 0
STLN$ = "--"
Next I
Goto 820
670 ' ------ IDENTIFY VOWELS -------
If B$ = "A" Or B$ = "a" Then Goto 780
If B$ = "E" Or B$ = "e" Then Goto 780
If B$ = "I" Or B$ = "i" Then Goto 780
If B$ = "O" Or B$ = "o" Then Goto 780
If B$ = "U" Or B$ = "u" Then Goto 780
If B$ = "Y" Or B$ = "y" Then Goto 780
V$ = V$ + " "
If B$ = " " Or B$ = "." Then C$ = C$ + " " Else C$ = C$ + Str$(CNT)
CTTL = CTTL + CNT
CPNA(C) = CPNA(C) + CNT
Return
780 '
V$ = V$ + Str$(CNT)
C$ = C$ + " "
VTTL = VTTL + CNT
VPNA(V) = VPNA(V) + CNT
Return
820 ' ------ IDENTIFY MISSING NUMBERS -------
FLAG = 1
For I = 1 To 9
Locate 21, 20: Print "PROCESSING --- PLEASE WAIT !!! "; I;
NAM$ = ""
Locate 23, 10: Print CLR$;
For J = 1 To Len(NA$)
B$ = Mid$(NA$, J, 1)
Gosub 350
NAM$ = NAM$ + B$
Locate 23, 15: Print NAM$;
If CNT = I Then Goto 950
Next J
MN$ = MN$ + Str$(I) + " "
950 '
Next I
Goto 1080
980 ' ------ REDUCE NUBMER To A Single DIGIT ------
If NBR <= 9 Then Return
TNBR = 0
NBR$ = Str$(NBR)
For J = 1 To Len(NBR$)
TNBR = TNBR + Val(Mid$(NBR$, J, 1))
Next J
NBR = TNBR
If TNBR = 11 Or TNBR = 22 Or TNBR = 33 Or TNBR = 44 Then Return
Goto 980
1080 ' ------------
NBR = TTL: Gosub 980: GTTL = NBR
NBR = VTTL: Gosub 980: VGTTL = NBR
NBR = CTTL: Gosub 980: CGTTL = NBR
' ------ Print Data -------
Cls
Print " "; VPNA(1), VPNA(2), VPNA(3)
Print " "; LN1$
Print "Vowels : "; V$; " = "; VTTL; " = "; VGTTL: Print
Print "Name : "; NA$: Print
Print " "; PNA(1), PNA(2), PNA(3)
Print " "; LN1$
Print "Numbers : "; N$; " = "; TTL; " = "; GTTL
Print " "; CPNA(1), CPNA(2), CPNA(3)
Print " "; LN1$
Print "Consonants : "; C$; " = "; CTTL; " = "; CGTTL: Print
Print "Missing No.: "; MN$
' ------ Print Data -------
Lprint
Lprint " NAME : "; A$
Lprint " BIRTHDAY : "; BM$ + "/" + BD$ + "/" + BY$
Lprint Tab(53); "DATE PRINTED: "; Date$
Lprint LN$:
Lprint " NAME ANALYSIS": Lprint LN$: Lprint
Lprint " Name : "; NA$: Lprint
Lprint " Vowels : "; V$; " = "; VTTL; " = "; VGTTL: Lprint
Lprint " Numbers : "; N$; " = "; TTL; " = "; GTTL : Lprint
Lprint " Consonants : "; C$; " = "; CTTL; " = "; CGTTL: Lprint
Lprint " Missing No.: "; MN$: Lprint
Lprint LN$
'
' ------ START OF KABBALAH CALCULATIONS ------
'
CM = Val(BM$): NBR = CM: Gosub 1420: A1 = NBR
CD = Val(BD$): NBR = CD: Gosub 1420: A2 = NBR
CY = Val(BY$): NBR = CY: Gosub 1420: A3 = NBR
Goto 1510
1420 ' ----- REDUCE Date To A Single DIGIT -----
1430 '
SUM$ = Str$(NBR)
NBR = 0
LN = Len(SUM$)
For I = 2 To LN
NBR = NBR + Val(Mid$(SUM$, I, 1))
Next I
If NBR > 9 Then Goto 1430
Return
1510 ' --------------
NBR = CD: Gosub 1420: A2 = NBR
A4 = A1 + A2 + A3: NBR = A4: Gosub 1420: A4 = NBR
A5 = A1 + A2: NBR = A5: Gosub 1420: A5 = NBR
A6 = A2 + A3: NBR = A6: Gosub 1420: A6 = NBR
A7 = A5 + A6: NBR = A7: Gosub 1420: A7 = NBR
A8 = A1 + A3: NBR = A8: Gosub 1420: A8 = NBR
A9 = Abs(A1 - A2): NBR = A9: Gosub 1420: A9 = NBR
A10 = Abs(A2 - A3): NBR = A10: Gosub 1420: A10 = NBR
A11 = Abs(A9 - A10): NBR = A11: Gosub 1420: A11 = NBR
A12 = A9 + A10 + A11: NBR = A12: Gosub 1420: A12 = NBR
A13 = A12 + A4 + A8: NBR = A13: Gosub 1420: A13 = NBR
A14 = 2 * A13: NBR = A14: Gosub 1420: A14 = NBR
B1 = A8 + A13: NBR = B1: Gosub 1420: B1 = NBR
B2 = A8 + A14: NBR = B2: Gosub 1420: B2 = NBR
B3 = A13 + A12: NBR = B3: Gosub 1420: B3 = NBR
B4 = A12 + A14: NBR = B4: Gosub 1420: B4 = NBR
'
' ------ End OF KABBALAH CALCULATIONS ------
'
' ----------------------------------------------------------------------------
'
' -----------------------Start of output for Kabbalah
'
Lprint " KABBALAH": Lprint LN$
Lprint
Lprint " "; A8
Lprint " "; B1; " "; B2
Lprint " "; A7; " |"
Lprint " "; A5; " "; A6; " |"
Lprint " "; A1; " "; A2; " "; A3; "| "; A4
Lprint " "; A13; "-----------+---- "; A14
Lprint " "; A9; " "; A10; " |"
Lprint " "; A11; " |"
Lprint " "; B3; " "; B4
Lprint " "; A12
Lprint
'
' ------------------ End output for Kabbalah
'
' ------ COMPATIBILITY MATRIX -------
BT$ = BM$ + BD$ + BY$
For I = 1 To 9
NT$(I) = " *"
For J = 1 To Len(BT$)
If Val(Mid$(BT$, J, 1)) = I Then NT(I) = NT(I) + 1
Next J
If NT(I) <> 0 Then NT$(I) = Str$(NT(I))
Next I
Lprint LN$
Lprint " COMPATIBILITY": Lprint LN$
Lprint
Lprint " (3's) | (6's) | (9's)"
Lprint " "; NT$(3); " | "; NT$(6); " | "; NT$(9)
Lprint " | |"
Lprint " ------+----------+------"
Lprint " (2's) | (5's) | (8's)"
Lprint " "; NT$(2); " | "; NT$(5); " | "; NT$(8)
Lprint " | |"
Lprint " ------+----------+------"
Lprint " (1's) | (4's) | (7's)"
Lprint " "; NT$(1); " | "; NT$(4); " | "; NT$(7)
Lprint " | |"
Lprint
For I = 1 To 13
Lprint
Next I
Print: Print: Print
Input "Do you want to do another ? (Y)es (N)o "; ANS$
If ANS$ = "Y" Or ANS$ = "y" Then Goto 120
End
Re: New code that needs to be changed listed
To clarify what you mean by 'change to a single digit'.mart9594 wrote:I'm not a programer at could some please help me fix this code.
change to a single digit
Now add 1 add 9 = 10. Now reduce it to (1) for E01
Is this the normal numerological method where one adds all the digits of a number together, repeating until there is only one left?
For example:
105 -> ( 1 + 0 + 5 ) = 6
277 -> ( 2 + 7 + 7 ) -> 16 -> ( 1 + 6 ) = 7
If so, do you use special rules for 11, 22, etc.?
The nines digit reduction code has a legacy inclusion in the form of the multiple elevens. The elevens do not seem to be needed because it generates the global variable TNBR, while NBR is actually used.
Code to perform digit reduction only need be done at the end of the process since it is unaffected by + - * / arithmetic. I use this FB code function;
Here is FB coded function to convert a letter to a value;
Code to perform digit reduction only need be done at the end of the process since it is unaffected by + - * / arithmetic. I use this FB code function;
Code: Select all
' digit sum of a number, range from 1 to 9, only zero gives zero
Function lone_digit(Byval n As Integer) As Integer
lone_digit = ((n-1) Mod 9) + 1
End FunctionCode: Select all
' value assignment to letters
Function letter_value(Byref t As String) As Integer
Select Case Ucase(t)
Case "A", "J", "S"
letter_value = 1
Case "B", "K", "T"
letter_value = 2
Case "C", "L", "U"
letter_value = 3
Case "D", "M", "V"
letter_value = 4
Case "E", "N", "W"
letter_value = 5
Case "F", "O", "X"
letter_value = 6
Case "G", "P", "Y"
letter_value = 7
Case "H", "Q", "Z"
letter_value = 8
Case "I", "R"
letter_value = 9
Case Else
letter_value = 0
End Select
End Function