Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Développement Développement Visual Basic Problème de langage qb->vb ???

Problème de langage qb->vb ???

12 réponses
Avatar
LE TROLL
Bonjour,

Ça entre dans les attributions du forum le
"basic", QB, ici, j'ai ça:

6500 '....................MODULE "PRESUB"
6505 '
6510 If TJ < 2299226.5 Then K = 1
6515 DJ = TJ - JJ0: If K = 1 Then DJ = DJ - DN
6520 If TJ < 2299226.5 And A / 4 = Fix(A / 4) Then
F = 1: GoTo 6545
6525 If TJ >= 2299226.5 And A = 1582 And K = 0
Then DJ = DJ + 10
6530 If A / 4 = Fix(A / 4) Then F = 1
6535 If K = 1 Then GoTo 6545
6540 If A / 100 = Fix(A / 100) And A / 400 <>
Fix(A / 400) Then F = 0
6545 If DJ > 58 Then DJ = DJ - F
6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE
6555 Data 242, SEPTEMBRE, 211, AOUT, 180, JUILLET
6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58,
mars, 1000, IXE
6565 READ XK, md
6570 If XK = 1000 Then GoTo 6585
6575 If Fix(DJ - 0.5) >= XK Then GoTo 6595
6580 GoTo 6565
6585 If DJ > 30 Then XK = 30: md = "FEVRIER": GoTo
6595
6590 XK = -1: md = "JANVIER"
6595 J = DJ - XK
6600 If DJ > 333 And J >= 31.5 Then A = A + 1: J =
J - 31: md = "JANVIER"
6605 J0 = Fix(J): HH = (J - J0) * 24: H = Fix(HH):
MM = (HH - H) * 60
6610 MN = Fix(MM): S = Fix((MM - MN) * 60): H = H
+ 12
6615 If H >= 24 Then H = H - 24: J0 = J0 + 1
6620 RESTORE: Return
-------------------

Mon problème est ici:

6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE
6555 Data 242, SEPTEMBRE, 211, AOUT, 180, JUILLET
6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58,
mars, 1000, IXE
6565 READ XK, md

VB6 ne reconnaît pas "READ" et cette forme "data"
(ce doit être ce qu'on appelle la compatibilité
ascendante ?).
J'ai souvenir dans un basic BAL de Prolog-Bull
d'une instruction read, qui faisait comme un
buffer, une variable qui se lisait en séquence,
puis qui se vidait (gain de place), et que pour
réutiliser, il fallait recharger par Read, mais je
ne me souviens plus...

Je serai tenté d'écrire par exemple:

If md = "DECEMBRE" then XK = 333

Mais je ne suis sûr de rien!

Donc, svp, comment mettre ça en terme
intelligibles pour VB ???



--
Merci beaucoup, au revoir et à bientôt :o)
------
Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
------------------------------------------------------------------------------------
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Jacques93
LE TROLL a écrit :
Bonjour,

Ça entre dans les attributions du forum le
"basic", QB, ici, j'ai ça:

6500 '....................MODULE "PRESUB"
6505 '
6510 If TJ < 2299226.5 Then K = 1
6515 DJ = TJ - JJ0: If K = 1 Then DJ = DJ - DN
6520 If TJ < 2299226.5 And A / 4 = Fix(A / 4) Then
F = 1: GoTo 6545
6525 If TJ >= 2299226.5 And A = 1582 And K = 0
Then DJ = DJ + 10
6530 If A / 4 = Fix(A / 4) Then F = 1
6535 If K = 1 Then GoTo 6545
6540 If A / 100 = Fix(A / 100) And A / 400 <>
Fix(A / 400) Then F = 0
6545 If DJ > 58 Then DJ = DJ - F
6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE
6555 Data 242, SEPTEMBRE, 211, AOUT, 180, JUILLET
6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58,
mars, 1000, IXE
6565 READ XK, md
6570 If XK = 1000 Then GoTo 6585
6575 If Fix(DJ - 0.5) >= XK Then GoTo 6595
6580 GoTo 6565
6585 If DJ > 30 Then XK = 30: md = "FEVRIER": GoTo
6595
6590 XK = -1: md = "JANVIER"
6595 J = DJ - XK
6600 If DJ > 333 And J >= 31.5 Then A = A + 1: J =
J - 31: md = "JANVIER"
6605 J0 = Fix(J): HH = (J - J0) * 24: H = Fix(HH):
MM = (HH - H) * 60
6610 MN = Fix(MM): S = Fix((MM - MN) * 60): H = H
+ 12
6615 If H >= 24 Then H = H - 24: J0 = J0 + 1
6620 RESTORE: Return
-------------------

Mon problème est ici:

6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE
6555 Data 242, SEPTEMBRE, 211, AOUT, 180, JUILLET
6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58,
mars, 1000, IXE
6565 READ XK, md

VB6 ne reconnaît pas "READ" et cette forme "data"
(ce doit être ce qu'on appelle la compatibilité
ascendante ?).
J'ai souvenir dans un basic BAL de Prolog-Bull
d'une instruction read, qui faisait comme un
buffer, une variable qui se lisait en séquence,
puis qui se vidait (gain de place), et que pour
réutiliser, il fallait recharger par Read, mais je
ne me souviens plus...

Je serai tenté d'écrire par exemple:

If md = "DECEMBRE" then XK = 333



Je ne crois pas, la valeur de XK et md sont assignées simultanément, il
n'y a pas de test à faire. Sauf peut être pour la sortie de boucle (XK =
1000) cela dépend de la manière dont on transpose ...

Mais je ne suis sûr de rien!

Donc, svp, comment mettre ça en terme
intelligibles pour VB ???



D'après mes souvenirs :
le 1er READ XK, md => XK = 333; md = "DECEMBRE"
le 2eme XK = 303; md = "NOVEMBRE"
le 3eme XK = 272; md = "OCTOBRE"
etc ...
le dernier XK 00; md= "IXE"

le plus simple, me semble t-il, pour transposer cela en VB est
d'utiliser un tableau à deux dimensions et une boucle For ... Next à la
place du READ ... GOTO

Un petit rappel sur QBasic en français (voir page 5, section 4.2) :

http://www.laurentconstantin.com/common/utilordi/a2langages/qbasic.doc

--
Cordialement,

Jacques.
Avatar
Patrice Henrio
LE TROLL a écrit :
Bonjour,

Ça entre dans les attributions du forum le
"basic", QB, ici, j'ai ça:

6500 '....................MODULE "PRESUB"
6505 '
6510 If TJ < 2299226.5 Then K = 1
6515 DJ = TJ - JJ0: If K = 1 Then DJ = DJ - DN
6520 If TJ < 2299226.5 And A / 4 = Fix(A / 4) Then
F = 1: GoTo 6545
6525 If TJ >= 2299226.5 And A = 1582 And K = 0
Then DJ = DJ + 10
6530 If A / 4 = Fix(A / 4) Then F = 1
6535 If K = 1 Then GoTo 6545
6540 If A / 100 = Fix(A / 100) And A / 400 <>
Fix(A / 400) Then F = 0
6545 If DJ > 58 Then DJ = DJ - F
6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE
6555 Data 242, SEPTEMBRE, 211, AOUT, 180, JUILLET
6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58,
mars, 1000, IXE
6565 READ XK, md
6570 If XK = 1000 Then GoTo 6585
6575 If Fix(DJ - 0.5) >= XK Then GoTo 6595
6580 GoTo 6565
6585 If DJ > 30 Then XK = 30: md = "FEVRIER": GoTo
6595
6590 XK = -1: md = "JANVIER"
6595 J = DJ - XK
6600 If DJ > 333 And J >= 31.5 Then A = A + 1: J =
J - 31: md = "JANVIER"
6605 J0 = Fix(J): HH = (J - J0) * 24: H = Fix(HH):
MM = (HH - H) * 60
6610 MN = Fix(MM): S = Fix((MM - MN) * 60): H = H
+ 12
6615 If H >= 24 Then H = H - 24: J0 = J0 + 1
6620 RESTORE: Return
-------------------

Mon problème est ici:

6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE
6555 Data 242, SEPTEMBRE, 211, AOUT, 180, JUILLET
6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58,
mars, 1000, IXE
6565 READ XK, md

VB6 ne reconnaît pas "READ" et cette forme "data"
(ce doit être ce qu'on appelle la compatibilité
ascendante ?).
J'ai souvenir dans un basic BAL de Prolog-Bull
d'une instruction read, qui faisait comme un
buffer, une variable qui se lisait en séquence,
puis qui se vidait (gain de place), et que pour
réutiliser, il fallait recharger par Read, mais je
ne me souviens plus...

Je serai tenté d'écrire par exemple:

If md = "DECEMBRE" then XK = 333

Mais je ne suis sûr de rien!

Donc, svp, comment mettre ça en terme
intelligibles pour VB ???






Sub Presub(TJ As Double, JJ0 As Double, DN As Double, A As Long, J As
Double)
Dim K As Long, DJ As Double, F As Long, J0 As Long, MD As String,
HH As Double, H As Long, MM As Double, MN As Long
Dim data As String, donnees() As String, I As Long, XK As Long, S
As Long
DJ = TJ - JJ0
If TJ < 2299226.5 Then
DJ = DJ - DN
'attention ici visiblement les années bissextiles ne sont
pas traitées de la même façon
'que dans la branche else
If (A Mod 4 = 0) Then F = 1
Else
If A = 1582 Then DJ = DJ + 10
'Bissextile si multiple de 400 ou multiple de 4 et non
multiple de 100
If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A Mod 100) <> 0)
Then F = 1 Else F = 0
If DJ > 58 Then DJ = DJ - F
End If
data = "333, DECEMBRE, 303, NOVEMBRE, 272, OCTOBRE, 242, SEPTEMBRE,
211, AOUT, 180, JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars, 1000,
IXE"
donnees = Split(data, ", ")
I = 0
Do
XK = donnees(I)
I = I + 1
MD = donnees(I)
I = I + 1
If (XK = 1000) Then
If DJ > 30 Then
XK = 30
MD = "FEVRIER"
Else
XK = -1
MD = "JANVIER"
End If
Exit Do
End If
If (Fix(DJ - 0.5) >= XK) Then Exit Do
Loop
J = DJ - XK
If (DJ > 333) And (J >= 31.5) Then
A = A + 1
J = J - 31
MD = "JANVIER"
End If
J0 = Fix(J)
HH = (J - J0) * 24
H = Fix(HH)
MM = (HH - H) * 60
MN = Fix(MM)
S = Fix(MM - MN) * 60
H = H + 12
If H >= 24 Then
H = H - 24
J0 = J0 + 1
End If
End Sub

En espérant que la fonction fix de qbasic est équivalente à celle de VB
c'est la traduction logiquement équivalente de ton programme qbasic.

J'ai remarqué comme indiqué dans le programme que le traitement des
années bissextiles n'est pas le même suivant que TJ soit inférieur ou
non à 2299226.5
Avatar
Patrice Henrio
LE TROLL a écrit :
Bonjour,

Ça entre dans les attributions du forum le
"basic", QB, ici, j'ai ça:

6500 '....................MODULE "PRESUB"
6505 '
6510 If TJ < 2299226.5 Then K = 1
6515 DJ = TJ - JJ0: If K = 1 Then DJ = DJ - DN
6520 If TJ < 2299226.5 And A / 4 = Fix(A / 4) Then
F = 1: GoTo 6545
6525 If TJ >= 2299226.5 And A = 1582 And K = 0
Then DJ = DJ + 10
6530 If A / 4 = Fix(A / 4) Then F = 1
6535 If K = 1 Then GoTo 6545
6540 If A / 100 = Fix(A / 100) And A / 400 <>
Fix(A / 400) Then F = 0
6545 If DJ > 58 Then DJ = DJ - F
6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE
6555 Data 242, SEPTEMBRE, 211, AOUT, 180, JUILLET
6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58,
mars, 1000, IXE
6565 READ XK, md
6570 If XK = 1000 Then GoTo 6585
6575 If Fix(DJ - 0.5) >= XK Then GoTo 6595
6580 GoTo 6565
6585 If DJ > 30 Then XK = 30: md = "FEVRIER": GoTo
6595
6590 XK = -1: md = "JANVIER"
6595 J = DJ - XK
6600 If DJ > 333 And J >= 31.5 Then A = A + 1: J =
J - 31: md = "JANVIER"
6605 J0 = Fix(J): HH = (J - J0) * 24: H = Fix(HH):
MM = (HH - H) * 60
6610 MN = Fix(MM): S = Fix((MM - MN) * 60): H = H
+ 12
6615 If H >= 24 Then H = H - 24: J0 = J0 + 1
6620 RESTORE: Return
-------------------

