Solved

Convert .BAS code to Visual Basic 4

Posted on 2001-08-24
6
572 Views
Last Modified: 2013-11-25
In the site:
http://www.skypub.com/resources/software/basic/basic.html#list
exists the file - MOONUP.BAS - in Basic.
Can somebody  convert it to VB4 code?
0
Comment
Question by:giann
6 Comments
 
LVL 14

Expert Comment

by:wsh2
ID: 6424354
MOONUP.BAS Source

<----- Code Begin ----->

10 REM        MOONRISE-MOONSET
15 GOSUB 170
20 INPUT "LAT, LONG (DEG)";B5,L5
25 INPUT "TIME ZONE (HRS)";H
30 L5=L5/360: Z0=H/24
35 GOSUB 760: T=(J-2451545)+F
40 GOSUB 245: T=T+Z0
45 REM
50 REM      POSITION LOOP
55 FOR I=1 TO 3
60 GOSUB 495: M(I,1)=A5
65 M(I,2)=D5: M(I,3)=R5: T=T+0.5
70 NEXT
75 IF M(2,1)>M(1,1) THEN 85
80 M(2,1)=M(2,1)+P2
85 IF M(3,1)>M(2,1) THEN 95
90 M(3,1)=M(3,1)+P2
95 Z1=R1*(90.567-41.685/M(2,3))
100 S=SIN(B5*R1): C=COS(B5*R1)
105 Z=COS(Z1): M8=0: W8=0: PRINT
110 A0=M(1,1): D0=M(1,2)
115 FOR C0=0 TO 23
120 P=(C0+1)/24
125 F0=M(1,1):F1=M(2,1):F2=M(3,1)
130 GOSUB 225: A2=F
135 F0=M(1,2):F1=M(2,2):F2=M(3,2)
140 GOSUB 225: D2=F
145 GOSUB 285: A0=A2:D0=D2:V0=V2
150 NEXT
155 GOSUB 450: REM  SPECIAL MSG?
160 END
165 REM
170 REM        CONSTANTS
175 DIM M(3,3)
180 P1=3.14159265: P2=2*P1
185 R1=P1/180: K1=15*R1*1.0027379
190 S$="MOONSET AT  "
195 R$="MOONRISE AT "
200 M1$="NO MOONRISE THIS DATE"
205 M2$="NO MOONSET THIS DATE"
210 M3$="MOON DOWN ALL DAY"
215 M4$="MOON UP ALL DAY"
220 RETURN
225 REM    3-POINT INTERPOLATION
230 A=F1-F0: B=F2-F1-A
235 F=F0+P*(2*A+B*(2*P-1))
240 RETURN
245 REM     LST AT 0H ZONE TIME
250 T0=T/36525
255 S=24110.5+8640184.813*T0
260 S=S+86636.6*Z0+86400*L5
265 S=S/86400: S=S-INT(S)
270 T0=S*360*R1
275 RETURN
280 REM
285 REM  TEST AN HOUR FOR AN EVENT
290 L0=T0+C0*K1: L2=L0+K1
295 IF A2<A0 THEN A2=A2+2*P1
300 H0=L0-A0: H2=L2-A2
305 H1=(H2+H0)/2: REM  HOUR ANGLE
310 D1=(D2+D0)/2: REM  DEC
315 IF C0>0 THEN 325
320 V0=S*SIN(D0)+C*COS(D0)*COS(H0)-Z
325 V2=S*SIN(D2)+C*COS(D2)*COS(H2)-Z
330 IF SGN(V0)=SGN(V2) THEN 440
335 V1=S*SIN(D1)+C*COS(D1)*COS(H1)-Z
340 A=2*V2-4*V1+2*V0: B=4*V1-3*V0-V2
345 D=B*B-4*A*V0: IF D<0 THEN 440
350 D=SQR(D)
355 IF V0<0 AND V2>0 THEN PRINT R$;
360 IF V0<0 AND V2>0 THEN M8=1
365 IF V0>0 AND V2<0 THEN PRINT S$;
370 IF V0>0 AND V2<0 THEN W8=1
375 E=(-B+D)/(2*A)
380 IF E>1 OR E<0 THEN E=(-B-D)/(2*A)
385 T3=C0+E+1/120: REM ROUND OFF
390 H3=INT(T3): M3=INT((T3-H3)*60)
395 PRINT USING "##:##";H3;M3;
400 H7=H0+E*(H2-H0)
405 N7=-COS(D1)*SIN(H7)
410 D7=C*SIN(D1)-S*COS(D1)*COS(H7)
415 A7=ATN(N7/D7)/R1
420 IF D7<0 THEN A7=A7+180
425 IF A7<0 THEN A7=A7+360
430 IF A7>360 THEN A7=A7-360
435 PRINT USING ",  AZ ###.#";A7
440 RETURN
445 REM
450 REM   SPECIAL MESSAGE ROUTINE
455 IF M8=0 AND W8=0 THEN 475
460 IF M8=0 THEN PRINT M1$
465 IF W8=0 THEN PRINT M2$
470 GOTO 485
475 IF V2<0 THEN PRINT M3$
480 IF V2>0 THEN PRINT M4$
485 RETURN
490 REM
495 REM   FUNDAMENTAL ARGUMENTS
500 L=0.606434+0.03660110129*T
505 M=0.374897+0.03629164709*T
510 F=0.259091+0.03674819520*T
515 D=0.827362+0.03386319198*T
520 N=0.347343-0.00014709391*T
525 G=0.993126+0.00273777850*T
530 L=L-INT(L): M=M-INT(M)
535 F=F-INT(F): D=D-INT(D)
540 N=N-INT(N): G=G-INT(G)
545 L=L*P2: M=M*P2: F=F*P2
550 D=D*P2: N=N*P2: G=G*P2
555 V=0.39558*SIN(F+N)
560 V=V+0.08200*SIN(F)
565 V=V+0.03257*SIN(M-F-N)
570 V=V+0.01092*SIN(M+F+N)
575 V=V+0.00666*SIN(M-F)
580 V=V-0.00644*SIN(M+F-2*D+N)
585 V=V-0.00331*SIN(F-2*D+N)
590 V=V-0.00304*SIN(F-2*D)
595 V=V-0.00240*SIN(M-F-2*D-N)
600 V=V+0.00226*SIN(M+F)
605 V=V-0.00108*SIN(M+F-2*D)
610 V=V-0.00079*SIN(F-N)
615 V=V+0.00078*SIN(F+2*D+N)
620 U=1-0.10828*COS(M)
625 U=U-0.01880*COS(M-2*D)
630 U=U-0.01479*COS(2*D)
635 U=U+0.00181*COS(2*M-2*D)
640 U=U-0.00147*COS(2*M)
645 U=U-0.00105*COS(2*D-G)
650 U=U-0.00075*COS(M-2*D+G)
655 W=0.10478*SIN(M)
660 W=W-0.04105*SIN(2*F+2*N)
665 W=W-0.02130*SIN(M-2*D)
670 W=W-0.01779*SIN(2*F+N)
675 W=W+0.01774*SIN(N)
680 W=W+0.00987*SIN(2*D)
685 W=W-0.00338*SIN(M-2*F-2*N)
690 W=W-0.00309*SIN(G)
695 W=W-0.00190*SIN(2*F)
700 W=W-0.00144*SIN(M+N)
705 W=W-0.00144*SIN(M-2*F-N)
710 W=W-0.00113*SIN(M+2*F+2*N)
715 W=W-0.00094*SIN(M-2*D+G)
720 W=W-0.00092*SIN(2*M-2*D)
725 REM
730 REM    COMPUTE RA, DEC, DIST
735 S=W/SQR(U-V*V)
740 A5=L+ATN(S/SQR(1-S*S))
745 S=V/SQR(U):D5=ATN(S/SQR(1-S*S))
750 R5=60.40974*SQR(U)
755 RETURN
760 REM     CALENDAR --> JD
765 INPUT "Y,M,D ";Y,M,D
770 G=1: IF Y<1582 THEN G=0
775 D1=INT(D): F=D-D1-0.5
780 J=-INT(7*(INT((M+9)/12)+Y)/4)
785 IF G=0 THEN 805
790 S=SGN(M-9): A=ABS(M-9)
795 J3=INT(Y+S*INT(A/7))
800 J3=-INT((INT(J3/100)+1)*3/4)
805 J=J+INT(275*M/9)+D1+G*J3
810 J=J+1721027+2*G+367*Y
815 IF F>=0 THEN 825
820 F=F+1: J=J-1
825 RETURN
900 REM  ***************************
910 REM  THIS PROGRAM COMPUTES THE
920 REM  TIMES OF MOONRISE AND MOON-
930 REM  SET ANYWHERE IN THE WORLD.
940 REM  FROM SKY & TELESCOPE, JULY,
950 REM  1989, PAGE 78.
960 REM  ***************************

