je n'arrive pas a obtenir les positions des asteroides le tableau reste vide
peut etre un droit de licence de la dll suisse
si quelqu'un a des infos sur le sujet merci
Code : Tout sélectionner
;##############################################
;
; Swiss Ephemeris - swedll32.LIB
;
; Interface pour Purebasic 4.0.x et 5.0.x
;
; ftp://ftp.astro.com/pub/sweph/
; http://www.astro.com/swisseph/swephprg.htm
; https://github.com/koson/Mojave.Astrology
; ;##############################################
Declare donnees()
Declare saisie()
Global jour.l
Global mois.l
Global annee.l
Global minut.d
Global heure.d
Global latitude
Global latminute
Global longitude
Global longminute
Global lat.d
Global lon.d
Global glat.d
Global glon.d
Global heuregmt.d
Global NS$
Global EO$
#SEFLG_JPLEPH=1
#SEFLG_SWIEPH=2
#SEFLG_MOSEPH=4
#SEFLG_SPEED=256
#SEFLG_HELCTR=8
#SEFLG_TRUEPOS=16
#SEFLG_J2000=32
#SEFLG_NONUT=64
#SEFLG_NOGDEFL=512
#SEFLG_NOABERR=1024
#SEFLG_EQUATORIAL=2048
#SEFLG_XYZ=4096
#SEFLG_RADIANS=8192
#SEFLG_BARYCTR=16384
#SEFLG_TOPOCTR=32768
#SEFLG_SIDERAL=65536
#SEFLG_HELCTR=8
#SEFLG_TRUEPOS=16
#SE_CALC_RISE=1
#SE_CALC_SET=2
#SE_CALC_MTRANSIT=4
#SE_CALC_ITRANSIT=8
#SE_ECL_NUT=-1
Dim x.d(6); déclaration du tableau x
Dim x2.d(6)
Dim cusp.d(13)
Dim ascmc.d(10)
Dim attr.d(20)
Dim tret.d(20)
Dim geopos.d(10)
Dim geoposx.d(10)
Dim xnasc.d(6)
Dim xndsc.d(6)
Dim xperi.d(6)
Dim xaphe.d(6)
Dim Position.d(22)
Dim NomPlanete.s(22)
Dim serr.s(255,0)
hcusps.d=0
pName.s=Space(256)
Enumeration 0 Step 1
#SE_GREG_CAL
#SE_JUL_CAL
#ID
EndEnumeration
Enumeration 0 Step 1
#SE_SUN
#SE_MOON
#SE_MERCURY
#SE_VENUS
#SE_MARS
#SE_JUPITER
#SE_SATURN
#SE_URANUS
#SE_NEPTUNE
#SE_PLUTO
#SE_MEAN_NODE
#SE_TRUE_NODE
#SE_MEAN_APOG
#SE_OSCU_APOG
#SE_EARTH
#SE_CHIRON
#SE_PHOLUS
#SE_CERES
#SE_PALLAS
#SE_JUNO
#SE_VESTA
#SE_INTP_APOG
#SE_INTP_PERG
EndEnumeration
Enumeration
#SPR_Terre
#SPR_OmbreTerre
#SPR_Lune
#SPR_OmbreLune
EndEnumeration
Restore planetes
For n=0 To 22
Read NomPlanete.s(n)
Next n
;##############################################
Prototype.d SWE_JulDay(annee.l,mois.l,jour.l,heure.d,flag.l)
Prototype.l SWE_RevJul(juliandate.d,flag.l,*annee.l,*mois.l,*jour.l,*heure.l)
Prototype.l SWE_Day_Of_Week(juliandate.d)
Prototype.d SWE_DegNorm(Angle.d)
Prototype.d SWE_date_conversion(annee.l,mois.l,jour.l,heure.d,cal.b,tjd.d)
Prototype.l SWE_Calc_ut(tjd.d,ipl.l,Iflag.l,*x,serr.s)
Prototype.l SWE_get_planet_name(ipl.l,pName.s)
Prototype.d SWE_deltat(tjd.d)
Prototype.l SWE_pheno(tjd.d,ipl.l,Iflag.l,*attr,serr.s)
Prototype.l SWE_rise_trans(tjd.d,ipl.l,starname.s,epheflag.l,rsmi.l,*geopos,atpress.d,attemp.d,*tret,serr.s)
Prototype.l SWE_houses_ex(tjd.d,Iflag.l,geolat.d,geolon.d,ihsy.l,*cusp,*ascmc)
Prototype.d SWE_sidtime(tjd.d)
Prototype.l SWE_houses_armc(armc.d,geolat.d,eps.d,ihsy.l,*cusp,*ascmc)
;##############################################
;################### premier mode ###########
If OpenLibrary(1,"C:\Purebasic42\swedll32.dll")
JulDay.SWE_JulDay = GetFunction(1,"_swe_julday@24")
RevJul.SWE_RevJul = GetFunction(1,"_swe_revjul@28")
Day_Of_Week.SWE_Day_Of_Week = GetFunction(1,"_swe_day_of_week@8")
DegNorm.SWE_DegNorm = GetFunction(1,"_swe_degnorm@8")
Date_conversion.SWE_date_conversion = GetFunction(1,"_swe_date_conversion@28")
Calc_ut.SWE_Calc_ut= GetFunction(1,"_swe_calc_ut@24")
get_planet_name.SWE_get_planet_name= GetFunction(1,"_swe_get_planet_name@8")
deltat.SWE_deltat= GetFunction(1,"_swe_deltat@8")
pheno.SWE_pheno= GetFunction(1,"_swe_pheno@24")
rise_trans.SWE_rise_trans= GetFunction(1,"_swe_rise_trans@52")
houses_ex.SWE_houses_ex= GetFunction(1,"_swe_houses_ex@40")
sidtime.SWE_sidtime= GetFunction(1,"_swe_sidtime@8")
houses_armc.SWE_houses_armc= GetFunction(1,"_swe_houses_armc@36")
Else
MessageRequester("Error!","Can't open library!",#MB_ICONERROR)
End
EndIf
;##############################################
;################### deuxieme mode ############
;Import "swedll32.lib"
; julday.d(annee.l,mois.l,jour.l,heure.d,flag.l) As "_swe_julday@24"
; RevJul(juliandate.d,flag.l,*annee.l,*mois.l,*jour.l,*heure.l) As "_swe_revjul@28"
; Day_Of_Week.l(juliandate.d) As "_swe_day_of_week@8"
; DegNorm.d(Angle.d) As "_swe_degnorm@8"
; Date_conversion.l(annee.l,mois.l,jour.l,heure.d,cal.b,tjd.d) As "_swe_date_conversion@28"
; Calc_ut.l(tjd.d,ipl.l,Iflag.l,*x,serr.s) As "_swe_calc_ut@24";il ne faut pas mettre x sous forme de tableau. ????
; get_planet_name(ipl.l,pName.s) As "_swe_get_planet_name@8"
; deltat(tjd.d) As "_swe_deltat@8"
; pheno.l(tjd.d,ipl.l,Iflag.l,*attr,serr.s) As "_swe_pheno@24"
; rise_trans.l(tjd.d,ipl.l,starname.s,epheflag.l,rsmi.l,*geopos,atpress.d,attemp.d,*tret,serr.s) As "_swe_rise_trans@52"
; houses_ex.l(tjd.d,Iflag.l,geolat.d,geolon.d,ihsy.l,*cusp,*ascmc) As "_swe_houses_ex@40"
; sidtime.d(tjd.d) As "_swe_sidtime@8"
; houses_armc.l(armc.d,geolat.d,eps.d,ihsy.l,*cusp,*ascmc) As "_swe_houses_armc@36"
;EndImport
;##############################################
Macro myDEBUG(y,m,d,h)
"Le "+RSet(Str(d),2,"0")+"/"+RSet(Str(m),2,"0")+"/"+RSet(Str(y),4,"0")+" à "+StrD(h,2)
EndMacro
Macro DeciMinut(a)
Int(a)+(a-Int(a))*0.60
EndMacro
;################# date actuelle ####################
annee.l=Year(Date())
jour.l=Day(Date())
mois.l=Month(Date())
heure.d=Hour(Date())
minut.d=Minute(Date())
;##############################################
; test ephe
;###heure=heure+minut/60
; annee.l=2006
; jour.l=5
; mois.l=4
; heure.d=3
; minute=48
; seconde=0
;heure=heure+minute/60+seconde/3600
;###lat.d=44.06
;###lon.d=4.47
;###glon.d=Int(lon)+((lon-Int(lon))*100)/60
;###glat.d=Int(lat)+((lat-Int(lat))*100)/60
;##############################################
saisie()
heure.d=heuregmt.d
geopos(0)=glon
geopos(1)=glat
geopos(2)=0
Iflag=#SEFLG_SWIEPH+#SEFLG_SPEED
tjd_ut.d=JulDay(annee,mois,jour,heure,#SE_JUL_CAL)
For nplanete=#SE_SUN To #SE_INTP_PERG;#SE_PLUTO
Calc_ut.l(tjd_ut,nplanete,Iflag,@x.d(0),serr.s); par contre là il faut mettre le tableau ????
Position(nplanete)=x(0)
Next nplanete
If ((Position(1)<Position(0) And Position(0)-Position(1)<180) Or (Position(1)>Position(0) And Position(1)-Position(0)>180))
Elong.s=" Ouest"
Else
Elong.s= " Est"
EndIf
tsid.d=sidtime(tjd_ut)
ecart.d=deltat(tjd_ut)
ecart.d=ecart.d*86400
tsid.d=tsid+glon/15
armc.d=tsid*15
pheno(tjd_ut,#SE_MOON,#SEFLG_HELCTR,@attr.d(0),serr.s)
Debug "Angle de Phase "+ StrD(attr(0),2)
Debug "Phase "+StrD(attr(1),2)
Debug "Elongation "+StrD(attr(2),2)+Elong
Debug "Diamètre Apparent "+StrD(attr(3),2)
Debug "Magnitude apparente "+StrD(attr(4),2)
rise_trans(tjd_ut,#SE_SUN,"",#SEFLG_SWIEPH,#SE_CALC_RISE,@geopos.d(0),1013,15,@tret.d(0),serr.s)
RevJul(tret(0), #SE_JUL_CAL,@annee.l,@mois.l,@jour.l,@heure.d)
Debug "lever du soleil "+myDEBUG(annee,mois,jour,DeciMinut(heure))
rise_trans(tjd_ut,#SE_SUN,"",#SEFLG_MOSEPH,#SE_CALC_SET,@geopos.d(),1013,15,@tret.d(0),serr.s)
RevJul(tret(0), #SE_JUL_CAL,@annee.l,@mois.l,@jour.l,@heure.d)
Debug "coucher du soleil "+myDEBUG(annee,mois,jour,DeciMinut(heure))
rise_trans(tjd_ut,#SE_MOON,"",#SEFLG_SWIEPH,#SE_CALC_RISE,@geopos.d(0),1013,15,@tret.d(0),serr.s)
RevJul(tret(0), #SE_JUL_CAL,@annee.l,@mois.l,@jour.l,@heure.d)
Debug "lever de la lune "+myDEBUG(annee,mois,jour,DeciMinut(heure))
rise_trans(tjd_ut,#SE_MOON,"",#SEFLG_MOSEPH,#SE_CALC_SET,@geopos.d(),1013,15,@tret.d(0),serr.s)
RevJul(tret(0), #SE_JUL_CAL,@annee.l,@mois.l,@jour.l,@heure.d)
Debug "coucher de la lune "+myDEBUG(annee,mois,jour,DeciMinut(heure))
Calc_ut(tjd_ut,#SE_ECL_NUT,0,@x.d(0),serr.s)
eps_true.d= x(0)
houses_armc(armc.d,glat.d,eps_true.d,Asc("P"),@cusp.d(0),@ascmc.d(0))
;##############################################
If OpenWindow(#ID, 300, 50, 600, 600, "Astrologie", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget) = 0 Or CreateGadgetList(WindowID(#ID)) = 0
End
EndIf
StartDrawing(WindowOutput(#ID))
DrawingMode(1)
For n=0 To 22
DrawText(10,50+pas,NomPlanete(n))
DrawText(80,50+pas,RSet(StrD(Position(n),4),6," "))
pas+20
Next n
pas=0
For n=1 To 12
DrawText(200,50+pas,"Maison "+Str(n)+" "+StrD(cusp.d(n),2))
pas+20
Next n
DrawText(200,10,"Domification Placidus")
DrawText(370,10,"Jour Julien "+StrD(tjd_ut))
DrawText(20,20,"Date: "+GetGadgetText(2)+"/"+GetGadgetText(3)+"/"+GetGadgetText(4))
StopDrawing()
;##############################################
Debug " "
jd1.d = JulDay(1988,1, 1,12.23,#SE_JUL_CAL)
Debug jd1
RevJul( jd1, #SE_JUL_CAL, @annee.l, @mois.l, @jour.l, @heure.d)
Debug myDEBUG(annee, mois, jour, heure)
;##############################################
jd2.d = JulDay(2006,2,16,14.00,#SE_GREG_CAL)
Debug jd2
RevJul( jd2, #SE_GREG_CAL, @annee.l, @mois.l, @jour.l, @heure.d)
Debug myDEBUG(annee, mois, jour, heure)
;##############################################
Select Day_Of_Week( jd2 )
Case 0: Debug "Lundi"
Case 1: Debug "Mardi"
Case 2: Debug "Mercredi"
Case 3: Debug "Jeudi"
Case 4: Debug "Vendredi"
Case 5: Debug "Samedi"
Case 6: Debug "Dimanche"
EndSelect
;##############################################
Debug DegNorm(375.33333)
;##############################################
done.l = #False
Repeat
event.l = WaitWindowEvent()
Select event
Case #PB_Event_CloseWindow
done = #True
Case #PB_Event_MoveWindow
Case #PB_Event_SizeWindow
Default
EndSelect
Until done = #True
CloseWindow(#ID)
DataSection
planetes:
Data.s "Soleil","Lune","Mercure","Venus","Mars","Jupiter","Saturne","Uranus","Neptune","Pluton","Meanod","truenode","Meanapog","Ostuapog","Earth","Chiron","Pholus","Ceres","Pallas","Juno","Vesta","Intpapog","Intperge"
EndDataSection
; IDE Options = PureBasic v4.00 - Beta 6 (Windows - x86)
; CursorPosition = 158
; FirstLine = 123
; Folding = -
; IDE Options = PureBasic v4.00 - Beta 7 (Windows - x86)
; CursorPosition = 114
; FirstLine = 75
; Folding = -
; IDE Options = PureBasic v4.00 - Beta 8 (Windows - x86)
; CursorPosition = 110
; FirstLine = 91
; Folding = -
; IDE Options = PureBasic v4.00 - Beta 9 (Windows - x86)
; CursorPosition = 220
; FirstLine = 178
; Folding = -
; Date: 28. Avril 2008 (kernadec)
; OS: Windows
;
Procedure saisie()
;;######################## defaut ############################
nom$="Alain"
lieu$="Caen"
jour.l=23
mois.l=6
annee.l=1971
heure.d=11
minut.d=20
latitude=49
Latminute=11
longitude=0
longminute=22
NS$="N"
EO$="O"
;############################################################
OpenWindow(1,20,150,270,260,"dialogue par (Kernadec)",#PB_Window_SystemMenu)
CreateGadgetList(WindowID(1))
;######################## NOM ################################
StringGadget(0, 50, 40, 200, 20, nom$)
StringGadget(1, 50, 90, 200, 20, lieu$)
;#############################################################
;########### reste a traite les années bisextile #############
;########### sinon prendre une boite calendier #############
;######################### DATE ##############################
ComboBoxGadget(2,10,140,37,140,#PB_ComboBox_Editable)
For x = 1 To 31
AddGadgetItem(2,-1,Str(x)) ;Jour
Next
SetGadgetState(2,jour-1)
ComboBoxGadget(3,50,140,37,140,#PB_ComboBox_Editable)
For x = 1 To 12
AddGadgetItem(3,-1,Str(x)) ;mois
Next
SetGadgetState(3,mois-1)
ComboBoxGadget(4,90,140,48,200,#PB_ComboBox_Editable)
For x = 1 To 2300
AddGadgetItem(4,-1,Str(x)) ;année
Next
SetGadgetState(4, Abs(annee-1))
;########################## HEURE ############################
ComboBoxGadget(5,185,140,37,100,#PB_ComboBox_Editable)
For x = 0 To 23
AddGadgetItem(5,-1,Str(x)) ;heure
Next
SetGadgetState(5,Abs(heure-1))
ComboBoxGadget(6,225,140,37,100,#PB_ComboBox_Editable)
For x = 0 To 59
AddGadgetItem(6,-1,Str(x)) ;minute
Next
SetGadgetState(6,Abs(minut-1))
;######################## LATITUDE ###########################
ComboBoxGadget(7,20,180,37,100,#PB_ComboBox_Editable)
For x = 0 To 89
AddGadgetItem(7,-1,Str(x)) ;latitude degrés
Next
SetGadgetState(7,Abs(latitude-1))
ComboBoxGadget(8,70,180,37,100,#PB_ComboBox_Editable)
For x = 0 To 59
AddGadgetItem(8,-1,Str(x)) ;latitude minutes
Next
SetGadgetState(8,Abs(latminute-1))
;######################## radio boutons ######################
Frame3DGadget(9, 10, 165, 110, 58, "Latitude en degrés")
OptionGadget(10, 19, 203, 45, 17, "&Nord")
OptionGadget(11, 69, 203, 45, 17, "&Sud")
SetGadgetState(10, 1)
;######################### LONGITUDE #########################
ComboBoxGadget(12,157,180,43,100,#PB_ComboBox_Editable)
For x = 0 To 179
AddGadgetItem(12,-1,Str(x)) ;longitude degrés
Next
SetGadgetState(12,Abs(longitude-1))
ComboBoxGadget(13,212,180,37,100,#PB_ComboBox_Editable)
For x = 0 To 59
AddGadgetItem(13,-1,Str(x)) ;longitude minutes
Next
SetGadgetState(13,Abs(longminute-1))
;######################## radio boutons ######################
;(si le n° d'optiongadjet est=16 il devient actif bug????)
;pourquoi n°16 = (buttongadjet DEFAUT) cela reste un mystere??
;dans ce cas peut etre mais pas grave il est devenu frame lol
;#############################################################
Frame3DGadget(16, 147, 165, 115, 58, "Longitude en degrés")
OptionGadget(14, 156, 203, 45, 17, "&Est")
OptionGadget(15, 204, 203, 45, 17, "&Ouest")
SetGadgetState(14, 1)
;#############################################################
;######################## boutons ############################
ButtonGadget(17, 10, 230, 110, 25, "&Annuler")
ButtonGadget(18, 147, 230, 115, 25, "&Confirmer")
;######################## titres #############################
TextGadget(19, 10, 40, 60, 20, "Nom:")
TextGadget(20, 10, 90, 60, 20, "Lieu:")
TextGadget(21, 15, 125, 120, 20, "Jour Mois Année")
TextGadget(22, 185, 125, 120, 20, "Heures Minutes")
TextGadget(23, 155, 143, 30, 20, "GMT:")
;#####################cmd Clavier ############################
AddKeyboardShortcut(1,#PB_Shortcut_Return,18)
AddKeyboardShortcut(1,#PB_Shortcut_C,18)
AddKeyboardShortcut (1,#PB_Shortcut_N,10)
AddKeyboardShortcut(1,#PB_Shortcut_S,11)
AddKeyboardShortcut(1,#PB_Shortcut_E,14)
AddKeyboardShortcut(1,#PB_Shortcut_O,15)
;#############################################################
;#############################################################
Repeat
event=WaitWindowEvent()
If Event = #PB_Event_Gadget Or Event = #PB_Event_Menu
Select EventGadget()
Case 10
SetGadgetState(10, 1)
Case 11
SetGadgetState(11, 1)
Case 14
SetGadgetState(14, 1)
Case 15
SetGadgetState(15, 1)
Case 17
If IsWindow(2)
CloseWindow(2)
EndIf
Case 18
donnees()
Break
OpenWindow(2,400,150,350,270,"resultats",#PB_Window_SystemMenu)
;#####################cmd Clavier ############################
AddKeyboardShortcut(2,#PB_Shortcut_Escape,17)
AddKeyboardShortcut(2,#PB_Shortcut_A,17)
;######################## Affiche ############################
StartDrawing(WindowOutput(2))
DrawingMode(1)
DrawText(2,20,"Nom: "+GetGadgetText(0))
DrawText(2,50,"Lieu: "+GetGadgetText(1))
DrawText(2,80,"Date: "+GetGadgetText(2)+"/"+GetGadgetText(3)+"/"+GetGadgetText(4))
DrawText(2,110,"heure: "+GetGadgetText(5)+"h"+GetGadgetText(6)+"' ")
DrawText(2,140,"Latitude: "+GetGadgetText(7)+"°"+GetGadgetText(8)+"' "+NS$)
DrawText(2,170,"Longitude: "+GetGadgetText(12)+"°"+GetGadgetText(13)+"' "+EO$)
DrawText(2,200,"convers heure : "+StrD(heuregmt,4))
DrawText(2,230,"convers lat: "+StrD(glat.d,4)+" <-> convers long: "+StrD(glon.d,4))
StopDrawing()
Case #PB_Event_CloseWindow
CloseWindow(1)
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
;######################################################################
EndProcedure
Procedure donnees()
;############### Traitement des données ######################
nom$=GetGadgetText(0)
lieu$=GetGadgetText(1)
jour.l=Val(GetGadgetText(2))
mois.l=Val(GetGadgetText(3))
annee.l=Val(GetGadgetText(4))
heure.d=Val(GetGadgetText(5))
minut.d=Val(GetGadgetText(6))
latitude=Val(GetGadgetText(7))
latminute=Val(GetGadgetText(8))
longitude=Val(GetGadgetText(12))
longminute=Val(GetGadgetText(13))
lat=latitude+(latminute/100)
lon=longitude+(longminute/100)
If GetGadgetState(10)
NS$="N"
Else
NS$="S"
lat=0-lat
EndIf;
If GetGadgetState(14)
EO$="E"
Else
EO$="O"
lon=0-lon
EndIf
heuregmt=heure+minut/60+seconde/3600
glon.d=Int(lon)+((lon-Int(lon))*100)/60
glat.d=Int(lat)+((lat-Int(lat))*100)/60
EndProcedure