Mon problème est ici:

6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE
6555 Data 242, SEPTEMBRE, 211, AOUT, 180, JUILLET
6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58,
mars, 1000, IXE
6565 READ XK, md

VB6 ne reconnaît pas "READ" et cette forme "data"
(ce doit être ce qu'on appelle la compatibilité
ascendante ?).
J'ai souvenir dans un basic BAL de Prolog-Bull
d'une instruction read, qui faisait comme un
buffer, une variable qui se lisait en séquence,
puis qui se vidait (gain de place), et que pour
réutiliser, il fallait recharger par Read, mais je
ne me souviens plus...

Je serai tenté d'écrire par exemple:

If md = "DECEMBRE" then XK = 333

Mais je ne suis sûr de rien!

Donc, svp, comment mettre ça en terme
intelligibles pour VB ???





petite erreur
la ligne : If DJ > 58 Then DJ = DJ - F
doit se trouver à l'extérieur du if et non dedans

If DJ > 58 Then DJ = DJ - F
End If

doit donc s'écrire

End If
If DJ > 58 Then DJ = DJ - F

ce qui donne :

Sub Presub(TJ As Double, JJ0 As Double, DN As Double, A As Long, J As
Double)
Dim K As Long, DJ As Double, F As Long, J0 As Long
Dim data As String, donnees() As String, I As Long, XK As Long, MDF
As String
DJ = TJ - JJ0
If TJ < 2299226.5 Then
DJ = DJ - DN
'attention ici visiblement les années bissextiles ne sont
pas traitées de la même façon
'que dans la branche else
If (A Mod 4 = 0) Then F = 1
Else
If A = 1582 Then DJ = DJ + 10
'Bissextile si multiple de 400 ou multiple de 4 et non
multiple de 100
If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A Mod 100) <> 0)
Then F = 1 Else F = 0
End If
If DJ > 58 Then DJ = DJ - F
data = "333, DECEMBRE, 303, NOVEMBRE, 272, OCTOBRE, 242, SEPTEMBRE,
211, AOUT, 180, JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars, 1000,
IXE"
donnees = Split(data, ", ")
I = 0
Do
XK = donnees(I)
I = I + 1
md = donnees(I)
I = I + 1
If (XK = 1000) Then
If DJ > 30 Then
XK = 30
md = "FEVRIER"
Else
XK = -1
md = "JANVIER"
End If
Exit Do
End If
If (Fix(DJ - 0.5) >= XK) Then Exit Do
Loop
J = DJ - XK
If (DJ > 333) And (J >= 31.5) Then
A = A + 1
J = J - 31
md = "JANVIER"
End If
J0 = Fix(J)
HH = (J - J0) * 24
H = Fix(HH)
MM = (HH - H) * 60
MN = Fix(MM)
S = Fix(MM - MN) * 60
H = H + 12
If H >= 24 Then
H = H - 24
J0 = J0 + 1
End If
End Sub
Avatar
Patrice Henrio
Patrice Henrio a écrit :
LE TROLL a écrit :
Bonjour,

Ça entre dans les attributions du forum le "basic", QB, ici, j'ai ça:

6500 '....................MODULE "PRESUB"
6505 '
6510 If TJ < 2299226.5 Then K = 1
6515 DJ = TJ - JJ0: If K = 1 Then DJ = DJ - DN
6520 If TJ < 2299226.5 And A / 4 = Fix(A / 4) Then F = 1: GoTo 6545
6525 If TJ >= 2299226.5 And A = 1582 And K = 0 Then DJ = DJ + 10
6530 If A / 4 = Fix(A / 4) Then F = 1
6535 If K = 1 Then GoTo 6545
6540 If A / 100 = Fix(A / 100) And A / 400 <> Fix(A / 400) Then F = 0
6545 If DJ > 58 Then DJ = DJ - F
6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272, OCTOBRE
6555 Data 242, SEPTEMBRE, 211, AOUT, 180, JUILLET
6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58, mars, 1000, IXE
6565 READ XK, md
6570 If XK = 1000 Then GoTo 6585
6575 If Fix(DJ - 0.5) >= XK Then GoTo 6595
6580 GoTo 6565
6585 If DJ > 30 Then XK = 30: md = "FEVRIER": GoTo 6595
6590 XK = -1: md = "JANVIER"
6595 J = DJ - XK
6600 If DJ > 333 And J >= 31.5 Then A = A + 1: J = J - 31: md = "JANVIER"
6605 J0 = Fix(J): HH = (J - J0) * 24: H = Fix(HH): MM = (HH - H) * 60
6610 MN = Fix(MM): S = Fix((MM - MN) * 60): H = H + 12
6615 If H >= 24 Then H = H - 24: J0 = J0 + 1
6620 RESTORE: Return
-------------------

Mon problème est ici:

6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272, OCTOBRE
6555 Data 242, SEPTEMBRE, 211, AOUT, 180, JUILLET
6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58, mars, 1000, IXE
6565 READ XK, md

VB6 ne reconnaît pas "READ" et cette forme "data" (ce doit être ce
qu'on appelle la compatibilité ascendante ?).
J'ai souvenir dans un basic BAL de Prolog-Bull d'une instruction read,
qui faisait comme un buffer, une variable qui se lisait en séquence,
puis qui se vidait (gain de place), et que pour réutiliser, il fallait
recharger par Read, mais je ne me souviens plus...

Je serai tenté d'écrire par exemple:

If md = "DECEMBRE" then XK = 333

Mais je ne suis sûr de rien!

Donc, svp, comment mettre ça en terme intelligibles pour VB ???





petite erreur
la ligne : If DJ > 58 Then DJ = DJ - F
doit se trouver à l'extérieur du if et non dedans

If DJ > 58 Then DJ = DJ - F
End If

doit donc s'écrire

End If
If DJ > 58 Then DJ = DJ - F

ce qui donne :

Sub Presub(TJ As Double, JJ0 As Double, DN As Double, A As Long, J As
Double)
Dim K As Long, DJ As Double, F As Long, J0 As Long
Dim data As String, donnees() As String, I As Long, XK As Long, MDF
As String
DJ = TJ - JJ0
If TJ < 2299226.5 Then
DJ = DJ - DN
'attention ici visiblement les années bissextiles ne sont
pas traitées de la même façon
'que dans la branche else
If (A Mod 4 = 0) Then F = 1
Else
If A = 1582 Then DJ = DJ + 10
'Bissextile si multiple de 400 ou multiple de 4 et non
multiple de 100
If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A Mod 100) <> 0)
Then F = 1 Else F = 0
End If
If DJ > 58 Then DJ = DJ - F
data = "333, DECEMBRE, 303, NOVEMBRE, 272, OCTOBRE, 242, SEPTEMBRE,
211, AOUT, 180, JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars, 1000,
IXE"
donnees = Split(data, ", ")
I = 0
Do
XK = donnees(I)
I = I + 1
md = donnees(I)
I = I + 1
If (XK = 1000) Then
If DJ > 30 Then
XK = 30
md = "FEVRIER"
Else
XK = -1
md = "JANVIER"
End If
Exit Do
End If
If (Fix(DJ - 0.5) >= XK) Then Exit Do
Loop
J = DJ - XK
If (DJ > 333) And (J >= 31.5) Then
A = A + 1
J = J - 31
md = "JANVIER"
End If
J0 = Fix(J)
HH = (J - J0) * 24
H = Fix(HH)
MM = (HH - H) * 60
MN = Fix(MM)
S = Fix(MM - MN) * 60
H = H + 12
If H >= 24 Then
H = H - 24
J0 = J0 + 1
End If
End Sub


quand ça ne veut pas marcher !!!
les lignes litigieuses sont remplacées par de slignes ne commençant pas
par ">"
> Sub Presub(TJ As Double, JJ0 As Double, DN As Double, A As Long, J As
> Double)

Dim K As Long, DJ As Double, F As Long, J0 As Long, MD As String,
HH As Double, H As Long, MM As Double, MN As Long
Dim data As String, donnees() As String, I As Long, XK As Long, S
As Long

> DJ = TJ - JJ0
> If TJ < 2299226.5 Then
> DJ = DJ - DN
> 'attention ici visiblement les années bissextiles ne sont
> pas traitées de la même façon
> 'que dans la branche else
> If (A Mod 4 = 0) Then F = 1
> Else
> If A = 1582 Then DJ = DJ + 10
> 'Bissextile si multiple de 400 ou multiple de 4 et non
> multiple de 100
> If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A Mod 100) <> 0)
> Then F = 1 Else F = 0
> End If
> If DJ > 58 Then DJ = DJ - F
> data = "333, DECEMBRE, 303, NOVEMBRE, 272, OCTOBRE, 242, SEPTEMBRE,
> 211, AOUT, 180, JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars, 1000,
> IXE"

'attention le séparateur est virgule + espace
donnees = Split(data, ", ")

> I = 0
> Do
> XK = donnees(I)
> I = I + 1
> md = donnees(I)
> I = I + 1
> If (XK = 1000) Then
> If DJ > 30 Then
> XK = 30
> md = "FEVRIER"
> Else
> XK = -1
> md = "JANVIER"
> End If
> Exit Do
> End If
> If (Fix(DJ - 0.5) >= XK) Then Exit Do
> Loop
> J = DJ - XK
> If (DJ > 333) And (J >= 31.5) Then
> A = A + 1
> J = J - 31
> md = "JANVIER"
> End If
> J0 = Fix(J)
> HH = (J - J0) * 24
> H = Fix(HH)
> MM = (HH - H) * 60
> MN = Fix(MM)
> S = Fix(MM - MN) * 60
> H = H + 12
> If H >= 24 Then
> H = H - 24
> J0 = J0 + 1
> End If
> End Sub

espérons que ce soit la bonne
Avatar
LE TROLL
Oh là là, merci Patrice, quel travail
espérons que ça marche, c'est d'autant plus
pénible que le mec écrit comme un cochon, il saut
à la ligne seulement quand il a le temps, collant
tout abec ":"

Comment on l'appelle ?

Call Presub(TJ, JJ0, DN, A, J) ': GoSub 6500

Ça, ça marche pas, je ne suis pas doué en passage
de paramètres...

Sinon, j'ai collé ça:

Sub Presub(TJ As Double, JJ0 As Double, DN As
Double, A As Long, J As Double)
Dim K As Long, DJ As Double, F As Long, J0 As
Long
Dim data As String, donnees() As String, I As
Long, XK As Long, MDF As String
DJ = TJ - JJ0
If TJ < 2299226.5 Then
DJ = DJ - DN
'attention ici visiblement les années
bissextiles ne sont pas traitées de la même façon
que dans la branche else
If (A Mod 4 = 0) Then F = 1
Else
If A = 1582 Then DJ = DJ + 10
'Bissextile si multiple de 400 ou multiple
de 4 et non multiple de 100
If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A
Mod 100) <> 0) Then F = 1 Else F = 0
End If
If DJ > 58 Then DJ = DJ - F
'data = "333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE, 242, SEPTEMBRE, " 211, AOUT, 180,
JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars,
1000, IXE ""
donnees = Split(data, ", ")
I = 0
Do
XK = donnees(I)
I = I + 1
md = donnees(I)
I = I + 1
If (XK = 1000) Then
If DJ > 30 Then
XK = 30
md = "FEVRIER"
Else
XK = -1
md = "JANVIER"
End If
Exit Do
End If
If (Fix(DJ - 0.5) >= XK) Then Exit Do
Loop
J = DJ - XK
If (DJ > 333) And (J >= 31.5) Then
A = A + 1
J = J - 31
md = "JANVIER"
End If
J0 = Fix(J)
HH = (J - J0) * 24
H = Fix(HH)
MM = (HH - H) * 60
MN = Fix(MM)
S = Fix(MM - MN) * 60
H = H + 12
If H >= 24 Then
H = H - 24
J0 = J0 + 1
End If
End Sub



------------
J'ai inhibé les commande fichier que j'avais mis
pour faire un fichier sous dos avec GwBasic je
crois, qui ensuite est embarqué (ben voui, c'est
mieux que rien :o)
qui donne au total :
------------



Sub saisons()
'MODULE "PRSAISON"
Dim B, D, E, J, L, M, N, O, P, T, V
Dim ma As String
Dim ya(12) As String
Dim za(12) As String
Dim ja As String
'
15 A = YYYY 'A = 2002
' Color 7, 1: Cls
' Dim numfic As Integer
' numfic = FreeFile
' Open "Saisons.txt" For Output As numfic

