Coding Conversion Problem

[GeorgeLee]

I wrote a software program in BASIC PDS about 35 years ago and want to utilize it for my 64 Bit
computers in my home using QB64.  I am now 74 years old and have trouble remembering so I cannot attempt
to learn another language therefore, would appreciate help with this problem.  Virtual Windows XP
is NOT an option with my Windows 10 computers.  I know that the rest of the software program
works with Windows 10, but the info from the DEF FNname routine makes the use of the software
unusable.

Can anyone help me change the following DEF FNname lines to a FUNCTION in QB64 BASIC formula?

   DEF FNA (Z) = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
   DEF FNG (Z) = 100 * SIN(V / Z * P#)
   DEF FNB = V - 28 * INT(V / 28) + 1
   DEF FNC = V - 23 * INT(V / 23) + 1
   DEF FND = V - 33 * INT(V / 33) + 1

Thanks in advance,
George Lee

[Cobalt]

B,C,D should all be good. Not 100% sure on A and G, but see if these give you what you need.

 

Code: QB64: [Select]

1. ' DEF FNA (Z) = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
2. ' DEF FNG (Z) = 100 * SIN(V / Z * P#)
3. ' DEF FNB = V - 28 * INT(V / 28) + 1
4. ' DEF FNC = V - 23 * INT(V / 23) + 1
5. ' DEF FND = V - 33 * INT(V / 33) + 1
6. '
7. FUNCTION A# (V, Z, P#)
8.  Result# = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
9.  A = Result#
10. END FUNCTION
11.  
12. FUNCTION G# (V, Z, P#)
13.  Result# = 100 * SIN(V / Z * P#)
14.  G = Result#
15. END FUNCTION
16.  
17. FUNCTION B (V)
18.  Result = V - 28 * INT(V / 28) + 1
19.  B = Result
20. END FUNCTION
21.  
22. FUNCTION C (V)
23.  Result = V - 23 * INT(V / 23) + 1
24.  C = Result
25. END FUNCTION
26.  
27. FUNCTION D (V)
28.  Result = V - 33 * INT(V / 33) + 1
29.  D = Result
30. END FUNCTION
31.  

[Cobalt]

Oh Yeah, my manners....

Welcome to the Forums!

[GeorgeLee]

Thank you for your probable solution AND for your WELCOME.  I have been trying to implement the solution for the past three days straight to no avail.  If you could/would look at the original source code (I will attempt to paste it here), maybe you could help me solve the problem.  I would be happy to compensate you for your assistance (just let me know how much).  Thank YOU, George Lee

'----------------------FUNCTION 1 DEFINITION BEGIN  LINE 460
'----------------------FUNCTION 2 DEFINITION BEGIN LINE 1770
'
1 ' BioGraph.Bas, (C) 1985-2020, GEORGE A LEE, BioRhythm, (575) 623-8365
CDate$ = "1985-2020"
version$ = "Version. 4.0"
Hit = 0
KEY OFF
ON ERROR GOTO FIXIT
ELine = 50
2 WIDTH 80, ELine
GOTO 6
FIXIT:
IF ELine = 50 THEN ELine = 43: RESUME 2
IF ELine = 43 THEN ELine = 25: RESUME 3
RESUME NEXT
3 ELine = 25
6 WIDTH 80, 25
14 KEY OFF
15 LGreen = 10: LGRAY = 7: Cyan = 11: LRed = 12: Magenta = 13: Yellow = 14
20 DIM CR$(26), Start(26), FINISH(26)
30 C = 9
40 FOR I = 1 TO 26
50 CR$(I) = CHR$(64 + I)
60 Start(I) = C + 1
70 FINISH(I) = C + 100
80 C = C + 100
90 NEXT I
100 ON ERROR GOTO 3900
110 CLS
120 LOCATE 6, 1, 0
140 CP$ = "###.##%"
X$ = version$
Hit = 0
200 FOR Delay = 1 TO 3000: NEXT Delay: CLS : WIDTH 80
220 DIM A(12), D(12)
230 CLS
235 'WIDTH 80, 25: VIEW PRINT 1 TO ELine: LOCATE , , 0
 'IF pcpy AND ELine = 25 THEN PCOPY 1, 0: GOTO 370
236 'BLOAD PATH$ + "biograph.ov1": PCOPY 0, 1: pcpy = 1
237 GOTO 370
240 PRINT "BIO-RHYTHMS"; TAB(51); "(c) "; CDate$; " by George A. Lee"
250 FOR B = .2 TO 3 STEP .2
270 y = SIN(B)
280 PRINT TAB(20 * y + 9); CHR$(1);
290 PRINT TAB(40 * y + 10); CHR$(3);
300 PRINT TAB(50 * y + 10); CHR$(215);
310 ' formula from 'COMPUTER GAMES',J.V.NAHIGIAN,W.S.HODGES
320 ' formula translated to Model 4 by GEORGE A. LEE, 12/85
330 NEXT B
340 PRINT
350 PRINT "This program can chart your daily BIO-RHYTHMIC patterns, or determine compat-"
360 PRINT "ability of two individuals.": PRINT STRING$(80, "-");
370 FOR I = 1 TO 12
380 READ A(I)
390 NEXT I
400 FOR I = 1 TO 12
410 READ D(I)
420 NEXT I
430 DATA 0,31,59,90,120,151,181,212,243,273,304,334
440 DATA 31,28,31,30,31,30,31,31,30,31,30,31

'----------------------FUNCTION 1 DEFINITION BEGIN--------------------------------
460 DEF FNA (Z) = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
470 DEF FNG (Z) = 100 * SIN(V / Z * P#)
480 DEF FNB = V - 28 * INT(V / 28) + 1
490 DEF FNC = V - 23 * INT(V / 23) + 1
500 DEF FND = V - 33 * INT(V / 33) + 1
'----------------------FUNCTION 1 DEFINITION END--------------------------------

505 WF$ = ""
506 'GOTO 550
510 LOCATE 19, 1
515 PRINT "<1>  Single person chart"
520 PRINT "<2>  Two person compatability"
530 PRINT "<3>  End program"
540 PRINT "<4>  EDIT file"
550 ED$ = "4"
    LOCATE 23, 1: COLOR Yellow: PRINT "<"; : COLOR Magenta: PRINT "5"; : COLOR Yellow: PRINT ">"; : COLOR Cyan: PRINT "  OOPs, Wanted Printer Verson"
    KY$ = INPUT$(1): IF INSTR("1235" + ED$, KY$) = 0 THEN 550
560 KY = VAL(KY$): LOCATE , , 1
570 ON KY GOTO 580, 2370, 3300, 3840, 3861
575 NFME$ = TempName$: TempName$ = ""
580 FOR I = 0 TO 4: LOCATE 19 + I, 1: PRINT SPACE$(60); : NEXT I: LOCATE 19, 1: I = 0
585 IF LEFT$(NFME$, 1) = "m" OR LEFT$(NFME$, 1) = CHR$(0) THEN NFME$ = Ne$
590 COLOR Yellow, 0: PRINT "Name on chart: "; NFME$ + STRING$(10, 32); : COLOR 7: LOCATE 19, 16: LINE INPUT Ne$: IF Ne$ = "" THEN Ne$ = NFME$
600 GOSUB 3760: LOCATE 19, 16: PRINT STRING$(27, 32), ; : LOCATE 19, 16: PRINT Ne$;
610 NFME$ = Ne$: Name1$ = Ne$
620 'IF WF$="N" THEN 660
630 GOSUB 3460
640 NFME$ = N1$
650 YB = VAL(MID$(DT1$, 7))
660 COLOR Cyan, 1: CLS : LOCATE 1, 1: PRINT "This chart specifically printed for "; Ne$; "."
670 PRINT "Compiled on "; DATE$; "      -     "; "(c) "; CDate$; " by George A. Lee"
680 COLOR LRed: PRINT TAB(12); "Biorhythm is the rhythmic course of the life process of an individual."
690 PRINT : COLOR Yellow: PRINT "The MEDIAN, line (0), is the critical and is when most accidents MAY occur.": PRINT TAB(12); "The high periods (+) are when you have the most energy, and the low"
700 PRINT TAB(12); "periods (-) are regarded as recuperative periods.": COLOR Cyan
710 LOCATE 21, 1: PRINT STRING$(80, 32); : LOCATE 22, 1: PRINT STRING$(80, 32);
715 LOCATE 21, 1: COLOR LGreen
        PRINT "STARTING DATE FOR CHART? (Default=";
        COLOR 15: PRINT DATE$; : COLOR LGreen: PRINT ") ";
 Sharon1 = POS(Sharon1) + 1: LOCATE , Sharon1: PRINT "   -  -"; : COLOR Cyan
720 LOCATE , Sharon1: UUU = Sharon1: UU = 20: U = 1: GOSUB 3320: m = VAL(ab$): IF m <= 0 THEN m = VAL(DATE$): DD = VAL(MID$(DATE$, 4, 2)): y = VAL(RIGHT$(DATE$, 4)): LOCATE CSRLIN, Sharon1: PRINT DATE$: GOTO 760
730 IF (m <= 0) + (m > 12) THEN BEEP: GOTO 720
    Sharon2 = Sharon1 + 3
740 LOCATE , Sharon2: U = 1: UUU = Sharon2: GOSUB 3320: DD = VAL(ab$): IF (DD <= 0) + (DD > 31) THEN BEEP: GOTO 740
750 LOCATE , Sharon2 + 3: U = 3: UUU = Sharon2 + 3: GOSUB 3320: IF ab$ = "" THEN BEEP: GOTO 750
    y = VAL(ab$)
760 ab$ = ""
780 IF YS > YB THEN 1130
800 DTP = ELine: '15.5
810 M2 = m
820 D2 = DD
830 Y3 = y
840 Y5 = y
850 GOSUB 2170
860 Z = T
870 PRINT
880 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 1020
886 GOSUB 3910
887 IF WF$ = "N" THEN 910
    EGEN$ = "ENTER " + UCASE$(Ne$) + "'S GENDER: "
890 LOCATE 23, 1: PRINT EGEN$ + STRING$(60 - LEN(Ne$), 32); : LOCATE 23, LEN(EGEN$) + 2: LINE INPUT Gender$: LOCATE 23, 1: PRINT STRING$(60, 32);
900 GOSUB 3870
910 IF WF$ = "N" THEN NFME$ = Ne$
915 LOCATE 23, 1: PRINT SPC(70);
916 LOCATE 23, 1: PRINT "ENTER "; UCASE$(Ne$); "'S BIRTHDATE ("; : COLOR 15: PRINT "MM-DD-YYYY"; : COLOR Cyan: PRINT ") ";
  Sharon1 = POS(Sharon1) + 1: LOCATE , Sharon1: PRINT "   -  -";
920 LOCATE , Sharon1: UUU = Sharon1: U = 1: UU = CSRLIN - 1: GOSUB 3320: m = VAL(ab$): IF (m <= 0) + (m > 12) THEN BEEP: GOTO 920
930 AD3$ = ab$ + "-": EY$ = ab$: ab$ = "": Sharon2 = Sharon1 + 3
940 LOCATE , Sharon2: U = 1: UUU = Sharon2: GOSUB 3320: DD = VAL(ab$): IF (DD <= 0) + (DD > 31) THEN BEEP: GOTO 940
950 AD4$ = ab$ + "-": EY$ = EY$ + ab$: ab$ = ""
960 LOCATE , Sharon2 + 3: U = 3: UUU = Sharon2 + 3: GOSUB 3320: IF ab$ = "" THEN BEEP: GOTO 960
970 y = VAL(ab$)
  UUU = 0
ab$ = RIGHT$(STR$(y), 4)
980 AD2$ = AD3$ + AD4$ + ab$
990 AD1$ = Ne$
1000 IF WF$ = "N" THEN 1020
1010 GOSUB 3640
1020 PRINT "Any changes (Y/N) ? ";
1030 YN$ = INPUT$(1): IF (YN$ = "Y") + (YN$ = "y") THEN TempName$ = Ne$: GOTO 575 ELSE IF (YN$ = "N") + (YN$ = "n") THEN 1050
1040 GOTO 1030
1050 COLOR 7, 0: ab$ = ""
1060 M1 = m
1070 D1 = DD
1080 Y2 = y
1085 GOTO 1140
1100 IF AD1$ <> "" THEN 1140
1130 LOCATE 23, 1: PRINT "******* Don't try to kid me, You weren't born yet!!!! Try again.": PRINT SPACE$(50); : FOR Delay = 1 TO 1000: NEXT Delay: GOTO 580
1140 GOSUB 2170
1145 IF T > Z THEN 1130
1150 V = T - Z
1160 V = ABS(V)
1180 IF ELine > 25 THEN WIDTH 80, ELine
VIEW PRINT 1 TO ELine: COLOR Cyan, 1: CLS
1190 PRINT "GRAPH SYMBOLS:  "; : COLOR 12: PRINT CHR$(3); : COLOR 15: PRINT " Physical Cycle (23 day)";
COLOR Yellow: PRINT TAB(51); "(c)"; CDate$; " by George A. Lee"
1200 COLOR 10: PRINT TAB(17); CHR$(1); : COLOR 15: PRINT " Sensitivity (emotional) Cycle (28 day)"
1210 COLOR 11: PRINT TAB(17); CHR$(251); : COLOR 15: PRINT " Cognitive (intellectual) Cycle (33 day)"
1220 COLOR 12: PRINT TAB(17); "**"; : COLOR 15: PRINT " Critical day.  Most accidents MAY occur."
1230 IF INSTR(Ne$, " ") <= 0 THEN IST = LEN(Ne$) ELSE IST = INSTR(Ne$, " ") - 1
1240 COLOR LGreen: PRINT LEFT$(Ne$, IST); ", "; "you were born on ";
1250 B9 = J + 1
1260 GOSUB 2110
1270 PRINT AY$; ", ";
1280 A9 = M1
1290 GOSUB 2080
1300 PRINT MT$;
1310 PRINT STR$(D1) + ","; Y2; "-";
1320 PRINT USING " ######, days OR ###.# years ago."; V; V / 365.25#: PRINT
1340 m$ = "DATE            (-)       (0)       (+)            CAPABILITY %-TILE"
1350 y = 5
1360 X = 0
1370 COLOR 10, 1: LOCATE 6, 1: LOCATE 6, 59: PRINT CHR$(1); : COLOR 11: PRINT "      " + CHR$(251); : COLOR 12: PRINT "      " + CHR$(3) + "     **"; : COLOR 15
1380 LOCATE 7, 7: PRINT m$: COLOR 7
1390 J1 = V + J
1400 J1 = J1 - 7 * INT(J1 / 7)
1410 D2 = D2 - 1
1420 J1 = J1 - 1
1430 V = V - 1
1450 FOR I = 1 TO DTP - 9
1455 K = 0
1460 V = V + 1
1470 D2 = D2 + 1
1480 J1 = J1 + 1
1490 IF M2 <> 2 THEN 1520
1500 IF INT(Y3 / 4) <> Y3 / 4 THEN 1520
1510 K = 1
1520 IF D2 <= D(M2) + K THEN 1550
1530 M2 = M2 + 1
1540 D2 = 1
1550 IF J1 < 7 THEN 1570
1560 J1 = 0
1570 IF M2 <= 12 THEN 1620
1580 Happy$ = "* HAPPY NEW YEAR *"
1590 Happy = 1
1600 M2 = 1
1610 Y3 = Y3 + 1
1620 IF M2 <> M1 THEN 1670
1630 IF D2 <> D1 THEN 1670
1640 Happy$ = "*HAPPY" + STR$(Y3 - Y2) + " BIRTHDAY*"
1650 Happy = 1
1660 'PUT 'HAPPY BIRTHDAY' SONG IN HERE
1670 IF M2 <> 12 THEN 1710
1680 IF D2 <> 25 THEN 1710
1690 Happy$ = "* MERRY CHRISTMAS *"
1700 Happy = 1
1710 m$ = STR$(M2) + "-" + STR$(D2)
1720 IF VAL(RIGHT$(STR$(Y3), 4)) < 10 THEN YR1$ = "000" + RIGHT$(STR$(Y3), 1) ELSE YR1$ = RIGHT$(STR$(Y3), 4)
1730 COLOR 14: LOCATE 7 + I, 1: PRINT USING " ##_-##_-\  \"; M2; D2; YR1$: COLOR 7
1750 G = 20
1760 P# = 6.28318530717961#

'----------------------FUNCTION2 DEFINITION BEGIN--------------------------------
1770 C5 = FNA(33) + G
1780 S5 = FNA(28) + G
1790 P5 = FNA(23) + G
1800 LOCATE 7 + I, 34: PRINT CHR$(179);
1810 CH1$ = CHR$(2): CH2$ = CHR$(1)
1820 IF S5 > 33 THEN SWAP CH1$, CH2$
1830 LOCATE 7 + I, S5 + 1: COLOR 10: PRINT CH2$;
1840 LOCATE 7 + I, 57: PRINT USING "####"; FNG(28); : COLOR 7

1850 LOCATE 7 + I, C5 + 1: COLOR 11: PRINT CHR$(251);
1860 LOCATE 7 + I, 64: PRINT USING "####"; FNG(33); : COLOR 7

1870 LOCATE 7 + I, P5 + 1: COLOR 12: PRINT CHR$(3);
1880 LOCATE 7 + I, 71: PRINT USING "####"; FNG(23); : COLOR 7

1890 IF (S5 = 33) + (P5 = 33) + (C5 = 33) THEN LOCATE 7 + I, 79: COLOR 12 + 16: PRINT "**"; : COLOR 7

1900 IF FNG(28) = FNG(33) THEN LOCATE 7 + I, S5 + 1: PRINT " ";
1910 IF FNG(28) = FNG(23) THEN LOCATE 7 + I, S5 + 1: PRINT " ";
1920 IF FNG(23) = FNG(33) THEN LOCATE 7 + I, P5 + 1: PRINT " ";
'----------------------FUNCTION2 DEFINITION END--------------------------------



1930 IF Happy THEN GOSUB 2130
1940 IF M2 <> 1 THEN 1980
1950 IF D2 <> 1 THEN 1980
1960 m$ = "* HAPPY NEW YEAR *"
1970 GOSUB 2140
1980 NEXT I
1990 m$ = "Another chart? (Y/n) "
2000 LOCATE ELine - LastLine, 1: PRINT STRING$(70, 32);
2010 LOCATE ELine - LastLine, 1: COLOR 15: PRINT m$;
     LastLine = 0
     COLOR 7, 0
2020 KY$ = INKEY$
2030 IF KY$ = "" THEN 2020
2040 IF UCASE$(KY$) = "N" THEN CLS : GOTO 3300
2050 IF UCASE$(KY$) = "Y" THEN CLOSE : CLS : RUN
     GOTO 2020
2060 CLS : CLOSE : LOCATE , , 0: SYSTEM 'RUN "BIORHYTH.EXE"
2080 MONTH$ = "JanFebMarAprMayJunJulAugSepOctNovDec"
2090 MT$ = MID$(MONTH$, A9 * 3 - 2, 3)
2100 RETURN
2110 DDAY$ = "WedThuFriSatSunMonTue"
2120 AY$ = MID$(DDAY$, B9 * 3 - 2, 3): RETURN
2130 IF Happy THEN SWAP m$, Happy$
2140 LOCATE 7 + I, 1:
        IF Happy THEN COLOR LGreen + 16
        PRINT m$;
        COLOR 7
2150 Happy = 0
2160 RETURN
2170 y1 = y - 1800
2180 Q1 = INT(y1 / 4)
2190 Q2 = INT(Q1 / 25)
2200 Q3 = INT((y1 + 200) / 400)
2210 K = 0
2220 IF Q1 * 4 <> y1 THEN 2260
2230 IF Q2 * 100 <> y1 THEN 2260
2240 IF Q3 * 400 - 200 <> y1 THEN 2260
2250 K = 1
2260 T = 365 * y1 + Q1 - Q2 + Q3 - K
2270 T = T + A(m) + DD - 1
2280 IF m < 3 THEN 2300
2290 T = T + K
2300 IF INT(y1 / 4) <> y1 / 4 THEN 2330
2310 IF m > 2 THEN 2330
2320 T = T - 1
2330 J = T - 7 * INT(T / 7)
2340 RETURN
2350 END
2370 COLOR Cyan, 1: CLS
2380 PRINT "                 C O M P A T A B I L I T Y    A N A L Y S I S"
2390 PRINT
     COLOR Yellow
2400 PRINT "          Two individuals will have an average compatability of 100%"
2410 PRINT "       ONLY if they were born on the same day, or if they were born"
2420 PRINT "       21,252 days (58.1848 Years) apart.  ";
2430 PRINT "Please do not be upset if": PRINT "       your compatability average is less than 100%!"
2440 PRINT : IF NFME$ = "" THEN NFME$ = Name1$
     COLOR Cyan
2460 LOCATE 10, 16: PRINT "What is person one's name?  "; NFME$ + STRING$(8, 32); : LOCATE CSRLIN, 44: LINE INPUT A1$: IF A1$ = "" THEN A1$ = NFME$
2470 Ne$ = A1$: Name1$ = Ne$
2480 GOSUB 3760
2490 A1$ = Ne$
2500 NFME$ = A1$
2510 'IF INSTR(A1$," ")>0 THEN 2550
2520 GOSUB 3460
2530 IF DT1 > 0 THEN SWAP A1$, N2$
2540 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 2620
2542 GOSUB 3910
2543 IF WF$ = "N" THEN 2560
2550 LOCATE 11, 16: PRINT "ENTER GENDER: "; : LINE INPUT Gender$: GOSUB 3870
2560 LOCATE 11, 16: PRINT "What is "; A1$; "'s ";
 INPUT "birthday (MM,DD,YYYY)"; m, DD, y: IF LEN(LTRIM$(STR$(y))) < 4 THEN 2560
2570 IF m < 10 THEN AD3$ = "0" + RIGHT$(STR$(m), 1) ELSE AD3$ = RIGHT$(STR$(m), 2)
2580 IF DD < 10 THEN AD4$ = "0" + RIGHT$(STR$(DD), 1) ELSE AD4$ = RIGHT$(STR$(DD), 2)
2590 AD1$ = A1$: AD2$ = AD3$ + "-" + AD4$ + "-" + RIGHT$(STR$(y), 4)
2600 IF WF$ = "N" THEN 2620
2610 GOSUB 3640
2620 E1 = m
2630 F1 = DD
2640 G1 = y
2650 GOSUB 2170
2660 Z2 = T
2670 K1 = J + 1
2680 PRINT : IF NFM1$ = "" THEN NFM1$ = Name2$
2690 LOCATE 14, 16: PRINT "What is person two's name?  "; NFM1$ + STRING$(10, 32); : LOCATE CSRLIN, 44: LINE INPUT B1$: IF B1$ = "" THEN B1$ = NFM1$
2700 Ne$ = B1$: Name2$ = Ne$
2710 GOSUB 3760
2720 B1$ = Ne$
2730 NFM1$ = B1$
2750 GOSUB 3460
2760 IF DT1 > 0 THEN SWAP B1$, N2$
2770 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 2860
2775 GOSUB 3910
2776 IF WF$ = "N" THEN 2790
2780 LOCATE 15, 16: PRINT "ENTER GENDER: " + STRING$(50, 32); : LOCATE , 30: LINE INPUT Gender$: GOSUB 3870
2790 LOCATE 15, 16: PRINT "What is "; B1$; "'s ";
2800 INPUT "birthday  (MM,DD,YYYY)"; m, DD, y: IF LEN(LTRIM$(STR$(y))) < 4 THEN 2790
2810 IF m < 10 THEN AD3$ = "0" + RIGHT$(STR$(m), 1) ELSE AD3$ = RIGHT$(STR$(m), 2)
2820 IF DD < 10 THEN AD4$ = "0" + RIGHT$(STR$(DD), 1) ELSE AD4$ = RIGHT$(STR$(DD), 2)
2830 AD1$ = B1$: AD2$ = AD3$ + "-" + AD4$ + "-" + RIGHT$(STR$(y), 4)
2840 IF WF$ = "N" THEN 2860
2850 GOSUB 3640
2860 E2 = m
2870 D2 = DD
2880 G2 = y
2890 GOSUB 2170
2900 P2 = ABS(Z2 - T)
2910 K2 = J + 1
2930 COLOR 7, 0: CLS : ' BLOAD PATH$ + "biocomp.ovl"
2950 LOCATE 11, 28: COLOR LGreen: PRINT A1$; " and "; B1$; "."; : COLOR LGRAY
2960 LOCATE 13, 15: COLOR LGreen: PRINT A1$; : COLOR LGRAY: PRINT " was born on ";
2970 B9 = K1
2980 GOSUB 2110
2990 COLOR LRed: PRINT AY$; : COLOR LGRAY: PRINT ", ";
3000 A9 = E1
3010 GOSUB 2080
3020 PRINT MT$;
3030 PRINT STR$(F1); ","; G1;
3040 LOCATE 14, 15: COLOR LGreen: PRINT B1$; : COLOR LGRAY: PRINT " was born on ";
3050 B9 = K2
3060 GOSUB 2110
3070 COLOR LRed: PRINT AY$; : COLOR LGRAY: PRINT ", ";
3080 A9 = E2
3090 GOSUB 2080
3100 PRINT MT$;
3110 PRINT STR$(D2); ","; G2;
3130 Z = P2
3150 P3 = ABS(INT(((Z / 23) - INT(Z / 23)) * 23))
3160 S3 = ABS(INT(((Z / 28) - INT(Z / 28)) * 28))
3170 C3 = ABS(INT(((Z / 33) - INT(Z / 33)) * 33))
3180 P5 = ABS(100 - ((2 * P3) * (100 / 23)))
3190 S5 = ABS(100 - ((2 * S3) * (100 / 28)))
3200 C5 = ABS(100 - ((2 * C3) * (100 / 33)))
3210 COLOR LRed: LOCATE 16, 55: PRINT USING CP$; P5
3220 COLOR Cyan: LOCATE 17, 55: PRINT USING CP$; S5
3230 COLOR Yellow: LOCATE 18, 55: PRINT USING CP$; C5
3250 LOCATE 20, 55
3260 A5 = (P5 + S5 + C5) / 3
3270 COLOR Magenta: PRINT USING CP$; A5; : COLOR LGRAY
3280 IF ELine = 43 THEN LastLine = 18
 IF ELine = 25 THEN LastLine = 0
 IF ELine = 50 THEN LastLine = 25
3290 GOTO 1990
3300 CLOSE : SYSTEM: ' RUN "BioRhyth.Exe"
3310 CLS : SYSTEM: 'RUN "BIORHYTH.EXE"
3320 LOCATE UU + 1, UUU + 1: PRINT STRING$(LEN(ab$), 32); : LOCATE UU + 1, UUU + 1
3340 ab$ = ""
3350 FOR I = 0 TO U
3360 m$ = INPUT$(1)
3370 IF m$ = CHR$(13) THEN 3420
     IF m$ = CHR$(29) THEN 3320
3380 IF m$ = CHR$(8) THEN m$ = CHR$(29): GOTO 3320
     IF (m$ = " ") + (m$ = "'") THEN 3390
3385 IF (ASC(UCASE$(m$)) < 48) + (ASC(UCASE$(m$)) > 90) THEN BEEP: GOTO 3360
3390 ab$ = ab$ + m$
3400 LOCATE UU + 1, UUU + I + 1: PRINT m$;
3410 NEXT I
3420 IF U = 3 THEN
  IF (LEN(ab$)) < 4 THEN 3320
  END IF
  IF U < 3 AND m$ = CHR$(13) THEN 3440
3430 IF U < 3 THEN PRINT "-";  ELSE PRINT
3440 RETURN
3460 'CLOSE #1: OPEN "R", 1, pat2$ + "BIO.DAT", 60
3470 'N1$ = ""
3480 'FIELD 1, 30 AS N1$, 10 AS D1$, 8 AS D2$, 6 AS GE$, 1 AS DL$
3490 'DT1 = 0
3500 'GH = ASC(Ne$) - 64
3510 'FOR SE = Start(GH) TO FINISH(GH)
3520 'IF EOF(1) THEN 3620
3530 'GET 1, SE
3540 'IF LEFT$(N1$, 2) = "%%" THEN 3620
3550 'IF DL$ = "I" THEN PIX = SE: GOTO 3580
3570 'IF INSTR(1, N1$, Ne$) <> 0 THEN 3590
3580 'NEXT SE
3590 'N2$ = LEFT$(N1$, INSTR(1, N1$, "  ") - 1)
3600 'Ne$ = N2$
3610 'DT1 = VAL(MID$(D1$, 1, 2)): DT2 = VAL(MID$(D1$, 4, 2)): DT3 = VAL(RIGHT$(D1$, 4))
3620 'CLOSE #1
3630 RETURN
3640 ON ERROR GOTO 3900
3650 'CLOSE 1: OPEN "R", 1, pat2$ + "BIO.DAT", 60
     'FIELD 1, 30 AS N1$, 10 AS D1$, 8 AS D2$, 6 AS GE$, 1 AS DL$
3660 'IF PIX THEN SE = PIX
3670 'PIX = 0
3680 'LSET N1$ = AD1$
3690 'LSET D1$ = AD2$
3700 'LSET D2$ = LEFT$(DATE$, 6) + RIGHT$(DATE$, 2)
3710 'LSET GE$ = Gender$
3720 'LSET DL$ = "A"
3730 'PUT 1, SE
3740 'CLOSE #1
3750 RETURN
3760 FOR I = 1 TO LEN(Ne$)
3770 S1$ = MID$(Ne$, I, 1)
3780 IF I = 1 THEN S1$ = MID$(Ne$, I, 1): IF S1$ < CHR$(97) OR S1$ > CHR$(122) THEN 3820 ELSE MID$(Ne$, I, 1) = CHR$(ASC(S1$) - 32)
3790 IF S1$ = " " THEN I = I + 1: S1$ = MID$(Ne$, I, 1): IF S1$ < CHR$(97) OR S1$ > CHR$(122) THEN 3820 ELSE MID$(Ne$, I, 1) = CHR$(ASC(S1$) - 32)
3800 IF S1$ < CHR$(65) OR S1$ > CHR$(91) THEN 3820
3810 MID$(Ne$, I, 1) = CHR$(ASC(S1$) + 32)
3820 NEXT I
3830 RETURN
3840 CLOSE : ' OPEN "O", 1, "BIOCHAIN.CFG": PRINT #1, "2": CLOSE #1
3850 CLS : LOCATE 12, 31: PRINT "Loading Editor...";
3860 SYSTEM: 'RUN "BioEdit.Prg"
3861 SYSTEM: 'CLOSE : CLS : LOCATE 12, 31: PRINT "Loading Printout Program...": RUN "BioPrint.prg"

3870 IF Gender$ = "" THEN Gender$ = "E"
3875 MID$(Gender$, 1, 1) = UCASE$(LEFT$(Gender$, 1)): MID$(Gender$, 2) = LCASE$(MID$(Gender$, 2))
3890 RETURN
3900 RESUME NEXT
3910 BEEP: NOF$ = " is not on file.  Do you want to file (Y/N) ?"
LOCATE 23, 1: PRINT Ne$; NOF$;
3911 WF$ = UCASE$(INKEY$): IF WF$ = "" THEN 3911
3916 IF INSTR("YN", WF$) = 0 THEN 3911
LOCATE 23, 1: PRINT STRING$(79, 32);
3920 RETURN
'end of program lines

[bplus]

See if this works:

Code: QB64: [Select]

1. DIM SHARED V
2. DIM SHARED P#
3. '----------------------FUNCTION 1 DEFINITION BEGIN  LINE 460
4. '----------------------FUNCTION 2 DEFINITION BEGIN LINE 1770
5. '
6. 1 ' BioGraph.Bas, (C) 1985-2020, GEORGE A LEE, BioRhythm, (575) 623-8365
7. CDate$ = "1985-2020"
8. version$ = "Version. 4.0"
9. Hit = 0
10. KEY OFF
11. ON ERROR GOTO FIXIT
12. ELine = 50
13. 2 WIDTH 80, ELine
14. GOTO 6
15. FIXIT:
16. IF ELine = 50 THEN ELine = 43: RESUME 2
17. IF ELine = 43 THEN ELine = 25: RESUME 3
18. RESUME NEXT
19. 3 ELine = 25
20. 6 WIDTH 80, 25
21. 14 KEY OFF
22. 15 LGreen = 10: LGRAY = 7: Cyan = 11: LRed = 12: Magenta = 13: Yellow = 14
23. 20 DIM CR$(26), Start(26), FINISH(26)
24. 30 C = 9
25. 40 FOR I = 1 TO 26
26.    50 CR$(I) = CHR$(64 + I)
27.    60 Start(I) = C + 1
28.    70 FINISH(I) = C + 100
29.    80 C = C + 100
30. 90 NEXT I
31. 100 ON ERROR GOTO 3900
32. 110 CLS
33. 120 LOCATE 6, 1, 0
34. 140 CP$ = "###.##%"
35. X$ = version$
36. Hit = 0
37. 200 FOR Delay = 1 TO 3000: NEXT Delay: CLS: WIDTH 80
38. 220 DIM A(12), D(12)
39. 230 CLS
40. 235 'WIDTH 80, 25: VIEW PRINT 1 TO ELine: LOCATE , , 0
41. 'IF pcpy AND ELine = 25 THEN PCOPY 1, 0: GOTO 370
42. 236 'BLOAD PATH$ + "biograph.ov1": PCOPY 0, 1: pcpy = 1
43. 237 GOTO 370
44. 240 PRINT "BIO-RHYTHMS"; TAB(51); "(c) "; CDate$; " by George A. Lee"
45. 250 FOR B = .2 TO 3 STEP .2
46.    270 y = SIN(B)
47.    280 PRINT TAB(20 * y + 9); CHR$(1);
48.    290 PRINT TAB(40 * y + 10); CHR$(3);
49.    300 PRINT TAB(50 * y + 10); CHR$(215);
50.    310 ' formula from 'COMPUTER GAMES',J.V.NAHIGIAN,W.S.HODGES
51.    320 ' formula translated to Model 4 by GEORGE A. LEE, 12/85
52. 330 NEXT B
53. 340 PRINT
54. 350 PRINT "This program can chart your daily BIO-RHYTHMIC patterns, or determine compat-"
55. 360 PRINT "ability of two individuals.": PRINT STRING$(80, "-");
56. 370 FOR I = 1 TO 12
57.    380 READ A(I)
58. 390 NEXT I
59. 400 FOR I = 1 TO 12
60.    410 READ D(I)
61. 420 NEXT I
62. 430 DATA 0,31,59,90,120,151,181,212,243,273,304,334
63. 440 DATA 31,28,31,30,31,30,31,31,30,31,30,31
64.  
65. '----------------------FUNCTION 1 DEFINITION BEGIN--------------------------------
66. '460 DEF FNA (Z) = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
67. '470 DEF FNG (Z) = 100 * SIN(V / Z * P#)
68. '480 DEF FNB = V - 28 * INT(V / 28) + 1
69. '490 DEF FNC = V - 23 * INT(V / 23) + 1
70. '500 DEF FND = V - 33 * INT(V / 33) + 1
71. '----------------------FUNCTION 1 DEFINITION END--------------------------------
72.  
73. 505 WF$ = ""
74. 506 'GOTO 550
75. 510 LOCATE 19, 1
76. 515 PRINT "<1>  Single person chart"
77. 520 PRINT "<2>  Two person compatability"
78. 530 PRINT "<3>  End program"
79. 540 PRINT "<4>  EDIT file"
80. 550 ED$ = "4"
81. LOCATE 23, 1: COLOR Yellow: PRINT "<";: COLOR Magenta: PRINT "5";: COLOR Yellow: PRINT ">";: COLOR Cyan: PRINT "  OOPs, Wanted Printer Verson"
82. KY$ = INPUT$(1): IF INSTR("1235" + ED$, KY$) = 0 THEN 550
83. 560 KY = VAL(KY$): LOCATE , , 1
84. 570 ON KY GOTO 580, 2370, 3300, 3840, 3861
85. 575 NFME$ = TempName$: TempName$ = ""
86. 580 FOR I = 0 TO 4: LOCATE 19 + I, 1: PRINT SPACE$(60);: NEXT I: LOCATE 19, 1: I = 0
87. 585 IF LEFT$(NFME$, 1) = "m" OR LEFT$(NFME$, 1) = CHR$(0) THEN NFME$ = Ne$
88. 590 COLOR Yellow, 0: PRINT "Name on chart: "; NFME$ + STRING$(10, 32);: COLOR 7: LOCATE 19, 16: LINE INPUT Ne$: IF Ne$ = "" THEN Ne$ = NFME$
89. 600 GOSUB 3760: LOCATE 19, 16: PRINT STRING$(27, 32), ;: LOCATE 19, 16: PRINT Ne$;
90. 610 NFME$ = Ne$: Name1$ = Ne$
91. 620 'IF WF$="N" THEN 660
92. 630 GOSUB 3460
93. 640 NFME$ = N1$
94. 650 YB = VAL(MID$(DT1$, 7))
95. 660 COLOR Cyan, 1: CLS: LOCATE 1, 1: PRINT "This chart specifically printed for "; Ne$; "."
96. 670 PRINT "Compiled on "; DATE$; "      -     "; "(c) "; CDate$; " by George A. Lee"
97. 680 COLOR LRed: PRINT TAB(12); "Biorhythm is the rhythmic course of the life process of an individual."
98. 690 PRINT: COLOR Yellow: PRINT "The MEDIAN, line (0), is the critical and is when most accidents MAY occur.": PRINT TAB(12); "The high periods (+) are when you have the most energy, and the low"
99. 700 PRINT TAB(12); "periods (-) are regarded as recuperative periods.": COLOR Cyan
100. 710 LOCATE 21, 1: PRINT STRING$(80, 32);: LOCATE 22, 1: PRINT STRING$(80, 32);
101. 715 LOCATE 21, 1: COLOR LGreen
102. PRINT "STARTING DATE FOR CHART? (Default=";
103. COLOR 15: PRINT DATE$;: COLOR LGreen: PRINT ") ";
104. Sharon1 = POS(Sharon1) + 1: LOCATE , Sharon1: PRINT "   -  -";: COLOR Cyan
105. 720 LOCATE , Sharon1: UUU = Sharon1: UU = 20: U = 1: GOSUB 3320: m = VAL(ab$): IF m <= 0 THEN m = VAL(DATE$): DD = VAL(MID$(DATE$, 4, 2)): y = VAL(RIGHT$(DATE$, 4)): LOCATE CSRLIN, Sharon1: PRINT DATE$: GOTO 760
106. 730 IF (m <= 0) + (m > 12) THEN BEEP: GOTO 720
107. Sharon2 = Sharon1 + 3
108. 740 LOCATE , Sharon2: U = 1: UUU = Sharon2: GOSUB 3320: DD = VAL(ab$): IF (DD <= 0) + (DD > 31) THEN BEEP: GOTO 740
109. 750 LOCATE , Sharon2 + 3: U = 3: UUU = Sharon2 + 3: GOSUB 3320: IF ab$ = "" THEN BEEP: GOTO 750
110. y = VAL(ab$)
111. 760 ab$ = ""
112. 780 IF YS > YB THEN 1130
113. 800 DTP = ELine: '15.5
114. 810 M2 = m
115. 820 D2 = DD
116. 830 Y3 = y
117. 840 Y5 = y
118. 850 GOSUB 2170
119. 860 Z = T
120. 870 PRINT
121. 880 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 1020
122. 886 GOSUB 3910
123. 887 IF WF$ = "N" THEN 910
124. EGEN$ = "ENTER " + UCASE$(Ne$) + "'S GENDER: "
125. 890 LOCATE 23, 1: PRINT EGEN$ + STRING$(60 - LEN(Ne$), 32);: LOCATE 23, LEN(EGEN$) + 2: LINE INPUT Gender$: LOCATE 23, 1: PRINT STRING$(60, 32);
126. 900 GOSUB 3870
127. 910 IF WF$ = "N" THEN NFME$ = Ne$
128. 915 LOCATE 23, 1: PRINT SPC(70);
129. 916 LOCATE 23, 1: PRINT "ENTER "; UCASE$(Ne$); "'S BIRTHDATE (";: COLOR 15: PRINT "MM-DD-YYYY";: COLOR Cyan: PRINT ") ";
130. Sharon1 = POS(Sharon1) + 1: LOCATE , Sharon1: PRINT "   -  -";
131. 920 LOCATE , Sharon1: UUU = Sharon1: U = 1: UU = CSRLIN - 1: GOSUB 3320: m = VAL(ab$): IF (m <= 0) + (m > 12) THEN BEEP: GOTO 920
132. 930 AD3$ = ab$ + "-": EY$ = ab$: ab$ = "": Sharon2 = Sharon1 + 3
133. 940 LOCATE , Sharon2: U = 1: UUU = Sharon2: GOSUB 3320: DD = VAL(ab$): IF (DD <= 0) + (DD > 31) THEN BEEP: GOTO 940
134. 950 AD4$ = ab$ + "-": EY$ = EY$ + ab$: ab$ = ""
135. 960 LOCATE , Sharon2 + 3: U = 3: UUU = Sharon2 + 3: GOSUB 3320: IF ab$ = "" THEN BEEP: GOTO 960
136. 970 y = VAL(ab$)
137. UUU = 0
138. ab$ = RIGHT$(STR$(y), 4)
139. 980 AD2$ = AD3$ + AD4$ + ab$
140. 990 AD1$ = Ne$
141. 1000 IF WF$ = "N" THEN 1020
142. 1010 GOSUB 3640
143. 1020 PRINT "Any changes (Y/N) ? ";
144. 1030 YN$ = INPUT$(1): IF (YN$ = "Y") + (YN$ = "y") THEN TempName$ = Ne$: GOTO 575 ELSE IF (YN$ = "N") + (YN$ = "n") THEN 1050
145. 1040 GOTO 1030
146. 1050 COLOR 7, 0: ab$ = ""
147. 1060 M1 = m
148. 1070 D1 = DD
149. 1080 Y2 = y
150. 1085 GOTO 1140
151. 1100 IF AD1$ <> "" THEN 1140
152. 1130 LOCATE 23, 1: PRINT "******* Don't try to kid me, You weren't born yet!!!! Try again.": PRINT SPACE$(50);: FOR Delay = 1 TO 1000: NEXT Delay: GOTO 580
153. 1140 GOSUB 2170
154. 1145 IF T > Z THEN 1130
155. 1150 V = T - Z
156. 1160 V = ABS(V)
157. 1180 IF ELine > 25 THEN WIDTH 80, ELine
158. VIEW PRINT 1 TO ELine: COLOR Cyan, 1: CLS
159. 1190 PRINT "GRAPH SYMBOLS:  ";: COLOR 12: PRINT CHR$(3);: COLOR 15: PRINT " Physical Cycle (23 day)";
160. COLOR Yellow: PRINT TAB(51); "(c)"; CDate$; " by George A. Lee"
161. 1200 COLOR 10: PRINT TAB(17); CHR$(1);: COLOR 15: PRINT " Sensitivity (emotional) Cycle (28 day)"
162. 1210 COLOR 11: PRINT TAB(17); CHR$(251);: COLOR 15: PRINT " Cognitive (intellectual) Cycle (33 day)"
163. 1220 COLOR 12: PRINT TAB(17); "**";: COLOR 15: PRINT " Critical day.  Most accidents MAY occur."
164. 1230 IF INSTR(Ne$, " ") <= 0 THEN IST = LEN(Ne$) ELSE IST = INSTR(Ne$, " ") - 1
165. 1240 COLOR LGreen: PRINT LEFT$(Ne$, IST); ", "; "you were born on ";
166. 1250 B9 = J + 1
167. 1260 GOSUB 2110
168. 1270 PRINT AY$; ", ";
169. 1280 A9 = M1
170. 1290 GOSUB 2080
171. 1300 PRINT MT$;
172. 1310 PRINT STR$(D1) + ","; Y2; "-";
173. 1320 PRINT USING " ######, days OR ###.# years ago."; V; V / 365.25#: PRINT
174. 1340 m$ = "DATE            (-)       (0)       (+)            CAPABILITY %-TILE"
175. 1350 y = 5
176. 1360 X = 0
177. 1370 COLOR 10, 1: LOCATE 6, 1: LOCATE 6, 59: PRINT CHR$(1);: COLOR 11: PRINT "      " + CHR$(251);: COLOR 12: PRINT "      " + CHR$(3) + "     **";: COLOR 15
178. 1380 LOCATE 7, 7: PRINT m$: COLOR 7
179. 1390 J1 = V + J
180. 1400 J1 = J1 - 7 * INT(J1 / 7)
181. 1410 D2 = D2 - 1
182. 1420 J1 = J1 - 1
183. 1430 V = V - 1
184. 1450 FOR I = 1 TO DTP - 9
185.    1455 K = 0
186.    1460 V = V + 1
187.    1470 D2 = D2 + 1
188.    1480 J1 = J1 + 1
189.    1490 IF M2 <> 2 THEN 1520
190.    1500 IF INT(Y3 / 4) <> Y3 / 4 THEN 1520
191.    1510 K = 1
192.    1520 IF D2 <= D(M2) + K THEN 1550
193.    1530 M2 = M2 + 1
194.    1540 D2 = 1
195.    1550 IF J1 < 7 THEN 1570
196.    1560 J1 = 0
197.    1570 IF M2 <= 12 THEN 1620
198.    1580 Happy$ = "* HAPPY NEW YEAR *"
199.    1590 Happy = 1
200.    1600 M2 = 1
201.    1610 Y3 = Y3 + 1
202.    1620 IF M2 <> M1 THEN 1670
203.    1630 IF D2 <> D1 THEN 1670
204.    1640 Happy$ = "*HAPPY" + STR$(Y3 - Y2) + " BIRTHDAY*"
205.    1650 Happy = 1
206.    1660 'PUT 'HAPPY BIRTHDAY' SONG IN HERE
207.    1670 IF M2 <> 12 THEN 1710
208.    1680 IF D2 <> 25 THEN 1710
209.    1690 Happy$ = "* MERRY CHRISTMAS *"
210.    1700 Happy = 1
211.    1710 m$ = STR$(M2) + "-" + STR$(D2)
212.    1720 IF VAL(RIGHT$(STR$(Y3), 4)) < 10 THEN YR1$ = "000" + RIGHT$(STR$(Y3), 1) ELSE YR1$ = RIGHT$(STR$(Y3), 4)
213.    1730 COLOR 14: LOCATE 7 + I, 1: PRINT USING " ##_-##_-\  \"; M2; D2; YR1$: COLOR 7
214.    1750 G = 20
215.    1760 P# = 6.28318530717961#
216.  
217.     '----------------------FUNCTION2 DEFINITION BEGIN--------------------------------
218.    1770 C5 = FNA(33) + G
219.    1780 S5 = FNA(28) + G
220.    1790 P5 = FNA(23) + G
221.    1800 LOCATE 7 + I, 34: PRINT CHR$(179);
222.    1810 CH1$ = CHR$(2): CH2$ = CHR$(1)
223.    1820 IF S5 > 33 THEN SWAP CH1$, CH2$
224.    1830 LOCATE 7 + I, S5 + 1: COLOR 10: PRINT CH2$;
225.    1840 LOCATE 7 + I, 57: PRINT USING "####"; FNG(28);: COLOR 7
226.  
227.     1850 LOCATE 7 + I, C5 + 1: COLOR 11: PRINT CHR$(251);
228.    1860 LOCATE 7 + I, 64: PRINT USING "####"; FNG(33);: COLOR 7
229.  
230.     1870 LOCATE 7 + I, P5 + 1: COLOR 12: PRINT CHR$(3);
231.    1880 LOCATE 7 + I, 71: PRINT USING "####"; FNG(23);: COLOR 7
232.  
233.     1890 IF (S5 = 33) + (P5 = 33) + (C5 = 33) THEN LOCATE 7 + I, 79: COLOR 12 + 16: PRINT "**";: COLOR 7
234.  
235.     1900 IF FNG(28) = FNG(33) THEN LOCATE 7 + I, S5 + 1: PRINT " ";
236.    1910 IF FNG(28) = FNG(23) THEN LOCATE 7 + I, S5 + 1: PRINT " ";
237.    1920 IF FNG(23) = FNG(33) THEN LOCATE 7 + I, P5 + 1: PRINT " ";
238.     '----------------------FUNCTION2 DEFINITION END--------------------------------
239.  
240.  
241.  
242.     1930 IF Happy THEN GOSUB 2130
243.    1940 IF M2 <> 1 THEN 1980
244.    1950 IF D2 <> 1 THEN 1980
245.    1960 m$ = "* HAPPY NEW YEAR *"
246.    1970 GOSUB 2140
247. 1980 NEXT I
248. 1990 m$ = "Another chart? (Y/n) "
249. 2000 LOCATE ELine - LastLine, 1: PRINT STRING$(70, 32);
250. 2010 LOCATE ELine - LastLine, 1: COLOR 15: PRINT m$;
251. LastLine = 0
252. COLOR 7, 0
253. 2020 KY$ = INKEY$
254. 2030 IF KY$ = "" THEN 2020
255. 2040 IF UCASE$(KY$) = "N" THEN CLS: GOTO 3300
256. 2050 IF UCASE$(KY$) = "Y" THEN CLOSE: CLS: RUN
257. GOTO 2020
258. 2060 CLS: CLOSE: LOCATE , , 0: SYSTEM 'RUN "BIORHYTH.EXE"
259. 2080 MONTH$ = "JanFebMarAprMayJunJulAugSepOctNovDec"
260. 2090 MT$ = MID$(MONTH$, A9 * 3 - 2, 3)
261. 2100 RETURN
262. 2110 DDAY$ = "WedThuFriSatSunMonTue"
263. 2120 AY$ = MID$(DDAY$, B9 * 3 - 2, 3): RETURN
264. 2130 IF Happy THEN SWAP m$, Happy$
265. 2140 LOCATE 7 + I, 1:
266. IF Happy THEN COLOR LGreen + 16
267. PRINT m$;
268. COLOR 7
269. 2150 Happy = 0
270. 2160 RETURN
271. 2170 y1 = y - 1800
272. 2180 Q1 = INT(y1 / 4)
273. 2190 Q2 = INT(Q1 / 25)
274. 2200 Q3 = INT((y1 + 200) / 400)
275. 2210 K = 0
276. 2220 IF Q1 * 4 <> y1 THEN 2260
277. 2230 IF Q2 * 100 <> y1 THEN 2260
278. 2240 IF Q3 * 400 - 200 <> y1 THEN 2260
279. 2250 K = 1
280. 2260 T = 365 * y1 + Q1 - Q2 + Q3 - K
281. 2270 T = T + A(m) + DD - 1
282. 2280 IF m < 3 THEN 2300
283. 2290 T = T + K
284. 2300 IF INT(y1 / 4) <> y1 / 4 THEN 2330
285. 2310 IF m > 2 THEN 2330
286. 2320 T = T - 1
287. 2330 J = T - 7 * INT(T / 7)
288. 2340 RETURN
289. 2350 END
290. 2370 COLOR Cyan, 1: CLS
291. 2380 PRINT "                 C O M P A T A B I L I T Y    A N A L Y S I S"
292. 2390 PRINT
293. COLOR Yellow
294. 2400 PRINT "          Two individuals will have an average compatability of 100%"
295. 2410 PRINT "       ONLY if they were born on the same day, or if they were born"
296. 2420 PRINT "       21,252 days (58.1848 Years) apart.  ";
297. 2430 PRINT "Please do not be upset if": PRINT "       your compatability average is less than 100%!"
298. 2440 PRINT: IF NFME$ = "" THEN NFME$ = Name1$
299. COLOR Cyan
300. 2460 LOCATE 10, 16: PRINT "What is person one's name?  "; NFME$ + STRING$(8, 32);: LOCATE CSRLIN, 44: LINE INPUT A1$: IF A1$ = "" THEN A1$ = NFME$
301. 2470 Ne$ = A1$: Name1$ = Ne$
302. 2480 GOSUB 3760
303. 2490 A1$ = Ne$
304. 2500 NFME$ = A1$
305. 2510 'IF INSTR(A1$," ")>0 THEN 2550
306. 2520 GOSUB 3460
307. 2530 IF DT1 > 0 THEN SWAP A1$, N2$
308. 2540 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 2620
309. 2542 GOSUB 3910
310. 2543 IF WF$ = "N" THEN 2560
311. 2550 LOCATE 11, 16: PRINT "ENTER GENDER: ";: LINE INPUT Gender$: GOSUB 3870
312. 2560 LOCATE 11, 16: PRINT "What is "; A1$; "'s ";
313. INPUT "birthday (MM,DD,YYYY)"; m, DD, y: IF LEN(LTRIM$(STR$(y))) < 4 THEN 2560
314. 2570 IF m < 10 THEN AD3$ = "0" + RIGHT$(STR$(m), 1) ELSE AD3$ = RIGHT$(STR$(m), 2)
315. 2580 IF DD < 10 THEN AD4$ = "0" + RIGHT$(STR$(DD), 1) ELSE AD4$ = RIGHT$(STR$(DD), 2)
316. 2590 AD1$ = A1$: AD2$ = AD3$ + "-" + AD4$ + "-" + RIGHT$(STR$(y), 4)
317. 2600 IF WF$ = "N" THEN 2620
318. 2610 GOSUB 3640
319. 2620 E1 = m
320. 2630 F1 = DD
321. 2640 G1 = y
322. 2650 GOSUB 2170
323. 2660 Z2 = T
324. 2670 K1 = J + 1
325. 2680 PRINT: IF NFM1$ = "" THEN NFM1$ = Name2$
326. 2690 LOCATE 14, 16: PRINT "What is person two's name?  "; NFM1$ + STRING$(10, 32);: LOCATE CSRLIN, 44: LINE INPUT B1$: IF B1$ = "" THEN B1$ = NFM1$
327. 2700 Ne$ = B1$: Name2$ = Ne$
328. 2710 GOSUB 3760
329. 2720 B1$ = Ne$
330. 2730 NFM1$ = B1$
331. 2750 GOSUB 3460
332. 2760 IF DT1 > 0 THEN SWAP B1$, N2$
333. 2770 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 2860
334. 2775 GOSUB 3910
335. 2776 IF WF$ = "N" THEN 2790
336. 2780 LOCATE 15, 16: PRINT "ENTER GENDER: " + STRING$(50, 32);: LOCATE , 30: LINE INPUT Gender$: GOSUB 3870
337. 2790 LOCATE 15, 16: PRINT "What is "; B1$; "'s ";
338. 2800 INPUT "birthday  (MM,DD,YYYY)"; m, DD, y: IF LEN(LTRIM$(STR$(y))) < 4 THEN 2790
339. 2810 IF m < 10 THEN AD3$ = "0" + RIGHT$(STR$(m), 1) ELSE AD3$ = RIGHT$(STR$(m), 2)
340. 2820 IF DD < 10 THEN AD4$ = "0" + RIGHT$(STR$(DD), 1) ELSE AD4$ = RIGHT$(STR$(DD), 2)
341. 2830 AD1$ = B1$: AD2$ = AD3$ + "-" + AD4$ + "-" + RIGHT$(STR$(y), 4)
342. 2840 IF WF$ = "N" THEN 2860
343. 2850 GOSUB 3640
344. 2860 E2 = m
345. 2870 D2 = DD
346. 2880 G2 = y
347. 2890 GOSUB 2170
348. 2900 P2 = ABS(Z2 - T)
349. 2910 K2 = J + 1
350. 2930 COLOR 7, 0: CLS: ' BLOAD PATH$ + "biocomp.ovl"
351. 2950 LOCATE 11, 28: COLOR LGreen: PRINT A1$; " and "; B1$; ".";: COLOR LGRAY
352. 2960 LOCATE 13, 15: COLOR LGreen: PRINT A1$;: COLOR LGRAY: PRINT " was born on ";
353. 2970 B9 = K1
354. 2980 GOSUB 2110
355. 2990 COLOR LRed: PRINT AY$;: COLOR LGRAY: PRINT ", ";
356. 3000 A9 = E1
357. 3010 GOSUB 2080
358. 3020 PRINT MT$;
359. 3030 PRINT STR$(F1); ","; G1;
360. 3040 LOCATE 14, 15: COLOR LGreen: PRINT B1$;: COLOR LGRAY: PRINT " was born on ";
361. 3050 B9 = K2
362. 3060 GOSUB 2110
363. 3070 COLOR LRed: PRINT AY$;: COLOR LGRAY: PRINT ", ";
364. 3080 A9 = E2
365. 3090 GOSUB 2080
366. 3100 PRINT MT$;
367. 3110 PRINT STR$(D2); ","; G2;
368. 3130 Z = P2
369. 3150 P3 = ABS(INT(((Z / 23) - INT(Z / 23)) * 23))
370. 3160 S3 = ABS(INT(((Z / 28) - INT(Z / 28)) * 28))
371. 3170 C3 = ABS(INT(((Z / 33) - INT(Z / 33)) * 33))
372. 3180 P5 = ABS(100 - ((2 * P3) * (100 / 23)))
373. 3190 S5 = ABS(100 - ((2 * S3) * (100 / 28)))
374. 3200 C5 = ABS(100 - ((2 * C3) * (100 / 33)))
375. 3210 COLOR LRed: LOCATE 16, 55: PRINT USING CP$; P5
376. 3220 COLOR Cyan: LOCATE 17, 55: PRINT USING CP$; S5
377. 3230 COLOR Yellow: LOCATE 18, 55: PRINT USING CP$; C5
378. 3250 LOCATE 20, 55
379. 3260 A5 = (P5 + S5 + C5) / 3
380. 3270 COLOR Magenta: PRINT USING CP$; A5;: COLOR LGRAY
381. 3280 IF ELine = 43 THEN LastLine = 18
382. IF ELine = 25 THEN LastLine = 0
383. IF ELine = 50 THEN LastLine = 25
384. 3290 GOTO 1990
385. 3300 CLOSE: SYSTEM: ' RUN "BioRhyth.Exe"
386. 3310 CLS: SYSTEM: 'RUN "BIORHYTH.EXE"
387. 3320 LOCATE UU + 1, UUU + 1: PRINT STRING$(LEN(ab$), 32);: LOCATE UU + 1, UUU + 1
388. 3340 ab$ = ""
389. 3350 FOR I = 0 TO U
390.    3360 m$ = INPUT$(1)
391.    3370 IF m$ = CHR$(13) THEN 3420
392.     IF m$ = CHR$(29) THEN 3320
393.    3380 IF m$ = CHR$(8) THEN m$ = CHR$(29): GOTO 3320
394.     IF (m$ = " ") + (m$ = "'") THEN 3390
395.    3385 IF (ASC(UCASE$(m$)) < 48) + (ASC(UCASE$(m$)) > 90) THEN BEEP: GOTO 3360
396.    3390 ab$ = ab$ + m$
397.    3400 LOCATE UU + 1, UUU + I + 1: PRINT m$;
398. 3410 NEXT I
399. 3420 IF U = 3 THEN
400.     IF (LEN(ab$)) < 4 THEN 3320
401. END IF
402. IF U < 3 AND m$ = CHR$(13) THEN 3440
403. 3430 IF U < 3 THEN PRINT "-"; ELSE PRINT
404. 3440 RETURN
405. 3460 'CLOSE #1: OPEN "R", 1, pat2$ + "BIO.DAT", 60
406. 3470 'N1$ = ""
407. 3480 'FIELD 1, 30 AS N1$, 10 AS D1$, 8 AS D2$, 6 AS GE$, 1 AS DL$
408. 3490 'DT1 = 0
409. 3500 'GH = ASC(Ne$) - 64
410. 3510 'FOR SE = Start(GH) TO FINISH(GH)
411. 3520 'IF EOF(1) THEN 3620
412. 3530 'GET 1, SE
413. 3540 'IF LEFT$(N1$, 2) = "%%" THEN 3620
414. 3550 'IF DL$ = "I" THEN PIX = SE: GOTO 3580
415. 3570 'IF INSTR(1, N1$, Ne$) <> 0 THEN 3590
416. 3580 'NEXT SE
417. 3590 'N2$ = LEFT$(N1$, INSTR(1, N1$, "  ") - 1)
418. 3600 'Ne$ = N2$
419. 3610 'DT1 = VAL(MID$(D1$, 1, 2)): DT2 = VAL(MID$(D1$, 4, 2)): DT3 = VAL(RIGHT$(D1$, 4))
420. 3620 'CLOSE #1
421. 3630 RETURN
422. 3640 ON ERROR GOTO 3900
423. 3650 'CLOSE 1: OPEN "R", 1, pat2$ + "BIO.DAT", 60
424. 'FIELD 1, 30 AS N1$, 10 AS D1$, 8 AS D2$, 6 AS GE$, 1 AS DL$
425. 3660 'IF PIX THEN SE = PIX
426. 3670 'PIX = 0
427. 3680 'LSET N1$ = AD1$
428. 3690 'LSET D1$ = AD2$
429. 3700 'LSET D2$ = LEFT$(DATE$, 6) + RIGHT$(DATE$, 2)
430. 3710 'LSET GE$ = Gender$
431. 3720 'LSET DL$ = "A"
432. 3730 'PUT 1, SE
433. 3740 'CLOSE #1
434. 3750 RETURN
435. 3760 FOR I = 1 TO LEN(Ne$)
436.    3770 S1$ = MID$(Ne$, I, 1)
437.    3780 IF I = 1 THEN S1$ = MID$(Ne$, I, 1): IF S1$ < CHR$(97) OR S1$ > CHR$(122) THEN 3820 ELSE MID$(Ne$, I, 1) = CHR$(ASC(S1$) - 32)
438.    3790 IF S1$ = " " THEN I = I + 1: S1$ = MID$(Ne$, I, 1): IF S1$ < CHR$(97) OR S1$ > CHR$(122) THEN 3820 ELSE MID$(Ne$, I, 1) = CHR$(ASC(S1$) - 32)
439.    3800 IF S1$ < CHR$(65) OR S1$ > CHR$(91) THEN 3820
440.    3810 MID$(Ne$, I, 1) = CHR$(ASC(S1$) + 32)
441. 3820 NEXT I
442. 3830 RETURN
443. 3840 CLOSE: ' OPEN "O", 1, "BIOCHAIN.CFG": PRINT #1, "2": CLOSE #1
444. 3850 CLS: LOCATE 12, 31: PRINT "Loading Editor...";
445. 3860 SYSTEM: 'RUN "BioEdit.Prg"
446. 3861 SYSTEM: 'CLOSE : CLS : LOCATE 12, 31: PRINT "Loading Printout Program...": RUN "BioPrint.prg"
447.  
448. 3870 IF Gender$ = "" THEN Gender$ = "E"
449. 3875 MID$(Gender$, 1, 1) = UCASE$(LEFT$(Gender$, 1)): MID$(Gender$, 2) = LCASE$(MID$(Gender$, 2))
450. 3890 RETURN
451. 3900 RESUME NEXT
452. 3910 BEEP: NOF$ = " is not on file.  Do you want to file (Y/N) ?"
453. LOCATE 23, 1: PRINT Ne$; NOF$;
454. 3911 WF$ = UCASE$(INKEY$): IF WF$ = "" THEN 3911
455. 3916 IF INSTR("YN", WF$) = 0 THEN 3911
456. LOCATE 23, 1: PRINT STRING$(79, 32);
457. 3920 RETURN
458.  
459. FUNCTION FNA (Z)
460.     FNA = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
461. END FUNCTION
462. FUNCTION FNG (Z)
463.     FNG = 100 * SIN(V / Z * P#)
464. END FUNCTION
465. FUNCTION FNB ()
466.     FNB = V - 28 * INT(V / 28) + 1
467. END FUNCTION
468. FUNCTION FNC ()
469.     FNC = V - 23 * INT(V / 23) + 1
470. END FUNCTION
471. FUNCTION FND
472.     FND = V - 33 * INT(V / 33) + 1
473. END FUNCTION
474.  
475.  
476.  

[Cobalt]

I just converted the functions, I did give thought to keeping them inline with code.  I think B+ has it.

[GeorgeLee]

Thank You!, Thank You!, Thank You!  I looked over the code and haven't found the actual trick you used, but it works great.  Now, I will apply YOUR changes to the "printer" module and when I apply them, I may see where I went wrong.  Again, Thank You.   About 3 years after I first wrote/translated it, an officer from the Los Angeles Police Department download it to do some studies of accidents at certain intersections and, he telephone me and told me that it was scary how accurate it appeared to be.  I tried to find someone to translate it to Visual Basic so I could have some of the "fancy" windows graphics but couldn't find anyone (they didn't like my code structure).  As I was writing it, I would get more ideas of what to add and used a lot of "gosub" routines.

In a couple of weeks after my back heals from sitting here, I will put the complete software with the overlays, modules, etc. on http://www.oiccs.com/biorhyth.zip if you would like a copy.  It will include the source code, i.e. *.bas files.  The web page also contains my email address.  If I can ever help you with anything, please don't hesitate to ask.
Thanks again,
George

[bplus]

Sounds like it worked. :)

I just changed the functions like Cobalt did, only I SHARED V and P# so they could be read from the FUNCTION code without adding more parameters, so the FNx's kept the original single or 0 parameters. So all that happened was the FNx's part was commented out the first 2 lines to SHARED variables for FUNCTIONs and last lines to replace FNx's.

Gold Star to QB64 remaining compatible.