<----- Code End ----->
0
 
LVL 14

Expert Comment

by:wsh2
ID: 6424357
MOONUP.BAS Credits

Sky & Telescope magazine is pleased to make available in machine-readable form the programs that have been published in its monthly Astronomical Computing department, which first appeared in April 1984. These are offered as-is and without support; most back issues of S&T from 1985 to the present are still available.

Whenever possible the programs are written in simple generic BASIC, but there are unavoidable variations from one interpreter to another. In case of difficulties, check your BASIC manual. A few programs require specific graphics adapters or printers. Why BASIC, you ask? See Stuart Goldman's article, "BASICally Speaking," adapted from the April 1996 issue of S&T.

At the end of each program is a block indicating the issue of the magazine in which the program appeared together with supporting text and instructions. If you have any questions, please consult the original articles.

0
 

Author Comment

by:giann
ID: 6424548
The code above is in .bas
The question is to be converted to VB4
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6425407
Hearing...
0
 
LVL 39

Accepted Solution

by:
appari earned 300 total points
ID: 6425795
i have no idea of astronomical calculations. just i converted BASIC code to a VB procedure. Just removed BASIC branching and made it compile error free.

i didnt removed linenos so that it may help you in finding errors. i couldn't test this sub because i have no idea of astronomical calculations. check it may be you can use it with little modifications.