20 'A = A + 1
PI = 3.14159265
25 RA1 = PI / 180: RA2 = PI / 12:
30 KK = 2
35 M = 1: J = 1: H = 0
40 GoSub 500: LS1 = LS: JJ2 = JJ: JJ0 = JJ
45 JJ1 = 1671383#: GoSub 6700: PRL0 = PRL
50 If KK = 2 Then PRL = 0: PRL0 = 0
55 KC = Fix((LS1 - PRL) / 30) + 4: If KC > 12 Then
KC = KC - 12
60 L0 = 30 * (KC - 3): KC0 = KC
65
70
75 za(1) = "": za(2) = "": za(3) = ""
80 za(4) = "": za(5) = "": za(6) = ""
85 za(7) = "": za(8) = "": za(9) = ""
90 za(10) = "": za(11) = ""
95 za(12) = "": ya(3) = " PRINTEMPS"
100 ya(6) = " ETE ": ya(9) = " AUTOMNE ":
ya(12) = " HIVER "
105
110 GoSub 170: GoSub 515: LS1 = LS
115 GoSub 170: GoSub 515: LS1 = LS
120 JJ = JJ - 0.5: TJ = JJ
Call Presub(TJ, JJ0, DN, A, J) ': GoSub 6500

125 If KC = 3 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 6 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 9 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 12 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If
130

135 LS = L0: JJ = JJ + 0.5: L0 = L0 + 30: KC = KC
+ 1: K = 0
140 If L0 >= 360 Then L0 = L0 - 360
145 If KC > 12 Then KC = KC - 12
150 If KC = KC0 Then GoTo 165
155 If KK = 1 Then PRL = PRL0 + KC * 0.00012
160 GoTo 110

'-----------------------
165 'If A < 2051 Then GoTo 20
'If A > 2050 Then
' Close numfic
' End
' End If
Exit Sub
'-----------------------

170 JJ = JJ + 1: H = 0: GoSub 515: LS2 = LS
175 If LS2 < LS1 Then LS2 = LS2 + 360
180 DLJ = LS2 - LS1: DDJ = (L0 + PRL - LS1) / DLJ
185 If DDJ < -100 Then DDJ = DDJ + 360 / DLJ
190 JJ = JJ - 1 + DDJ
195 Return

500 '....................MODULE "SOL"
505 '
510 GoSub 6000: JJ = JJ - DN
515 BJ = JJ - 2451545#
520 TJ = Fix(BJ - HJ) / 36525#
525 T = BJ / 36525#
530 If A >= 1900 Then VL = -0.2837 * T - 0.248:
GoTo 545
535 VL = -0.00008304245 * T ^ 4 - 0.005673214 * T
^ 3 - 0.0005050719 * T ^ 2
540 VL = VL - 0.259827 * T - 0.248274
545 Lo = LO0 - VL * KEPH
550 LSM = 280.4659 + 36000.76953 * T + 0.0003025 *
T ^ 2
555 BK = LSM: GoSub 5000: LSM = BK
560 PS = 282.9405 + 1.72009 * T + 0.0004628 * T ^
2 + 0.00000033 * T ^ 3
565 BK = PS: GoSub 5000: PS = BK
570 ES = 0.016709114 - 0.000042052 * T -
0.000000126 * T ^ 2
575 MS = LSM - PS: MR = MS * RA1: E = ES
580 GoSub 5050: VS = V / RA1
585 LS = PS + VS: BK = LS: GoSub 5000: LS = BK:
AXS = 1.00000023
590 XS = AXS * (1 - ES ^ 2) / (1 + ES * Cos(V))
595 TX = BJ / 365242.2
600 OB = 23.43928 - 0.1301403 * TX - 0.00014163 *
TX ^ 2 + 0.00050833 * TX ^ 3
605 OBR = OB * RA1
610 TS = 280.4603 + 36000.7697 * TJ + 0.00038708 *
TJ ^ 2
615 BK = TS: GoSub 5000: TS0 = BK
620 TS = (H - 12) * 36624.22 / 36524.22 + TS0 / 15
+ Lo / 15
625 If TS < 0 Then TS = TS + 24
630 If TS > 24 Then TS = TS - 24
635 LL = 218.31617 + 481267.88088 * T - 0.00112767
* T ^ 2 + 0.000001888 * T ^ 3
640 BK = LL: GoSub 5000: LL = BK
645 NL = 125.043347 - 1934.137846 * T + 0.00208444
* T ^ 2 + 0.000002222 * T ^ 3
650 BK = NL: GoSub 5000: NL = BK
655 PL = 83.353248 + 4069.013343 * T - 0.0103625 *
T ^ 2 - 0.0000125 * T ^ 3
660 BK = PL: GoSub 5000: PL = BK
665 r = (LL - LSM) * RA1: D = (LL - NL) * RA1: G =
(LL - PL) * RA1: W = MR
670 NU = -17.2327 * Sin(NL * RA1) / 3600 - 1.2729
* Sin(LSM * RA1 * 2) / 3600
675 NU = NU + 0.2088 * Sin(2 * NL * RA1) / 3600 -
0.2037 * Sin(LL * 2 * RA1) / 3600
680 NOB = 9.21 * Cos(NL * RA1) / 3600 + 0.5522 *
Cos(LSM * RA1 * 2) / 3600
685 OB = OB + NOB: OBR = OB * RA1
690 TS = TS + NU * Cos(OBR) / 15: SS = 0.266567 /
XS
695 ASO = -20.496 * (1 + ES * Cos(V)) / 3600
700 LS = PS + VS + NU + ASO + 0.0018 * Sin(r): BK
= LS: GoSub 5000
705 LS = Fix(BK * 10000) / 10000: LL = Fix(LL *
1000) / 1000
710 x = TS: GoSub 5100
715 Return

4990 '....................MODULE "RED"
4995 '
5000 '....................MODULE "REDCAD"
5005 IK = Fix(BK / 360): BK = BK - IK * 360: If BK
< 0 Then BK = BK + 360
5010 Return
5050 '....................MODULE "ANOMAL"
5055 U = MR
5060 U1 = MR + E * Sin(U): If Abs(U - U1) <
0.000001 Then GoTo 5070
5065 U = U1: GoTo 5060
5070 TV = Sqr((1 + E) / (1 - E)) * Tan(U / 2)
5075 V = Atn(TV) * 2: If V < 0 Then V = V + PI * 2
5080 Return
5100 '....................MODULE "REDSEX"
5105 If x < 0 Then x = -x: Y = -1 Else Y = 1
5110 X1 = Fix(x): X2 = Fix((x - X1) * 60): X3 =
Fix((x - X1 - X2 / 60) * 36000!) / 10
5115 Return
5200 '....................MODULE "REDHEUR"
5205 J0 = Fix(J): HH = (J - J0) * 24: H = Fix(HH):
MM = (HH - H) * 60
5210 MN = Fix(MM): S = Fix((MM - MN) * 60): H = H
+ 12 - DH
5215 If H >= 24 Then H = H - 24: J0 = J0 + 1
5220 H = H - 12: If H < 0 Then H = H + 24: J0 =
J0 - 1
5225 Return

6000 '....................MODULE "JULIEN"
6005 '
6010 C = A Mod 4: B = A + 4712: N = B * 365 +
Fix((B + 3) / 4)
6015 N0 = N: DN = 0: If C = 0 Then F = 1: FJ = 1
Else F = 0: FJ = 0
6020 If A > 1582 Then DN = 10
6025 If A = 1582 And M = 12 And J > 19 Then DN =
10
6030 If A >= 1700 Then GoTo 6035 Else GoTo 6040
6035 DM = -Fix((A - 1) / 100) + 12 + Fix((A - 1) /
400): N0 = N
6040 If A / 400 <> Fix(A / 400) And A / 100 =
Fix(A / 100) Then F = 0
6045 DN = DN - DM
6050 If M <= 8 Then N = N + (M - 1) * 30 + Fix(M /
2)
6055 If M > 8 Then N = N + (M - 1) * 30 + Fix((M -
1) / 2) + 1
6060 If M >= 3 And F = 1 Then N = N - 1
6065 If M >= 3 And F = 0 Then N = N - 2 + FJ: DN =
DN + FJ
6070 JJ = N + J - 1.5: HJ = H / 24: JJ = JJ + HJ
6075 JE = Fix(JJ + 0.5) - N0 + 1: JE = JE Mod 365
6080 If JJ <= 2299236# Then GoTo 6090
6085 If JJ > 2299236# And A = 1582 Then JE = JE -
10
6090 Return

6100 '....................MODULE "JOUR"
6105 '
6110 Q = Fix(JJ) - Fix(JJ / 7) * 7 + 2
6115 If JJ - Fix(JJ) >= 0.5 Then Q = Q + 1
6120 If Q > 7 Then Q = Q - 7
6125 If Q = 1 Then ja = "DIMANCHE"
6130 If Q = 2 Then ja = "LUNDI"
6135 If Q = 3 Then ja = "MARDI"
6140 If Q = 4 Then ja = "MERCREDI"
6145 If Q = 5 Then ja = "JEUDI"
6150 If Q = 6 Then ja = "VENDREDI"
6155 If Q = 7 Then ja = "SAMEDI"
6160 Return
End Sub


Sub Presub(TJ As Double, JJ0 As Double, DN As
Double, A As Long, J As Double)
Dim K As Long, DJ As Double, F As Long, J0 As
Long
Dim data As String, donnees() As String, I As
Long, XK As Long, MDF As String
DJ = TJ - JJ0
If TJ < 2299226.5 Then
DJ = DJ - DN
'attention ici visiblement les années
bissextiles ne sont pas traitées de la même façon
que dans la branche else
If (A Mod 4 = 0) Then F = 1
Else
If A = 1582 Then DJ = DJ + 10
'Bissextile si multiple de 400 ou multiple
de 4 et non multiple de 100
If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A
Mod 100) <> 0) Then F = 1 Else F = 0
End If
If DJ > 58 Then DJ = DJ - F
'data = "333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE, 242, SEPTEMBRE, " 211, AOUT, 180,
JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars,
1000, IXE ""
donnees = Split(data, ", ")
I = 0
Do
XK = donnees(I)
I = I + 1
md = donnees(I)
I = I + 1
If (XK = 1000) Then
If DJ > 30 Then
XK = 30
md = "FEVRIER"
Else
XK = -1
md = "JANVIER"
End If
Exit Do
End If
If (Fix(DJ - 0.5) >= XK) Then Exit Do
Loop
J = DJ - XK
If (DJ > 333) And (J >= 31.5) Then
A = A + 1
J = J - 31
md = "JANVIER"
End If
J0 = Fix(J)
HH = (J - J0) * 24
H = Fix(HH)
MM = (HH - H) * 60
MN = Fix(MM)
S = Fix(MM - MN) * 60
H = H + 12
If H >= 24 Then
H = H - 24
J0 = J0 + 1
End If
End Sub
Avatar
LE TROLL
Bonjour Jacques, merci.

