Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Convert .BAS code to Visual Basic 4

Posted on 2001-08-24
6
588 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
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

 
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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Copy a row 12 64
How to hault or freeze parent form when a 2d form is open in vb6 3 39
Set email body to html using vbscript 6 49
How can my static class become undefined?? 8 62
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

840 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