'****************************************
'****************************************
'****************************************

Public Sub MoonRISEnSET()

10 Rem        MOONRISE-MOONSET
15

170 Rem        CONSTANTS
175 Dim M1111(3, 3) As Long
180 P1 = 3.14159265: P2 = 2 * P1
185 R1 = P1 / 180: K1 = 15 * R1 * 1.0027379
190 S$ = "MOONSET AT  "
195 R$ = "MOONRISE AT "
200 M1$ = "NO MOONRISE THIS DATE"
205 M2$ = "NO MOONSET THIS DATE"
210 M3$ = "MOON DOWN ALL DAY"
215 M4$ = "MOON UP ALL DAY"
220 'Return


20  InputBox "LAT(DEG)", B5
    InputBox "LONG (DEG)", L5

25 InputBox "TIME ZONE (HRS)", H
30 L5 = L5 / 360: Z0 = H / 24

35 'GoSub 760:

760 Rem     CALENDAR --> JD
765 InputBox "Y ", Y
    InputBox "M ", M
    InputBox "D ", D
   
770 G = 1: If Y < 1582 Then G = 0
775 D1 = Int(D): F = D - D1 - 0.5
780 J = -Int(7 * (Int((M + 9) / 12) + Y) / 4)
785 If G <> 0 Then 'GoTo 805
790     S = Sgn(M - 9): A = Abs(M - 9)
795     J3 = Int(Y + S * Int(A / 7))
800     J3 = -Int((Int(J3 / 100) + 1) * 3 / 4)
    End If
805 J = J + Int(275 * M / 9) + D1 + G * J3
810 J = J + 1721027 + 2 * G + 367 * Y
815 If F < 0 Then 'GoTo 825
820     F = F + 1
        J = J - 1
    End If
825 'Return


T = (J - 2451545) + F
40 'GoSub 245:

245 Rem     LST AT 0H ZONE TIME
250 T0 = T / 36525
255 S = 24110.5 + 8640184.813 * T0
260 S = S + 86636.6 * Z0 + 86400 * L5
265 S = S / 86400: S = S - Int(S)
270 T0 = S * 360 * R1
275 'Return
T = T + Z0