J'ai essayé en faisant une affectation directe
comme tu fais, en gros, mais reste que cette
partie est appelée à la fois par un gosub, non pas
sur une étiquette, mais sur un numéro de ligne
(peut être que c'est pareil pour gwBasic ?), et
est appelée de même, par un "restore" à l'autre
bout !

En tout cas, ça ne produit pas l'effet
escompté...

Je vais voir aussi du côté de Patrice, qui m'a
fait une procédure, sauf que je ne sais pas
comment l'appeler: "par son nom", oui :o)

--
Merci beaucoup, au revoir et à bientôt :o)
------
Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
------------------------------------------------------------------------------------
"Jacques93" a écrit dans le
message de news:
eVEV%
| LE TROLL a écrit :
| > Bonjour,
| >
| > Ça entre dans les attributions du forum le
| > "basic", QB, ici, j'ai ça:
| >
| > 6500 '....................MODULE "PRESUB"
| > 6505 '
| > 6510 If TJ < 2299226.5 Then K = 1
| > 6515 DJ = TJ - JJ0: If K = 1 Then DJ = DJ - DN
| > 6520 If TJ < 2299226.5 And A / 4 = Fix(A / 4)
Then
| > F = 1: GoTo 6545
| > 6525 If TJ >= 2299226.5 And A = 1582 And K = 0
| > Then DJ = DJ + 10
| > 6530 If A / 4 = Fix(A / 4) Then F = 1
| > 6535 If K = 1 Then GoTo 6545
| > 6540 If A / 100 = Fix(A / 100) And A / 400 <>
| > Fix(A / 400) Then F = 0
| > 6545 If DJ > 58 Then DJ = DJ - F
| > 6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272,
| > OCTOBRE
| > 6555 Data 242, SEPTEMBRE, 211, AOUT, 180,
JUILLET
| > 6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58,
| > mars, 1000, IXE
| > 6565 READ XK, md
| > 6570 If XK = 1000 Then GoTo 6585
| > 6575 If Fix(DJ - 0.5) >= XK Then GoTo 6595
| > 6580 GoTo 6565
| > 6585 If DJ > 30 Then XK = 30: md = "FEVRIER":
GoTo
| > 6595
| > 6590 XK = -1: md = "JANVIER"
| > 6595 J = DJ - XK
| > 6600 If DJ > 333 And J >= 31.5 Then A = A + 1:
J | > J - 31: md = "JANVIER"
| > 6605 J0 = Fix(J): HH = (J - J0) * 24: H =
Fix(HH):
| > MM = (HH - H) * 60
| > 6610 MN = Fix(MM): S = Fix((MM - MN) * 60): H
= H
| > + 12
| > 6615 If H >= 24 Then H = H - 24: J0 = J0 + 1
| > 6620 RESTORE: Return
| > -------------------
| >
| > Mon problème est ici:
| >
| > 6550 Data 333, DECEMBRE, 303, NOVEMBRE, 272,
| > OCTOBRE
| > 6555 Data 242, SEPTEMBRE, 211, AOUT, 180,
JUILLET
| > 6560 Data 150, JUIN, 119, MAI, 89, AVRIL, 58,
| > mars, 1000, IXE
| > 6565 READ XK, md
| >
| > VB6 ne reconnaît pas "READ" et cette forme
"data"
| > (ce doit être ce qu'on appelle la
compatibilité
| > ascendante ?).
| > J'ai souvenir dans un basic BAL de Prolog-Bull
| > d'une instruction read, qui faisait comme un
| > buffer, une variable qui se lisait en
séquence,
| > puis qui se vidait (gain de place), et que
pour
| > réutiliser, il fallait recharger par Read,
mais je
| > ne me souviens plus...
| >
| > Je serai tenté d'écrire par exemple:
| >
| > If md = "DECEMBRE" then XK = 333
|
| Je ne crois pas, la valeur de XK et md sont
assignées simultanément, il
| n'y a pas de test à faire. Sauf peut être pour
la sortie de boucle (XK | 1000) cela dépend de la manière dont on
transpose ...
|
| > Mais je ne suis sûr de rien!
| >
| > Donc, svp, comment mettre ça en terme
| > intelligibles pour VB ???
|
| D'après mes souvenirs :
| le 1er READ XK, md => XK = 333; md =
"DECEMBRE"
| le 2eme XK = 303; md =
"NOVEMBRE"
| le 3eme XK = 272; md =
"OCTOBRE"
| etc ...
| le dernier XK 00; md= "IXE"
|
| le plus simple, me semble t-il, pour transposer
cela en VB est
| d'utiliser un tableau à deux dimensions et une
boucle For ... Next à la
| place du READ ... GOTO
|
| Un petit rappel sur QBasic en français (voir
page 5, section 4.2) :
|
|
http://www.laurentconstantin.com/common/utilordi/a2langages/qbasic.doc
|
| --
| Cordialement,
|
| Jacques.
Avatar
Patrice Henrio
LE TROLL a écrit :
Oh là là, merci Patrice, quel travail
espérons que ça marche, c'est d'autant plus
pénible que le mec écrit comme un cochon, il saut
à la ligne seulement quand il a le temps, collant
tout abec ":"

Comment on l'appelle ?

Call Presub(TJ, JJ0, DN, A, J) ': GoSub 6500

Ça, ça marche pas, je ne suis pas doué en passage
de paramètres...




A la place du gosub
tu écris simplement
Presub(TJ,JJ0,DN,A,J)
avec TJ, JJ0, DN, A et J sont les variables initialisées auparavant dans
le programme (je pense que A est l'année)




Sinon, j'ai collé ça:

Sub Presub(TJ As Double, JJ0 As Double, DN As
Double, A As Long, J As Double)
Dim K As Long, DJ As Double, F As Long, J0 As
Long
Dim data As String, donnees() As String, I As
Long, XK As Long, MDF As String
DJ = TJ - JJ0
If TJ < 2299226.5 Then
DJ = DJ - DN
'attention ici visiblement les années
bissextiles ne sont pas traitées de la même façon
que dans la branche else
If (A Mod 4 = 0) Then F = 1
Else
If A = 1582 Then DJ = DJ + 10
'Bissextile si multiple de 400 ou multiple
de 4 et non multiple de 100
If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A
Mod 100) <> 0) Then F = 1 Else F = 0
End If
If DJ > 58 Then DJ = DJ - F
'data = "333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE, 242, SEPTEMBRE, " 211, AOUT, 180,
JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars,
1000, IXE ""
donnees = Split(data, ", ")
I = 0
Do
XK = donnees(I)
I = I + 1
md = donnees(I)
I = I + 1
If (XK = 1000) Then
If DJ > 30 Then
XK = 30
md = "FEVRIER"
Else
XK = -1
md = "JANVIER"
End If
Exit Do
End If
If (Fix(DJ - 0.5) >= XK) Then Exit Do
Loop
J = DJ - XK
If (DJ > 333) And (J >= 31.5) Then
A = A + 1
J = J - 31
md = "JANVIER"
End If
J0 = Fix(J)
HH = (J - J0) * 24
H = Fix(HH)
MM = (HH - H) * 60
MN = Fix(MM)
S = Fix(MM - MN) * 60
H = H + 12
If H >= 24 Then
H = H - 24
J0 = J0 + 1
End If
End Sub





















------------
J'ai inhibé les commande fichier que j'avais mis
pour faire un fichier sous dos avec GwBasic je
crois, qui ensuite est embarqué (ben voui, c'est
mieux que rien :o)
qui donne au total :
------------



Sub saisons()
'MODULE "PRSAISON"
Dim B, D, E, J, L, M, N, O, P, T, V
Dim ma As String
Dim ya(12) As String
Dim za(12) As String
Dim ja As String
'
15 A = YYYY 'A = 2002
' Color 7, 1: Cls
' Dim numfic As Integer
' numfic = FreeFile
' Open "Saisons.txt" For Output As numfic

20 'A = A + 1
PI = 3.14159265
25 RA1 = PI / 180: RA2 = PI / 12:
30 KK = 2
35 M = 1: J = 1: H = 0
40 GoSub 500: LS1 = LS: JJ2 = JJ: JJ0 = JJ
45 JJ1 = 1671383#: GoSub 6700: PRL0 = PRL
50 If KK = 2 Then PRL = 0: PRL0 = 0
55 KC = Fix((LS1 - PRL) / 30) + 4: If KC > 12 Then
KC = KC - 12
60 L0 = 30 * (KC - 3): KC0 = KC
65
70
75 za(1) = "": za(2) = "": za(3) = ""
80 za(4) = "": za(5) = "": za(6) = ""
85 za(7) = "": za(8) = "": za(9) = ""
90 za(10) = "": za(11) = ""
95 za(12) = "": ya(3) = " PRINTEMPS"
100 ya(6) = " ETE ": ya(9) = " AUTOMNE ":
ya(12) = " HIVER "
105
110 GoSub 170: GoSub 515: LS1 = LS
115 GoSub 170: GoSub 515: LS1 = LS
120 JJ = JJ - 0.5: TJ = JJ
Call Presub(TJ, JJ0, DN, A, J) ': GoSub 6500

125 If KC = 3 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 6 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 9 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 12 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If
130

135 LS = L0: JJ = JJ + 0.5: L0 = L0 + 30: KC = KC
+ 1: K = 0
140 If L0 >= 360 Then L0 = L0 - 360
145 If KC > 12 Then KC = KC - 12
150 If KC = KC0 Then GoTo 165
155 If KK = 1 Then PRL = PRL0 + KC * 0.00012
160 GoTo 110

'-----------------------
165 'If A < 2051 Then GoTo 20
'If A > 2050 Then
' Close numfic
' End
' End If
Exit Sub
'-----------------------

170 JJ = JJ + 1: H = 0: GoSub 515: LS2 = LS
175 If LS2 < LS1 Then LS2 = LS2 + 360
180 DLJ = LS2 - LS1: DDJ = (L0 + PRL - LS1) / DLJ
185 If DDJ < -100 Then DDJ = DDJ + 360 / DLJ
190 JJ = JJ - 1 + DDJ
195 Return

500 '....................MODULE "SOL"
505 '
510 GoSub 6000: JJ = JJ - DN
515 BJ = JJ - 2451545#
520 TJ = Fix(BJ - HJ) / 36525#
525 T = BJ / 36525#
530 If A >= 1900 Then VL = -0.2837 * T - 0.248:
GoTo 545
535 VL = -0.00008304245 * T ^ 4 - 0.005673214 * T
^ 3 - 0.0005050719 * T ^ 2
540 VL = VL - 0.259827 * T - 0.248274
545 Lo = LO0 - VL * KEPH
550 LSM = 280.4659 + 36000.76953 * T + 0.0003025 *
T ^ 2
555 BK = LSM: GoSub 5000: LSM = BK
560 PS = 282.9405 + 1.72009 * T + 0.0004628 * T ^
2 + 0.00000033 * T ^ 3
565 BK = PS: GoSub 5000: PS = BK
570 ES = 0.016709114 - 0.000042052 * T -
0.000000126 * T ^ 2
575 MS = LSM - PS: MR = MS * RA1: E = ES
580 GoSub 5050: VS = V / RA1
585 LS = PS + VS: BK = LS: GoSub 5000: LS = BK:
AXS = 1.00000023
590 XS = AXS * (1 - ES ^ 2) / (1 + ES * Cos(V))
595 TX = BJ / 365242.2
600 OB = 23.43928 - 0.1301403 * TX - 0.00014163 *
TX ^ 2 + 0.00050833 * TX ^ 3
605 OBR = OB * RA1
610 TS = 280.4603 + 36000.7697 * TJ + 0.00038708 *
TJ ^ 2
615 BK = TS: GoSub 5000: TS0 = BK
620 TS = (H - 12) * 36624.22 / 36524.22 + TS0 / 15
+ Lo / 15
625 If TS < 0 Then TS = TS + 24
630 If TS > 24 Then TS = TS - 24
635 LL = 218.31617 + 481267.88088 * T - 0.00112767
* T ^ 2 + 0.000001888 * T ^ 3
640 BK = LL: GoSub 5000: LL = BK
645 NL = 125.043347 - 1934.137846 * T + 0.00208444
* T ^ 2 + 0.000002222 * T ^ 3
650 BK = NL: GoSub 5000: NL = BK
655 PL = 83.353248 + 4069.013343 * T - 0.0103625 *
T ^ 2 - 0.0000125 * T ^ 3
660 BK = PL: GoSub 5000: PL = BK
665 r = (LL - LSM) * RA1: D = (LL - NL) * RA1: G =
(LL - PL) * RA1: W = MR
670 NU = -17.2327 * Sin(NL * RA1) / 3600 - 1.2729
* Sin(LSM * RA1 * 2) / 3600
675 NU = NU + 0.2088 * Sin(2 * NL * RA1) / 3600 -
0.2037 * Sin(LL * 2 * RA1) / 3600
680 NOB = 9.21 * Cos(NL * RA1) / 3600 + 0.5522 *
Cos(LSM * RA1 * 2) / 3600
685 OB = OB + NOB: OBR = OB * RA1
690 TS = TS + NU * Cos(OBR) / 15: SS = 0.266567 /
XS
695 ASO = -20.496 * (1 + ES * Cos(V)) / 3600
700 LS = PS + VS + NU + ASO + 0.0018 * Sin(r): BK
= LS: GoSub 5000
705 LS = Fix(BK * 10000) / 10000: LL = Fix(LL *
1000) / 1000
710 x = TS: GoSub 5100
715 Return

4990 '....................MODULE "RED"
4995 '
5000 '....................MODULE "REDCAD"
5005 IK = Fix(BK / 360): BK = BK - IK * 360: If BK
< 0 Then BK = BK + 360
5010 Return
5050 '....................MODULE "ANOMAL"
5055 U = MR
5060 U1 = MR + E * Sin(U): If Abs(U - U1) <
0.000001 Then GoTo 5070
5065 U = U1: GoTo 5060
5070 TV = Sqr((1 + E) / (1 - E)) * Tan(U / 2)
5075 V = Atn(TV) * 2: If V < 0 Then V = V + PI * 2
5080 Return
5100 '....................MODULE "REDSEX"
5105 If x < 0 Then x = -x: Y = -1 Else Y = 1
5110 X1 = Fix(x): X2 = Fix((x - X1) * 60): X3 =
Fix((x - X1 - X2 / 60) * 36000!) / 10
5115 Return
5200 '....................MODULE "REDHEUR"
5205 J0 = Fix(J): HH = (J - J0) * 24: H = Fix(HH):
MM = (HH - H) * 60
5210 MN = Fix(MM): S = Fix((MM - MN) * 60): H = H
+ 12 - DH
5215 If H >= 24 Then H = H - 24: J0 = J0 + 1
5220 H = H - 12: If H < 0 Then H = H + 24: J0 =
J0 - 1
5225 Return

6000 '....................MODULE "JULIEN"
6005 '
6010 C = A Mod 4: B = A + 4712: N = B * 365 +
Fix((B + 3) / 4)
6015 N0 = N: DN = 0: If C = 0 Then F = 1: FJ = 1
Else F = 0: FJ = 0
6020 If A > 1582 Then DN = 10
6025 If A = 1582 And M = 12 And J > 19 Then DN =
10
6030 If A >= 1700 Then GoTo 6035 Else GoTo 6040
6035 DM = -Fix((A - 1) / 100) + 12 + Fix((A - 1) /
400): N0 = N
6040 If A / 400 <> Fix(A / 400) And A / 100 =
Fix(A / 100) Then F = 0
6045 DN = DN - DM
6050 If M <= 8 Then N = N + (M - 1) * 30 + Fix(M /
2)
6055 If M > 8 Then N = N + (M - 1) * 30 + Fix((M -
1) / 2) + 1
6060 If M >= 3 And F = 1 Then N = N - 1
6065 If M >= 3 And F = 0 Then N = N - 2 + FJ: DN =
DN + FJ
6070 JJ = N + J - 1.5: HJ = H / 24: JJ = JJ + HJ
6075 JE = Fix(JJ + 0.5) - N0 + 1: JE = JE Mod 365
6080 If JJ <= 2299236# Then GoTo 6090
6085 If JJ > 2299236# And A = 1582 Then JE = JE -
10
6090 Return

6100 '....................MODULE "JOUR"
6105 '
6110 Q = Fix(JJ) - Fix(JJ / 7) * 7 + 2
6115 If JJ - Fix(JJ) >= 0.5 Then Q = Q + 1
6120 If Q > 7 Then Q = Q - 7
6125 If Q = 1 Then ja = "DIMANCHE"
6130 If Q = 2 Then ja = "LUNDI"
6135 If Q = 3 Then ja = "MARDI"
6140 If Q = 4 Then ja = "MERCREDI"
6145 If Q = 5 Then ja = "JEUDI"
6150 If Q = 6 Then ja = "VENDREDI"
6155 If Q = 7 Then ja = "SAMEDI"
6160 Return
End Sub


Sub Presub(TJ As Double, JJ0 As Double, DN As
Double, A As Long, J As Double)
Dim K As Long, DJ As Double, F As Long, J0 As
Long
Dim data As String, donnees() As String, I As
Long, XK As Long, MDF As String
DJ = TJ - JJ0
If TJ < 2299226.5 Then
DJ = DJ - DN
'attention ici visiblement les années
bissextiles ne sont pas traitées de la même façon
que dans la branche else
If (A Mod 4 = 0) Then F = 1
Else
If A = 1582 Then DJ = DJ + 10
'Bissextile si multiple de 400 ou multiple
de 4 et non multiple de 100
If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A
Mod 100) <> 0) Then F = 1 Else F = 0
End If
If DJ > 58 Then DJ = DJ - F
'data = "333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE, 242, SEPTEMBRE, " 211, AOUT, 180,
JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars,
1000, IXE ""
donnees = Split(data, ", ")
I = 0
Do
XK = donnees(I)
I = I + 1
md = donnees(I)
I = I + 1
If (XK = 1000) Then
If DJ > 30 Then
XK = 30
md = "FEVRIER"
Else
XK = -1
md = "JANVIER"
End If
Exit Do
End If
If (Fix(DJ - 0.5) >= XK) Then Exit Do
Loop
J = DJ - XK
If (DJ > 333) And (J >= 31.5) Then
A = A + 1
J = J - 31
md = "JANVIER"
End If
J0 = Fix(J)
HH = (J - J0) * 24
H = Fix(HH)
MM = (HH - H) * 60
MN = Fix(MM)
S = Fix(MM - MN) * 60
H = H + 12
If H >= 24 Then
H = H - 24
J0 = J0 + 1
End If
End Sub





Avatar
Patrice Henrio
LE TROLL a écrit :
Oh là là, merci Patrice, quel travail
espérons que ça marche, c'est d'autant plus
pénible que le mec écrit comme un cochon, il saut
à la ligne seulement quand il a le temps, collant
tout abec ":"

Comment on l'appelle ?

Call Presub(TJ, JJ0, DN, A, J) ': GoSub 6500

Ça, ça marche pas, je ne suis pas doué en passage
de paramètres...

Sinon, j'ai collé ça:

Sub Presub(TJ As Double, JJ0 As Double, DN As
Double, A As Long, J As Double)
Dim K As Long, DJ As Double, F As Long, J0 As
Long
Dim data As String, donnees() As String, I As
Long, XK As Long, MDF As String
DJ = TJ - JJ0
If TJ < 2299226.5 Then
DJ = DJ - DN
'attention ici visiblement les années
bissextiles ne sont pas traitées de la même façon
que dans la branche else
If (A Mod 4 = 0) Then F = 1
Else
If A = 1582 Then DJ = DJ + 10
'Bissextile si multiple de 400 ou multiple
de 4 et non multiple de 100
If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A
Mod 100) <> 0) Then F = 1 Else F = 0
End If
If DJ > 58 Then DJ = DJ - F
'data = "333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE, 242, SEPTEMBRE, " 211, AOUT, 180,
JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars,
1000, IXE ""
donnees = Split(data, ", ")
I = 0
Do
XK = donnees(I)
I = I + 1
md = donnees(I)
I = I + 1
If (XK = 1000) Then
If DJ > 30 Then
XK = 30
md = "FEVRIER"
Else
XK = -1
md = "JANVIER"
End If
Exit Do
End If
If (Fix(DJ - 0.5) >= XK) Then Exit Do
Loop
J = DJ - XK
If (DJ > 333) And (J >= 31.5) Then
A = A + 1
J = J - 31
md = "JANVIER"
End If
J0 = Fix(J)
HH = (J - J0) * 24
H = Fix(HH)
MM = (HH - H) * 60
MN = Fix(MM)
S = Fix(MM - MN) * 60
H = H + 12
If H >= 24 Then
H = H - 24
J0 = J0 + 1
End If
End Sub



------------
J'ai inhibé les commande fichier que j'avais mis
pour faire un fichier sous dos avec GwBasic je
crois, qui ensuite est embarqué (ben voui, c'est
mieux que rien :o)
qui donne au total :
------------



Sub saisons()
'MODULE "PRSAISON"
Dim B, D, E, J, L, M, N, O, P, T, V
Dim ma As String
Dim ya(12) As String
Dim za(12) As String
Dim ja As String
'
15 A = YYYY 'A = 2002
' Color 7, 1: Cls
' Dim numfic As Integer
' numfic = FreeFile
' Open "Saisons.txt" For Output As numfic

20 'A = A + 1
PI = 3.14159265
25 RA1 = PI / 180: RA2 = PI / 12:
30 KK = 2
35 M = 1: J = 1: H = 0
40 GoSub 500: LS1 = LS: JJ2 = JJ: JJ0 = JJ
45 JJ1 = 1671383#: GoSub 6700: PRL0 = PRL
50 If KK = 2 Then PRL = 0: PRL0 = 0
55 KC = Fix((LS1 - PRL) / 30) + 4: If KC > 12 Then
KC = KC - 12
60 L0 = 30 * (KC - 3): KC0 = KC
65
70
75 za(1) = "": za(2) = "": za(3) = ""
80 za(4) = "": za(5) = "": za(6) = ""
85 za(7) = "": za(8) = "": za(9) = ""
90 za(10) = "": za(11) = ""
95 za(12) = "": ya(3) = " PRINTEMPS"
100 ya(6) = " ETE ": ya(9) = " AUTOMNE ":
ya(12) = " HIVER "
105
110 GoSub 170: GoSub 515: LS1 = LS
115 GoSub 170: GoSub 515: LS1 = LS
120 JJ = JJ - 0.5: TJ = JJ
Call Presub(TJ, JJ0, DN, A, J) ': GoSub 6500

125 If KC = 3 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 6 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 9 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 12 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If
130

135 LS = L0: JJ = JJ + 0.5: L0 = L0 + 30: KC = KC
+ 1: K = 0
140 If L0 >= 360 Then L0 = L0 - 360
145 If KC > 12 Then KC = KC - 12
150 If KC = KC0 Then GoTo 165
155 If KK = 1 Then PRL = PRL0 + KC * 0.00012
160 GoTo 110

'-----------------------
165 'If A < 2051 Then GoTo 20
'If A > 2050 Then
' Close numfic
' End
' End If
Exit Sub
'-----------------------

170 JJ = JJ + 1: H = 0: GoSub 515: LS2 = LS
175 If LS2 < LS1 Then LS2 = LS2 + 360
180 DLJ = LS2 - LS1: DDJ = (L0 + PRL - LS1) / DLJ
185 If DDJ < -100 Then DDJ = DDJ + 360 / DLJ
190 JJ = JJ - 1 + DDJ
195 Return

500 '....................MODULE "SOL"
505 '
510 GoSub 6000: JJ = JJ - DN
515 BJ = JJ - 2451545#
520 TJ = Fix(BJ - HJ) / 36525#
525 T = BJ / 36525#
530 If A >= 1900 Then VL = -0.2837 * T - 0.248:
GoTo 545
535 VL = -0.00008304245 * T ^ 4 - 0.005673214 * T
^ 3 - 0.0005050719 * T ^ 2
540 VL = VL - 0.259827 * T - 0.248274
545 Lo = LO0 - VL * KEPH
550 LSM = 280.4659 + 36000.76953 * T + 0.0003025 *
T ^ 2
555 BK = LSM: GoSub 5000: LSM = BK
560 PS = 282.9405 + 1.72009 * T + 0.0004628 * T ^
2 + 0.00000033 * T ^ 3
565 BK = PS: GoSub 5000: PS = BK
570 ES = 0.016709114 - 0.000042052 * T -
0.000000126 * T ^ 2
575 MS = LSM - PS: MR = MS * RA1: E = ES
580 GoSub 5050: VS = V / RA1
585 LS = PS + VS: BK = LS: GoSub 5000: LS = BK:
AXS = 1.00000023
590 XS = AXS * (1 - ES ^ 2) / (1 + ES * Cos(V))
595 TX = BJ / 365242.2
600 OB = 23.43928 - 0.1301403 * TX - 0.00014163 *
TX ^ 2 + 0.00050833 * TX ^ 3
605 OBR = OB * RA1
610 TS = 280.4603 + 36000.7697 * TJ + 0.00038708 *
TJ ^ 2
615 BK = TS: GoSub 5000: TS0 = BK
620 TS = (H - 12) * 36624.22 / 36524.22 + TS0 / 15
+ Lo / 15
625 If TS < 0 Then TS = TS + 24
630 If TS > 24 Then TS = TS - 24
635 LL = 218.31617 + 481267.88088 * T - 0.00112767
* T ^ 2 + 0.000001888 * T ^ 3
640 BK = LL: GoSub 5000: LL = BK
645 NL = 125.043347 - 1934.137846 * T + 0.00208444
* T ^ 2 + 0.000002222 * T ^ 3
650 BK = NL: GoSub 5000: NL = BK
655 PL = 83.353248 + 4069.013343 * T - 0.0103625 *
T ^ 2 - 0.0000125 * T ^ 3
660 BK = PL: GoSub 5000: PL = BK
665 r = (LL - LSM) * RA1: D = (LL - NL) * RA1: G =
(LL - PL) * RA1: W = MR
670 NU = -17.2327 * Sin(NL * RA1) / 3600 - 1.2729
* Sin(LSM * RA1 * 2) / 3600
675 NU = NU + 0.2088 * Sin(2 * NL * RA1) / 3600 -
0.2037 * Sin(LL * 2 * RA1) / 3600
680 NOB = 9.21 * Cos(NL * RA1) / 3600 + 0.5522 *
Cos(LSM * RA1 * 2) / 3600
685 OB = OB + NOB: OBR = OB * RA1
690 TS = TS + NU * Cos(OBR) / 15: SS = 0.266567 /
XS
695 ASO = -20.496 * (1 + ES * Cos(V)) / 3600
700 LS = PS + VS + NU + ASO + 0.0018 * Sin(r): BK
= LS: GoSub 5000
705 LS = Fix(BK * 10000) / 10000: LL = Fix(LL *
1000) / 1000
710 x = TS: GoSub 5100
715 Return