45 Rem
50 Rem      POSITION LOOP
55 For I = 1 To 3
60 'GoSub 495:
495 Rem   FUNDAMENTAL ARGUMENTS
500     L = 0.606434 + 0.03660110129 * T
505     M = 0.374897 + 0.03629164709 * T
510     F = 0.259091 + 0.0367481952 * T
515     D = 0.827362 + 0.03386319198 * T
520     N = 0.347343 - 0.00014709391 * T
525     G = 0.993126 + 0.0027377785 * T
530     L = L - Int(L): M = M - Int(M)
535     F = F - Int(F): D = D - Int(D)
540     N = N - Int(N): G = G - Int(G)
545     L = L * P2: M = M * P2: F = F * P2
550     D = D * P2: N = N * P2: G = G * P2
555     V = 0.39558 * Sin(F + N)
560     V = V + 0.082 * Sin(F)
565     V = V + 0.03257 * Sin(M - F - N)
570     V = V + 0.01092 * Sin(M + F + N)
575     V = V + 0.00666 * Sin(M - F)
580     V = V - 0.00644 * Sin(M + F - 2 * D + N)
585     V = V - 0.00331 * Sin(F - 2 * D + N)
590     V = V - 0.00304 * Sin(F - 2 * D)
595     V = V - 0.0024 * Sin(M - F - 2 * D - N)
600     V = V + 0.00226 * Sin(M + F)
605     V = V - 0.00108 * Sin(M + F - 2 * D)
610     V = V - 0.00079 * Sin(F - N)
615     V = V + 0.00078 * Sin(F + 2 * D + N)
620     U = 1 - 0.10828 * Cos(M)
625     U = U - 0.0188 * Cos(M - 2 * D)
630     U = U - 0.01479 * Cos(2 * D)
635     U = U + 0.00181 * Cos(2 * M - 2 * D)
640     U = U - 0.00147 * Cos(2 * M)
645     U = U - 0.00105 * Cos(2 * D - G)
650     U = U - 0.00075 * Cos(M - 2 * D + G)
655     W = 0.10478 * Sin(M)
660     W = W - 0.04105 * Sin(2 * F + 2 * N)
665     W = W - 0.0213 * Sin(M - 2 * D)
670     W = W - 0.01779 * Sin(2 * F + N)
675     W = W + 0.01774 * Sin(N)
680     W = W + 0.00987 * Sin(2 * D)
685     W = W - 0.00338 * Sin(M - 2 * F - 2 * N)
690     W = W - 0.00309 * Sin(G)
695     W = W - 0.0019 * Sin(2 * F)
700     W = W - 0.00144 * Sin(M + N)
705     W = W - 0.00144 * Sin(M - 2 * F - N)
710     W = W - 0.00113 * Sin(M + 2 * F + 2 * N)
715     W = W - 0.00094 * Sin(M - 2 * D + G)
720     W = W - 0.00092 * Sin(2 * M - 2 * D)
725 Rem
730 Rem    COMPUTE RA, DEC, DIST
735     S = W / Sqr(U - V * V)
740     A5 = L + Atn(S / Sqr(1 - S * S))
745     S = V / Sqr(U): D5 = Atn(S / Sqr(1 - S * S))
750     R5 = 60.40974 * Sqr(U)
755 'Return
        M1111(I, 1) = A5
65      M1111(I, 2) = D5: M1111(I, 3) = R5: T = T + 0.5
70  Next

75  If M1111(2, 1) <= M1111(1, 1) Then 'GoTo 85
80      M1111(2, 1) = M1111(2, 1) + P2
    End If
85  If M1111(3, 1) <= M1111(2, 1) Then 'GoTo 95
90      M1111(3, 1) = M1111(3, 1) + P2
    End If