4990 '....................MODULE "RED"
4995 '
5000 '....................MODULE "REDCAD"
5005 IK = Fix(BK / 360): BK = BK - IK * 360: If BK
< 0 Then BK = BK + 360
5010 Return
5050 '....................MODULE "ANOMAL"
5055 U = MR
5060 U1 = MR + E * Sin(U): If Abs(U - U1) <
0.000001 Then GoTo 5070
5065 U = U1: GoTo 5060
5070 TV = Sqr((1 + E) / (1 - E)) * Tan(U / 2)
5075 V = Atn(TV) * 2: If V < 0 Then V = V + PI * 2
5080 Return
5100 '....................MODULE "REDSEX"
5105 If x < 0 Then x = -x: Y = -1 Else Y = 1
5110 X1 = Fix(x): X2 = Fix((x - X1) * 60): X3 =
Fix((x - X1 - X2 / 60) * 36000!) / 10
5115 Return
5200 '....................MODULE "REDHEUR"
5205 J0 = Fix(J): HH = (J - J0) * 24: H = Fix(HH):
MM = (HH - H) * 60
5210 MN = Fix(MM): S = Fix((MM - MN) * 60): H = H
+ 12 - DH
5215 If H >= 24 Then H = H - 24: J0 = J0 + 1
5220 H = H - 12: If H < 0 Then H = H + 24: J0 =
J0 - 1
5225 Return

6000 '....................MODULE "JULIEN"
6005 '
6010 C = A Mod 4: B = A + 4712: N = B * 365 +
Fix((B + 3) / 4)
6015 N0 = N: DN = 0: If C = 0 Then F = 1: FJ = 1
Else F = 0: FJ = 0
6020 If A > 1582 Then DN = 10
6025 If A = 1582 And M = 12 And J > 19 Then DN =
10
6030 If A >= 1700 Then GoTo 6035 Else GoTo 6040
6035 DM = -Fix((A - 1) / 100) + 12 + Fix((A - 1) /
400): N0 = N
6040 If A / 400 <> Fix(A / 400) And A / 100 =
Fix(A / 100) Then F = 0
6045 DN = DN - DM
6050 If M <= 8 Then N = N + (M - 1) * 30 + Fix(M /
2)
6055 If M > 8 Then N = N + (M - 1) * 30 + Fix((M -
1) / 2) + 1
6060 If M >= 3 And F = 1 Then N = N - 1
6065 If M >= 3 And F = 0 Then N = N - 2 + FJ: DN =
DN + FJ
6070 JJ = N + J - 1.5: HJ = H / 24: JJ = JJ + HJ
6075 JE = Fix(JJ + 0.5) - N0 + 1: JE = JE Mod 365
6080 If JJ <= 2299236# Then GoTo 6090
6085 If JJ > 2299236# And A = 1582 Then JE = JE -
10
6090 Return

6100 '....................MODULE "JOUR"
6105 '
6110 Q = Fix(JJ) - Fix(JJ / 7) * 7 + 2
6115 If JJ - Fix(JJ) >= 0.5 Then Q = Q + 1
6120 If Q > 7 Then Q = Q - 7
6125 If Q = 1 Then ja = "DIMANCHE"
6130 If Q = 2 Then ja = "LUNDI"
6135 If Q = 3 Then ja = "MARDI"
6140 If Q = 4 Then ja = "MERCREDI"
6145 If Q = 5 Then ja = "JEUDI"
6150 If Q = 6 Then ja = "VENDREDI"
6155 If Q = 7 Then ja = "SAMEDI"
6160 Return
End Sub


Sub Presub(TJ As Double, JJ0 As Double, DN As
Double, A As Long, J As Double)
Dim K As Long, DJ As Double, F As Long, J0 As
Long
Dim data As String, donnees() As String, I As
Long, XK As Long, MDF As String
DJ = TJ - JJ0
If TJ < 2299226.5 Then
DJ = DJ - DN
'attention ici visiblement les années
bissextiles ne sont pas traitées de la même façon
que dans la branche else
If (A Mod 4 = 0) Then F = 1
Else
If A = 1582 Then DJ = DJ + 10
'Bissextile si multiple de 400 ou multiple
de 4 et non multiple de 100
If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A
Mod 100) <> 0) Then F = 1 Else F = 0
End If
If DJ > 58 Then DJ = DJ - F
'data = "333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE, 242, SEPTEMBRE, " 211, AOUT, 180,
JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars,
1000, IXE ""
donnees = Split(data, ", ")
I = 0
Do
XK = donnees(I)
I = I + 1
md = donnees(I)
I = I + 1
If (XK = 1000) Then
If DJ > 30 Then
XK = 30
md = "FEVRIER"
Else
XK = -1
md = "JANVIER"
End If
Exit Do
End If
If (Fix(DJ - 0.5) >= XK) Then Exit Do
Loop
J = DJ - XK
If (DJ > 333) And (J >= 31.5) Then
A = A + 1
J = J - 31
md = "JANVIER"
End If
J0 = Fix(J)
HH = (J - J0) * 24
H = Fix(HH)
MM = (HH - H) * 60
MN = Fix(MM)
S = Fix(MM - MN) * 60
H = H + 12
If H >= 24 Then
H = H - 24
J0 = J0 + 1
End If
End Sub





je vais essayer de te traduire l'ensemble.

J'ai besoin de connaître tes délarations de variables globales

A plus.

L'appel se fait simplement par
Presub TJ, JJ0, DN, A, J
ne pas mettre de parenthèses
Avatar
LE TROLL
Ah ben, attends alors, stp, je t'envoie les source
*.bas par email, avec les exécuteurs basic, comme
ça tu pourras tester...
Ben, si tu traduis, on pourra mettre en ligne, ça
peut servir aux autres, en fait, la saison, c'est
quand la terre est à 0, 90, 180, 270° par rapport
au soleil.

--
Merci beaucoup, au revoir et à bientôt :o)
------
Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
------------------------------------------------------------------------------------
"Patrice Henrio" a
écrit dans le message de news:

| LE TROLL a écrit :
| > Oh là là, merci Patrice, quel travail
| > espérons que ça marche, c'est d'autant plus
| > pénible que le mec écrit comme un cochon, il
saut
| > à la ligne seulement quand il a le temps,
collant
| > tout abec ":"
| >
| > Comment on l'appelle ?
| >
| > Call Presub(TJ, JJ0, DN, A, J) ': GoSub 6500
| >
| > Ça, ça marche pas, je ne suis pas doué en
passage
| > de paramètres...
| >
| > Sinon, j'ai collé ça:
| >
| > Sub Presub(TJ As Double, JJ0 As Double, DN As
| > Double, A As Long, J As Double)
| > Dim K As Long, DJ As Double, F As Long, J0
As
| > Long
| > Dim data As String, donnees() As String, I
As
| > Long, XK As Long, MDF As String
| > DJ = TJ - JJ0
| > If TJ < 2299226.5 Then
| > DJ = DJ - DN
| > 'attention ici visiblement les années
| > bissextiles ne sont pas traitées de la même
façon
| > que dans la branche else
| > If (A Mod 4 = 0) Then F = 1
| > Else
| > If A = 1582 Then DJ = DJ + 10
| > 'Bissextile si multiple de 400 ou
multiple
| > de 4 et non multiple de 100
| > If (A Mod 400 = 0) Or ((A Mod 4) = 0 And
(A
| > Mod 100) <> 0) Then F = 1 Else F = 0
| > End If
| > If DJ > 58 Then DJ = DJ - F
| > 'data = "333, DECEMBRE, 303, NOVEMBRE,
272,
| > OCTOBRE, 242, SEPTEMBRE, " 211, AOUT, 180,
| > JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58,
mars,
| > 1000, IXE ""
| > donnees = Split(data, ", ")
| > I = 0
| > Do
| > XK = donnees(I)
| > I = I + 1
| > md = donnees(I)
| > I = I + 1
| > If (XK = 1000) Then
| > If DJ > 30 Then
| > XK = 30
| > md = "FEVRIER"
| > Else
| > XK = -1
| > md = "JANVIER"
| > End If
| > Exit Do
| > End If
| > If (Fix(DJ - 0.5) >= XK) Then Exit Do
| > Loop
| > J = DJ - XK
| > If (DJ > 333) And (J >= 31.5) Then
| > A = A + 1
| > J = J - 31
| > md = "JANVIER"
| > End If
| > J0 = Fix(J)
| > HH = (J - J0) * 24
| > H = Fix(HH)
| > MM = (HH - H) * 60
| > MN = Fix(MM)
| > S = Fix(MM - MN) * 60
| > H = H + 12
| > If H >= 24 Then
| > H = H - 24
| > J0 = J0 + 1
| > End If
| > End Sub
| >
| >
| >
| > ------------
| > J'ai inhibé les commande fichier que j'avais
mis
| > pour faire un fichier sous dos avec GwBasic je
| > crois, qui ensuite est embarqué (ben voui,
c'est
| > mieux que rien :o)
| > qui donne au total :
| > ------------
| >
| >
| >
| > Sub saisons()
| > 'MODULE "PRSAISON"
| > Dim B, D, E, J, L, M, N, O, P, T, V
| > Dim ma As String
| > Dim ya(12) As String
| > Dim za(12) As String
| > Dim ja As String
| > '
| > 15 A = YYYY 'A = 2002
| > ' Color 7, 1: Cls
| > ' Dim numfic As Integer
| > ' numfic = FreeFile
| > ' Open "Saisons.txt" For Output As numfic
| >
| > 20 'A = A + 1
| > PI = 3.14159265
| > 25 RA1 = PI / 180: RA2 = PI / 12:
| > 30 KK = 2
| > 35 M = 1: J = 1: H = 0
| > 40 GoSub 500: LS1 = LS: JJ2 = JJ: JJ0 = JJ
| > 45 JJ1 = 1671383#: GoSub 6700: PRL0 = PRL
| > 50 If KK = 2 Then PRL = 0: PRL0 = 0
| > 55 KC = Fix((LS1 - PRL) / 30) + 4: If KC > 12
Then
| > KC = KC - 12
| > 60 L0 = 30 * (KC - 3): KC0 = KC
| > 65
| > 70
| > 75 za(1) = "": za(2) = "": za(3) = ""
| > 80 za(4) = "": za(5) = "": za(6) = ""
| > 85 za(7) = "": za(8) = "": za(9) = ""
| > 90 za(10) = "": za(11) = ""
| > 95 za(12) = "": ya(3) = " PRINTEMPS"
| > 100 ya(6) = " ETE ": ya(9) = " AUTOMNE
":
| > ya(12) = " HIVER "
| > 105
| > 110 GoSub 170: GoSub 515: LS1 = LS
| > 115 GoSub 170: GoSub 515: LS1 = LS
| > 120 JJ = JJ - 0.5: TJ = JJ
| > Call Presub(TJ, JJ0, DN, A, J) ': GoSub 6500
| >
| > 125 If KC = 3 Then
| > Print A; za(KC); J0; ma; ya(KC)
| > 'Print #(numfic), A; za(KC); J0; ma;
ya(KC)
| > End If
| >
| > If KC = 6 Then
| > Print A; za(KC); J0; ma; ya(KC)
| > 'Print #(numfic), A; za(KC); J0; ma;
ya(KC)
| > End If
| >
| > If KC = 9 Then
| > Print A; za(KC); J0; ma; ya(KC)
| > 'Print #(numfic), A; za(KC); J0; ma;
ya(KC)
| > End If
| >
| > If KC = 12 Then
| > Print A; za(KC); J0; ma; ya(KC)
| > 'Print #(numfic), A; za(KC); J0; ma;
ya(KC)
| > End If
| > 130
| >
| > 135 LS = L0: JJ = JJ + 0.5: L0 = L0 + 30: KC =
KC
| > + 1: K = 0
| > 140 If L0 >= 360 Then L0 = L0 - 360
| > 145 If KC > 12 Then KC = KC - 12
| > 150 If KC = KC0 Then GoTo 165
| > 155 If KK = 1 Then PRL = PRL0 + KC * 0.00012
| > 160 GoTo 110
| >
| > '-----------------------
| > 165 'If A < 2051 Then GoTo 20
| > 'If A > 2050 Then
| > ' Close numfic
| > ' End
| > ' End If
| > Exit Sub
| > '-----------------------
| >
| > 170 JJ = JJ + 1: H = 0: GoSub 515: LS2 = LS
| > 175 If LS2 < LS1 Then LS2 = LS2 + 360
| > 180 DLJ = LS2 - LS1: DDJ = (L0 + PRL - LS1) /
DLJ
| > 185 If DDJ < -100 Then DDJ = DDJ + 360 / DLJ
| > 190 JJ = JJ - 1 + DDJ
| > 195 Return
| >
| > 500 '....................MODULE "SOL"
| > 505 '
| > 510 GoSub 6000: JJ = JJ - DN
| > 515 BJ = JJ - 2451545#
| > 520 TJ = Fix(BJ - HJ) / 36525#
| > 525 T = BJ / 36525#
| > 530 If A >= 1900 Then VL = -0.2837 * T -
0.248:
| > GoTo 545
| > 535 VL = -0.00008304245 * T ^ 4 - 0.005673214
* T
| > ^ 3 - 0.0005050719 * T ^ 2
| > 540 VL = VL - 0.259827 * T - 0.248274
| > 545 Lo = LO0 - VL * KEPH
| > 550 LSM = 280.4659 + 36000.76953 * T +
0.0003025 *
| > T ^ 2
| > 555 BK = LSM: GoSub 5000: LSM = BK
| > 560 PS = 282.9405 + 1.72009 * T + 0.0004628 *
T ^
| > 2 + 0.00000033 * T ^ 3
| > 565 BK = PS: GoSub 5000: PS = BK
| > 570 ES = 0.016709114 - 0.000042052 * T -
| > 0.000000126 * T ^ 2
| > 575 MS = LSM - PS: MR = MS * RA1: E = ES
| > 580 GoSub 5050: VS = V / RA1
| > 585 LS = PS + VS: BK = LS: GoSub 5000: LS =
BK:
| > AXS = 1.00000023
| > 590 XS = AXS * (1 - ES ^ 2) / (1 + ES *
Cos(V))
| > 595 TX = BJ / 365242.2
| > 600 OB = 23.43928 - 0.1301403 * TX -
0.00014163 *
| > TX ^ 2 + 0.00050833 * TX ^ 3
| > 605 OBR = OB * RA1
| > 610 TS = 280.4603 + 36000.7697 * TJ +
0.00038708 *
| > TJ ^ 2
| > 615 BK = TS: GoSub 5000: TS0 = BK
| > 620 TS = (H - 12) * 36624.22 / 36524.22 + TS0
/ 15
| > + Lo / 15
| > 625 If TS < 0 Then TS = TS + 24
| > 630 If TS > 24 Then TS = TS - 24
| > 635 LL = 218.31617 + 481267.88088 * T -
0.00112767
| > * T ^ 2 + 0.000001888 * T ^ 3
| > 640 BK = LL: GoSub 5000: LL = BK
| > 645 NL = 125.043347 - 1934.137846 * T +
0.00208444
| > * T ^ 2 + 0.000002222 * T ^ 3
| > 650 BK = NL: GoSub 5000: NL = BK
| > 655 PL = 83.353248 + 4069.013343 * T -
0.0103625 *
| > T ^ 2 - 0.0000125 * T ^ 3
| > 660 BK = PL: GoSub 5000: PL = BK
| > 665 r = (LL - LSM) * RA1: D = (LL - NL) * RA1:
G | > (LL - PL) * RA1: W = MR
| > 670 NU = -17.2327 * Sin(NL * RA1) / 3600 -
1.2729
| > * Sin(LSM * RA1 * 2) / 3600
| > 675 NU = NU + 0.2088 * Sin(2 * NL * RA1) /
3600 -
| > 0.2037 * Sin(LL * 2 * RA1) / 3600
| > 680 NOB = 9.21 * Cos(NL * RA1) / 3600 + 0.5522
*
| > Cos(LSM * RA1 * 2) / 3600
| > 685 OB = OB + NOB: OBR = OB * RA1
| > 690 TS = TS + NU * Cos(OBR) / 15: SS =
0.266567 /
| > XS
| > 695 ASO = -20.496 * (1 + ES * Cos(V)) / 3600
| > 700 LS = PS + VS + NU + ASO + 0.0018 * Sin(r):
BK
| > = LS: GoSub 5000
| > 705 LS = Fix(BK * 10000) / 10000: LL = Fix(LL
*
| > 1000) / 1000
| > 710 x = TS: GoSub 5100
| > 715 Return
| >
| > 4990 '....................MODULE "RED"
| > 4995 '
| > 5000 '....................MODULE "REDCAD"
| > 5005 IK = Fix(BK / 360): BK = BK - IK * 360:
If BK
| > < 0 Then BK = BK + 360
| > 5010 Return
| > 5050 '....................MODULE "ANOMAL"
| > 5055 U = MR
| > 5060 U1 = MR + E * Sin(U): If Abs(U - U1) <
| > 0.000001 Then GoTo 5070
| > 5065 U = U1: GoTo 5060
| > 5070 TV = Sqr((1 + E) / (1 - E)) * Tan(U / 2)
| > 5075 V = Atn(TV) * 2: If V < 0 Then V = V + PI
* 2
| > 5080 Return
| > 5100 '....................MODULE "REDSEX"
| > 5105 If x < 0 Then x = -x: Y = -1 Else Y = 1
| > 5110 X1 = Fix(x): X2 = Fix((x - X1) * 60): X3
| > Fix((x - X1 - X2 / 60) * 36000!) / 10
| > 5115 Return
| > 5200 '....................MODULE "REDHEUR"
| > 5205 J0 = Fix(J): HH = (J - J0) * 24: H =
Fix(HH):
| > MM = (HH - H) * 60
| > 5210 MN = Fix(MM): S = Fix((MM - MN) * 60): H
= H
| > + 12 - DH
| > 5215 If H >= 24 Then H = H - 24: J0 = J0 + 1
| > 5220 H = H - 12: If H < 0 Then H = H + 24: J0
| > J0 - 1
| > 5225 Return
| >
| > 6000 '....................MODULE "JULIEN"
| > 6005 '
| > 6010 C = A Mod 4: B = A + 4712: N = B * 365 +
| > Fix((B + 3) / 4)
| > 6015 N0 = N: DN = 0: If C = 0 Then F = 1: FJ =
1
| > Else F = 0: FJ = 0
| > 6020 If A > 1582 Then DN = 10
| > 6025 If A = 1582 And M = 12 And J > 19 Then DN
| > 10
| > 6030 If A >= 1700 Then GoTo 6035 Else GoTo
6040
| > 6035 DM = -Fix((A - 1) / 100) + 12 + Fix((A -
1) /
| > 400): N0 = N
| > 6040 If A / 400 <> Fix(A / 400) And A / 100 | > Fix(A / 100) Then F = 0
| > 6045 DN = DN - DM
| > 6050 If M <= 8 Then N = N + (M - 1) * 30 +
Fix(M /
| > 2)
| > 6055 If M > 8 Then N = N + (M - 1) * 30 +
Fix((M -
| > 1) / 2) + 1
| > 6060 If M >= 3 And F = 1 Then N = N - 1
| > 6065 If M >= 3 And F = 0 Then N = N - 2 + FJ:
DN | > DN + FJ
| > 6070 JJ = N + J - 1.5: HJ = H / 24: JJ = JJ +
HJ
| > 6075 JE = Fix(JJ + 0.5) - N0 + 1: JE = JE Mod
365
| > 6080 If JJ <= 2299236# Then GoTo 6090
| > 6085 If JJ > 2299236# And A = 1582 Then JE =
JE -
| > 10
| > 6090 Return
| >
| > 6100 '....................MODULE "JOUR"
| > 6105 '
| > 6110 Q = Fix(JJ) - Fix(JJ / 7) * 7 + 2
| > 6115 If JJ - Fix(JJ) >= 0.5 Then Q = Q + 1
| > 6120 If Q > 7 Then Q = Q - 7
| > 6125 If Q = 1 Then ja = "DIMANCHE"
| > 6130 If Q = 2 Then ja = "LUNDI"
| > 6135 If Q = 3 Then ja = "MARDI"
| > 6140 If Q = 4 Then ja = "MERCREDI"
| > 6145 If Q = 5 Then ja = "JEUDI"
| > 6150 If Q = 6 Then ja = "VENDREDI"
| > 6155 If Q = 7 Then ja = "SAMEDI"
| > 6160 Return
| > End Sub
| >
| >
| > Sub Presub(TJ As Double, JJ0 As Double, DN As
| > Double, A As Long, J As Double)
| > Dim K As Long, DJ As Double, F As Long, J0
As
| > Long
| > Dim data As String, donnees() As String, I
As
| > Long, XK As Long, MDF As String
| > DJ = TJ - JJ0
| > If TJ < 2299226.5 Then
| > DJ = DJ - DN
| > 'attention ici visiblement les années
| > bissextiles ne sont pas traitées de la même
façon
| > que dans la branche else
| > If (A Mod 4 = 0) Then F = 1
| > Else
| > If A = 1582 Then DJ = DJ + 10
| > 'Bissextile si multiple de 400 ou
multiple
| > de 4 et non multiple de 100
| > If (A Mod 400 = 0) Or ((A Mod 4) = 0 And
(A
| > Mod 100) <> 0) Then F = 1 Else F = 0
| > End If
| > If DJ > 58 Then DJ = DJ - F
| > 'data = "333, DECEMBRE, 303, NOVEMBRE,
272,
| > OCTOBRE, 242, SEPTEMBRE, " 211, AOUT, 180,
| > JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58,
mars,
| > 1000, IXE ""
| > donnees = Split(data, ", ")
| > I = 0
| > Do
| > XK = donnees(I)
| > I = I + 1
| > md = donnees(I)
| > I = I + 1
| > If (XK = 1000) Then
| > If DJ > 30 Then
| > XK = 30
| > md = "FEVRIER"
| > Else
| > XK = -1
| > md = "JANVIER"
| > End If
| > Exit Do
| > End If
| > If (Fix(DJ - 0.5) >= XK) Then Exit Do
| > Loop
| > J = DJ - XK
| > If (DJ > 333) And (J >= 31.5) Then
| > A = A + 1
| > J = J - 31
| > md = "JANVIER"
| > End If
| > J0 = Fix(J)
| > HH = (J - J0) * 24
| > H = Fix(HH)
| > MM = (HH - H) * 60
| > MN = Fix(MM)
| > S = Fix(MM - MN) * 60
| > H = H + 12
| > If H >= 24 Then
| > H = H - 24
| > J0 = J0 + 1
| > End If
| > End Sub
| >
| >
| >
| je vais essayer de te traduire l'ensemble.
|
| J'ai besoin de connaître tes délarations de
variables globales
|
| A plus.
|
| L'appel se fait simplement par
| Presub TJ, JJ0, DN, A, J
| ne pas mettre de parenthèses
Avatar
Patrice Henrio
LE TROLL a écrit :
Oh là là, merci Patrice, quel travail
espérons que ça marche, c'est d'autant plus
pénible que le mec écrit comme un cochon, il saut
à la ligne seulement quand il a le temps, collant
tout abec ":"

Comment on l'appelle ?

Call Presub(TJ, JJ0, DN, A, J) ': GoSub 6500

Ça, ça marche pas, je ne suis pas doué en passage
de paramètres...

Sinon, j'ai collé ça:

Sub Presub(TJ As Double, JJ0 As Double, DN As
Double, A As Long, J As Double)
Dim K As Long, DJ As Double, F As Long, J0 As
Long
Dim data As String, donnees() As String, I As
Long, XK As Long, MDF As String
DJ = TJ - JJ0
If TJ < 2299226.5 Then
DJ = DJ - DN
'attention ici visiblement les années
bissextiles ne sont pas traitées de la même façon
que dans la branche else
If (A Mod 4 = 0) Then F = 1
Else
If A = 1582 Then DJ = DJ + 10
'Bissextile si multiple de 400 ou multiple
de 4 et non multiple de 100
If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A
Mod 100) <> 0) Then F = 1 Else F = 0
End If
If DJ > 58 Then DJ = DJ - F
'data = "333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE, 242, SEPTEMBRE, " 211, AOUT, 180,
JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars,
1000, IXE ""
donnees = Split(data, ", ")
I = 0
Do
XK = donnees(I)
I = I + 1
md = donnees(I)
I = I + 1
If (XK = 1000) Then
If DJ > 30 Then
XK = 30
md = "FEVRIER"
Else
XK = -1
md = "JANVIER"
End If
Exit Do
End If
If (Fix(DJ - 0.5) >= XK) Then Exit Do
Loop
J = DJ - XK
If (DJ > 333) And (J >= 31.5) Then
A = A + 1
J = J - 31
md = "JANVIER"
End If
J0 = Fix(J)
HH = (J - J0) * 24
H = Fix(HH)
MM = (HH - H) * 60
MN = Fix(MM)
S = Fix(MM - MN) * 60
H = H + 12
If H >= 24 Then
H = H - 24
J0 = J0 + 1
End If
End Sub



------------
J'ai inhibé les commande fichier que j'avais mis
pour faire un fichier sous dos avec GwBasic je
crois, qui ensuite est embarqué (ben voui, c'est
mieux que rien :o)
qui donne au total :
------------



Sub saisons()
'MODULE "PRSAISON"
Dim B, D, E, J, L, M, N, O, P, T, V
Dim ma As String
Dim ya(12) As String
Dim za(12) As String
Dim ja As String
'
15 A = YYYY 'A = 2002
' Color 7, 1: Cls
' Dim numfic As Integer
' numfic = FreeFile
' Open "Saisons.txt" For Output As numfic

20 'A = A + 1
PI = 3.14159265
25 RA1 = PI / 180: RA2 = PI / 12:
30 KK = 2
35 M = 1: J = 1: H = 0
40 GoSub 500: LS1 = LS: JJ2 = JJ: JJ0 = JJ
45 JJ1 = 1671383#: GoSub 6700: PRL0 = PRL
50 If KK = 2 Then PRL = 0: PRL0 = 0
55 KC = Fix((LS1 - PRL) / 30) + 4: If KC > 12 Then
KC = KC - 12
60 L0 = 30 * (KC - 3): KC0 = KC
65
70
75 za(1) = "": za(2) = "": za(3) = ""
80 za(4) = "": za(5) = "": za(6) = ""
85 za(7) = "": za(8) = "": za(9) = ""
90 za(10) = "": za(11) = ""
95 za(12) = "": ya(3) = " PRINTEMPS"
100 ya(6) = " ETE ": ya(9) = " AUTOMNE ":
ya(12) = " HIVER "
105
110 GoSub 170: GoSub 515: LS1 = LS
115 GoSub 170: GoSub 515: LS1 = LS
120 JJ = JJ - 0.5: TJ = JJ
Call Presub(TJ, JJ0, DN, A, J) ': GoSub 6500

125 If KC = 3 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 6 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 9 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If

If KC = 12 Then
Print A; za(KC); J0; ma; ya(KC)
'Print #(numfic), A; za(KC); J0; ma; ya(KC)
End If
130

135 LS = L0: JJ = JJ + 0.5: L0 = L0 + 30: KC = KC
+ 1: K = 0
140 If L0 >= 360 Then L0 = L0 - 360
145 If KC > 12 Then KC = KC - 12
150 If KC = KC0 Then GoTo 165
155 If KK = 1 Then PRL = PRL0 + KC * 0.00012
160 GoTo 110

'-----------------------
165 'If A < 2051 Then GoTo 20
'If A > 2050 Then
' Close numfic
' End
' End If
Exit Sub
'-----------------------

170 JJ = JJ + 1: H = 0: GoSub 515: LS2 = LS
175 If LS2 < LS1 Then LS2 = LS2 + 360
180 DLJ = LS2 - LS1: DDJ = (L0 + PRL - LS1) / DLJ
185 If DDJ < -100 Then DDJ = DDJ + 360 / DLJ
190 JJ = JJ - 1 + DDJ
195 Return

500 '....................MODULE "SOL"
505 '
510 GoSub 6000: JJ = JJ - DN
515 BJ = JJ - 2451545#
520 TJ = Fix(BJ - HJ) / 36525#
525 T = BJ / 36525#
530 If A >= 1900 Then VL = -0.2837 * T - 0.248:
GoTo 545
535 VL = -0.00008304245 * T ^ 4 - 0.005673214 * T
^ 3 - 0.0005050719 * T ^ 2
540 VL = VL - 0.259827 * T - 0.248274
545 Lo = LO0 - VL * KEPH
550 LSM = 280.4659 + 36000.76953 * T + 0.0003025 *
T ^ 2
555 BK = LSM: GoSub 5000: LSM = BK
560 PS = 282.9405 + 1.72009 * T + 0.0004628 * T ^
2 + 0.00000033 * T ^ 3
565 BK = PS: GoSub 5000: PS = BK
570 ES = 0.016709114 - 0.000042052 * T -
0.000000126 * T ^ 2
575 MS = LSM - PS: MR = MS * RA1: E = ES
580 GoSub 5050: VS = V / RA1
585 LS = PS + VS: BK = LS: GoSub 5000: LS = BK:
AXS = 1.00000023
590 XS = AXS * (1 - ES ^ 2) / (1 + ES * Cos(V))
595 TX = BJ / 365242.2
600 OB = 23.43928 - 0.1301403 * TX - 0.00014163 *
TX ^ 2 + 0.00050833 * TX ^ 3
605 OBR = OB * RA1
610 TS = 280.4603 + 36000.7697 * TJ + 0.00038708 *
TJ ^ 2
615 BK = TS: GoSub 5000: TS0 = BK
620 TS = (H - 12) * 36624.22 / 36524.22 + TS0 / 15
+ Lo / 15
625 If TS < 0 Then TS = TS + 24
630 If TS > 24 Then TS = TS - 24
635 LL = 218.31617 + 481267.88088 * T - 0.00112767
* T ^ 2 + 0.000001888 * T ^ 3
640 BK = LL: GoSub 5000: LL = BK
645 NL = 125.043347 - 1934.137846 * T + 0.00208444
* T ^ 2 + 0.000002222 * T ^ 3
650 BK = NL: GoSub 5000: NL = BK
655 PL = 83.353248 + 4069.013343 * T - 0.0103625 *
T ^ 2 - 0.0000125 * T ^ 3
660 BK = PL: GoSub 5000: PL = BK
665 r = (LL - LSM) * RA1: D = (LL - NL) * RA1: G =
(LL - PL) * RA1: W = MR
670 NU = -17.2327 * Sin(NL * RA1) / 3600 - 1.2729
* Sin(LSM * RA1 * 2) / 3600
675 NU = NU + 0.2088 * Sin(2 * NL * RA1) / 3600 -
0.2037 * Sin(LL * 2 * RA1) / 3600
680 NOB = 9.21 * Cos(NL * RA1) / 3600 + 0.5522 *
Cos(LSM * RA1 * 2) / 3600
685 OB = OB + NOB: OBR = OB * RA1
690 TS = TS + NU * Cos(OBR) / 15: SS = 0.266567 /
XS
695 ASO = -20.496 * (1 + ES * Cos(V)) / 3600
700 LS = PS + VS + NU + ASO + 0.0018 * Sin(r): BK
= LS: GoSub 5000
705 LS = Fix(BK * 10000) / 10000: LL = Fix(LL *
1000) / 1000
710 x = TS: GoSub 5100
715 Return

4990 '....................MODULE "RED"
4995 '
5000 '....................MODULE "REDCAD"
5005 IK = Fix(BK / 360): BK = BK - IK * 360: If BK
< 0 Then BK = BK + 360
5010 Return
5050 '....................MODULE "ANOMAL"
5055 U = MR
5060 U1 = MR + E * Sin(U): If Abs(U - U1) <
0.000001 Then GoTo 5070
5065 U = U1: GoTo 5060
5070 TV = Sqr((1 + E) / (1 - E)) * Tan(U / 2)
5075 V = Atn(TV) * 2: If V < 0 Then V = V + PI * 2
5080 Return
5100 '....................MODULE "REDSEX"
5105 If x < 0 Then x = -x: Y = -1 Else Y = 1
5110 X1 = Fix(x): X2 = Fix((x - X1) * 60): X3 =
Fix((x - X1 - X2 / 60) * 36000!) / 10
5115 Return
5200 '....................MODULE "REDHEUR"
5205 J0 = Fix(J): HH = (J - J0) * 24: H = Fix(HH):
MM = (HH - H) * 60
5210 MN = Fix(MM): S = Fix((MM - MN) * 60): H = H
+ 12 - DH
5215 If H >= 24 Then H = H - 24: J0 = J0 + 1
5220 H = H - 12: If H < 0 Then H = H + 24: J0 =
J0 - 1
5225 Return

6000 '....................MODULE "JULIEN"
6005 '
6010 C = A Mod 4: B = A + 4712: N = B * 365 +
Fix((B + 3) / 4)
6015 N0 = N: DN = 0: If C = 0 Then F = 1: FJ = 1
Else F = 0: FJ = 0
6020 If A > 1582 Then DN = 10
6025 If A = 1582 And M = 12 And J > 19 Then DN =
10
6030 If A >= 1700 Then GoTo 6035 Else GoTo 6040
6035 DM = -Fix((A - 1) / 100) + 12 + Fix((A - 1) /
400): N0 = N
6040 If A / 400 <> Fix(A / 400) And A / 100 =
Fix(A / 100) Then F = 0
6045 DN = DN - DM
6050 If M <= 8 Then N = N + (M - 1) * 30 + Fix(M /
2)
6055 If M > 8 Then N = N + (M - 1) * 30 + Fix((M -
1) / 2) + 1
6060 If M >= 3 And F = 1 Then N = N - 1
6065 If M >= 3 And F = 0 Then N = N - 2 + FJ: DN =
DN + FJ
6070 JJ = N + J - 1.5: HJ = H / 24: JJ = JJ + HJ
6075 JE = Fix(JJ + 0.5) - N0 + 1: JE = JE Mod 365
6080 If JJ <= 2299236# Then GoTo 6090
6085 If JJ > 2299236# And A = 1582 Then JE = JE -
10
6090 Return

6100 '....................MODULE "JOUR"
6105 '
6110 Q = Fix(JJ) - Fix(JJ / 7) * 7 + 2
6115 If JJ - Fix(JJ) >= 0.5 Then Q = Q + 1
6120 If Q > 7 Then Q = Q - 7
6125 If Q = 1 Then ja = "DIMANCHE"
6130 If Q = 2 Then ja = "LUNDI"
6135 If Q = 3 Then ja = "MARDI"
6140 If Q = 4 Then ja = "MERCREDI"
6145 If Q = 5 Then ja = "JEUDI"
6150 If Q = 6 Then ja = "VENDREDI"
6155 If Q = 7 Then ja = "SAMEDI"
6160 Return
End Sub


Sub Presub(TJ As Double, JJ0 As Double, DN As
Double, A As Long, J As Double)
Dim K As Long, DJ As Double, F As Long, J0 As
Long
Dim data As String, donnees() As String, I As
Long, XK As Long, MDF As String
DJ = TJ - JJ0
If TJ < 2299226.5 Then
DJ = DJ - DN
'attention ici visiblement les années
bissextiles ne sont pas traitées de la même façon
que dans la branche else
If (A Mod 4 = 0) Then F = 1
Else
If A = 1582 Then DJ = DJ + 10
'Bissextile si multiple de 400 ou multiple
de 4 et non multiple de 100
If (A Mod 400 = 0) Or ((A Mod 4) = 0 And (A
Mod 100) <> 0) Then F = 1 Else F = 0
End If
If DJ > 58 Then DJ = DJ - F
'data = "333, DECEMBRE, 303, NOVEMBRE, 272,
OCTOBRE, 242, SEPTEMBRE, " 211, AOUT, 180,
JUILLET, 150, JUIN, 119, MAI, 89, AVRIL, 58, mars,
1000, IXE ""
donnees = Split(data, ", ")
I = 0
Do
XK = donnees(I)
I = I + 1
md = donnees(I)
I = I + 1
If (XK = 1000) Then
If DJ > 30 Then
XK = 30
md = "FEVRIER"
Else
XK = -1
md = "JANVIER"
End If
Exit Do
End If
If (Fix(DJ - 0.5) >= XK) Then Exit Do
Loop
J = DJ - XK
If (DJ > 333) And (J >= 31.5) Then
A = A + 1
J = J - 31
md = "JANVIER"
End If
J0 = Fix(J)
HH = (J - J0) * 24
H = Fix(HH)
MM = (HH - H) * 60
MN = Fix(MM)
S = Fix(MM - MN) * 60
H = H + 12
If H >= 24 Then
H = H - 24
J0 = J0 + 1
End If
End Sub





où puis-je trouver ton source qbasic

Il y a un truc bizarre aux ligne 110 et 115
gosub 170:gosub 515: LS1=LS

en 170 on trouve
gosub 515

avant on a un gosub 500 (ligne 40)
en 500
gosub 6000: JJ=JJ-DN
puis on passe à la ligne 515


En traçant le programme avec la valeur A 02

ligne 40 ---> gosub500 --->gosub 6000
on s'aperçois qu'à la ligne 545, la variable LO0 n'est jamais initialisée.
1 2