95  Z1 = R1 * (90.567 - 41.685 / M1111(2, 3))
100 S = Sin(B5 * R1): C = Cos(B5 * R1)
105 Z = Cos(Z1): M8 = 0: W8 = 0 ': Print
110 A0 = M1111(1, 1): D0 = M1111(1, 2)
115 For C0 = 0 To 23
120     P = (C0 + 1) / 24
125     F0 = M1111(1, 1): F1 = M1111(2, 1): F2 = M1111(3, 1)
130 'GoSub 225:
225 Rem    3-POINT INTERPOLATION
230     A = F1 - F0: B = F2 - F1 - A
235     F = F0 + P * (2 * A + B * (2 * P - 1))
240 'Return

        A2 = F
135     F0 = M1111(1, 2): F1 = M1111(2, 2): F2 = M1111(3, 2)
140 'GoSub 225:
2251 'Rem    3-POINT INTERPOLATION
2301     A = F1 - F0: B = F2 - F1 - A
2351     F = F0 + P * (2 * A + B * (2 * P - 1))
2401 'Return

        D2 = F
145 'GoSub 285:
285 Rem  TEST AN HOUR FOR AN EVENT
290 L0 = T0 + C0 * K1: L2 = L0 + K1
295 If A2 < A0 Then A2 = A2 + 2 * P1
300 H0 = L0 - A0: H2 = L2 - A2
305 H1 = (H2 + H0) / 2: Rem  HOUR ANGLE
310 D1 = (D2 + D0) / 2: Rem  DEC
315 If C0 <= 0 Then 'GoTo 325
320     V0 = S * Sin(D0) + C * Cos(D0) * Cos(H0) - Z
    End If
325 V2 = S * Sin(D2) + C * Cos(D2) * Cos(H2) - Z
330 If Sgn(V0) = Sgn(V2) Then GoTo 440
335 V1 = S * Sin(D1) + C * Cos(D1) * Cos(H1) - Z
340 A = 2 * V2 - 4 * V1 + 2 * V0: B = 4 * V1 - 3 * V0 - V2
345 D = B * B - 4 * A * V0: If D < 0 Then GoTo 440
350 D = Sqr(D)
3551 If V0 < 0 And V2 > 0 Then Form1.Print R$;
360 If V0 < 0 And V2 > 0 Then M8 = 1
365 If V0 > 0 And V2 < 0 Then Form1.Print S$;
370 If V0 > 0 And V2 < 0 Then W8 = 1
375 E = (-B + D) / (2 * A)
380 If E > 1 Or E < 0 Then E = (-B - D) / (2 * A)
385 T3 = C0 + E + 1 / 120: Rem ROUND OFF
390 H3 = Int(T3): M3 = Int((T3 - H3) * 60)
395 Form1.Print USING; "##:##"; H3; M3;
400 H7 = H0 + E * (H2 - H0)
405 N7 = -Cos(D1) * Sin(H7)
410 D7 = C * Sin(D1) - S * Cos(D1) * Cos(H7)
415 A7 = Atn(N7 / D7) / R1
420 If D7 < 0 Then A7 = A7 + 180
425 If A7 < 0 Then A7 = A7 + 360
430 If A7 > 360 Then A7 = A7 - 360
435 Form1.Print USING; ",  AZ ###.#"; A7
440 'Return

A0 = A2: D0 = D2: V0 = V2
150 Next
155 'GoSub 450: Rem  SPECIAL MSG?
160 'End
165 Rem



280 Rem
445 Rem
450 Rem   SPECIAL MESSAGE ROUTINE
455 If Not (M8 = 0 And W8 = 0) Then 'GoTo 475
460     If M8 = 0 Then Form1.Print M1$
465     If W8 = 0 Then Form1.Print M2$
    Else
470 'GoTo 485
475     If V2 < 0 Then Form1.Print M3$
480     If V2 > 0 Then Form1.Print M4$
    End If
485 'Return
490 Rem
900 Rem  ***************************
910 Rem  THIS PROGRAM COMPUTES THE
920 Rem  TIMES OF MOONRISE AND MOON-
930 Rem  SET ANYWHERE IN THE WORLD.
940 Rem  FROM SKY & TELESCOPE, JULY,
950 Rem  1989, PAGE 78.
960 Rem  ***************************


End Sub

0
 

Author Comment

by:giann
ID: 6425945
For appari:
Right. For this conversion the important is to know the language and not astronomy.
Thanks, I check it.
 
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now