Code : Tout sélectionner
;################################################################
;
; Swiss Ephemeris - swedll32.LIB
;
; Interface pour Purebasic 4.0.x
;
; ftp://ftp.astro.com/pub/sweph/
; http://www.astro.com/swisseph/swephprg.htm
;
;################################################################
;asteroides resolus Date: 17 mai 2008 (kernadec) OS: Windows
;le repertoire "ephe" doit contenir les fichiers suivants
;a telecharger a partir du site: ftp://ftp.astro.com/pub/swisseph/ephe/
;################################################################
; le repertoire "ephe"
;SEORBEL.TXT :cupido,hades,zeus,kronos,apollon,admetos,vulkanus,poseidon
;sepl_18.se1
;semo_18.se1
;SEASNAM.TXT
;seas_18.se1
; le repertoire "ast0"
;se00016s.se1 Psyche
;se00019s.se1 Fortuna
;se00030s.se1 Urania
;se00040s.se1 Harmonia
;se00055s.se1 Pandora
;se00078s.se1 Diana
;se00080s.se1 Sappho
;se00157s.se1 Dejanira
;se00433s.se1 Eros ;
;se00588s.se1 Achilles
;se00944s.se1 Hidalgo
;se01221s.se1 Amor
;se01566s.se1 Icarus
;se01685s.se1 Toro
;se01809s.se1 Prometheus
;se01810s.se1 Epimetheus
;se01862s.se1 Apollo
;se01866s.se1 Sisyphus
;se02101s.se1 Adonis
;se03200s.se1 Phaethon
;se03671s.se1 Dionysus
;se04543s.se1 Phoinix
;se04581s.se1 Asclepius
;se05143s.se1 Heracles
;se05145s.se1 Pholus
;se05731s.se1 Zeus
;se07066s.se1 Nessus
;######################## REMARQUE ##############################
;pour les symboles utiliser une police car cela permet de faire dessiner
;l'imprimante et d'avoir une sortie graphique parfaite sur papier.
;il faut faire attention dans la police a ne pas utiliser certains
;caracteres qui ne s'affiche pas dans le cas d'une sortie en PDF
;avec acrobat distiller pour modifier la police caractere voir fontlab45!!
;une simulation 3D de notre systeme solaire reste a faire !!!!
;################################################################
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$
Global path.s
Global c.s
Global i
Global starname.s
;################################################################
path.s="C:\Purebasic42" ; chemin du repertoire principal
;points returned by swe_houses() and swe_houses_armc()
;in array ascmc(0...10)
#SE_ASC = 0
#SE_MC = 1
#SE_ARMC = 2
#SE_VERTEX = 3
#SE_EQUASC = 4 ; "equatorial ascendant"
#SE_NASCMC = 5 ; number of such points
#SEFLG_JPLEPH=1
#SEFLG_SWIEPH=2
#SEFLG_MOSEPH=4
#SEFLG_HELCTR=8
#SEFLG_TRUEPOS=16
#SEFLG_J2000=32
#SEFLG_NONUT=64
#SEFLG_SPEED=256
#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 retro.s(22)
Dim serr.s(255)
Dim plnam.s(255)
Dim asteroide.s(26)
Dim refasteroide.d(26)
Dim Pasteroide.d(26)
Dim pretro.s(26)
Dim Uranianf.s(7)
Dim pUranianf.d(7)
Dim uretro.s(7)
Dim domification.s(9)
Dim ndomification.s(9)
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
#SE_NPLANETS = 21
#SE_AST_OFFSET = 10000
;Hamburger or Uranian ficticious "planets"
#SE_FICT_OFFSET = 40
#SE_FICT_MAX = 999 ;maximum number for ficticious planets
;if taken from file seorbel.txt
#SE_NFICT_ELEM = 15 ;number of built-in ficticious planets
Enumeration
#SPR_Terre
#SPR_OmbreTerre
#SPR_Lune
#SPR_OmbreLune
EndEnumeration
Restore planetes
For n=0 To 22
Read NomPlanete.s(n)
Next n
Restore asteroides
For n=0 To 26
Read asteroide.s(n)
Next n
Restore refasteroides
For n=0 To 26
Read refasteroide.d(n)
Next n
Restore uranianfic
For n=0 To 7
Read uranianf.s(n)
Next n
Restore domifications
For n=0 To 9
Read domification.s(n)
Next n
Restore ndomifications
For n=0 To 9
Read ndomification.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(juliandate.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.s SWE_set_ephe_path(path.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,path+"\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")
set_ephe_path.SWE_set_ephe_path= GetFunction(1,"_swe_set_ephe_path@4")
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(juliandate.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
;################################################################
debut:
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)
;################################################################
set_ephe_path(path+"\ephe") ; chemin des donnees asteroides
;################################################################
For nplanete=#SE_SUN To #SE_INTP_PERG
Calc_ut.l(tjd_ut,nplanete,Iflag,@x.d(0),serr.s); par contre là il faut mettre le tableau ????
Position(nplanete)=x(0)
If x(3) < 0
retro(nplanete)= "r"
Else
retro(nplanete)= " "
EndIf
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
For n=0 To 26 ;ASTEROIDES
Calc_ut.l(tjd_ut,refasteroide(n),Iflag,@x.d(0),serr.s); par contre là il faut mettre le tableau ????
Pasteroide(n)=x(0)
If x(3) < 0
pretro(n)= "r"
Else
pretro(n)= " "
EndIf
Next n
For n=0 To 7 ;URANIANS FICTIF
Calc_ut.l(tjd_ut,#SE_FICT_OFFSET+n,Iflag,@x.d(0),serr.s); par contre là il faut mettre le tableau ????
Puranianf(n)=x(0)
If x(3) < 0
uretro(n)= "r"
Else
uretro(n)= " "
EndIf
Next n
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(ndomification(GetGadgetState(17))),@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)
DrawText(10,30+pas,"PLANETES")
For n=0 To 22
DrawText(10,50+pas,NomPlanete(n))
DrawText(80,50+pas,RSet(StrD(Position(n),4),6," ")+" "+retro(n))
pas+20
Next n
pas=0
For n=1 To 12
DrawText(180,50+pas,"Maison "+Str(n)+" "+StrD(cusp.d(n),2))
pas+20
Next n
pas=0
DrawText(380,30+pas,"ASTEROIDES")
For n=0 To 26
DrawText(360,50+pas,asteroide(n))
DrawText(450,50+pas,RSet(StrD(Pasteroide(n),4),6," ")+" "+pretro(n))
pas+20
Next n
pas=0
DrawText(185,330+pas,"URANIANS FICTIFS")
For n=0 To 7
DrawText(180,350+pas,uranianf(n))
DrawText(280,350+pas,RSet(StrD(Puranianf(n),4),6," ")+" "+uretro(n))
pas+20
Next n
pas=0
DrawText(190,10,"Domification ")
DrawText(180,30,"Selon: "+GetGadgetText(17))
DrawText(370,10,"Jour Julien "+StrD(tjd_ut))
DrawText(10,10,"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)
Goto debut ; lollllll
;################################################################
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
DataSection
asteroides: ; tableau de 27 asteroides
Data.s "Achilles","Adonis","Amor","Apollo","Asclepius","Damocles","Dejanira","Diana","Dionysus","Epimeteus"
Data.s "Eros","Fortuna","Harmonia","Heracles","Hidalgo","Icarus","Nessus","Pandora","Phaethon","Phoinix"
Data.s "Prometheus","Psyche","Sappho","Sisyphus","Toro","Urania","Zeus"
EndDataSection
DataSection
refasteroides: ; ajoutes de 10000 (SE_AST_OFFSET)
Data.d 10588,12101,11221,11862,14581,15335,10157,10078,13671,11810
Data.d 10433,10019,10040,15143,10944,11566,17066,10055,13200,14543
Data.d 11809,10016,10080,11866,11685,10030,15731
EndDataSection
DataSection
Uranianfic: ; tableau de 8 Uranians Fictif
Data.s "Cupidon","Hades","Zeus","Kronos","Apollon","Admetos","Vulkanus","Poseidon"
EndDataSection
DataSection
domifications: ; tableau de 10 domifications
Data.s "Placidus","Koch","Porphyrius","Regiomontanus","Campanus","Equal","Vehlow equal","axial rotation","azimutethoriz","topocentric"
EndDataSection
DataSection
ndomifications: ; tableau des 10 lettres
Data.s "P","K","O","R","C","A","V","X","H","T"
EndDataSection
;################################################################
;########## Domification = ASC("P") ##########################
;0 'P' Placidus
;1 'K' Koch
;2 'O' Porphyrius
;3 'R' Regiomontanus
;4 'C' Campanus
;5 'A' Or 'E' Equal (cusp 1 is Ascendant)
;6 'V' Vehlow equal (Asc. in middle of house 1)
;7 'X' axial rotation system
;8 'H' azimuthal Or horizontal system
;9 'T' Polich/Page ("topocentric" system)
;################################################################
Procedure saisie()
;;######################## defaut ###############################
nom$="Alain"
lieu$="Caen"
jour.l=23
mois.l=6
annee.l=1975
heure.d=1
minut.d=20
latitude=49
Latminute=11
longitude=0
longminute=22
NS$="N"
EO$="O"
;################################################################
OpenWindow(1,20,60,270,260,"dialogue par (Kernadec)",#PB_Window_SystemMenu)
CreateGadgetList(WindowID(1))
;########################### NOM ################################
StringGadget(0, 50, 20, 200, 20, nom$)
StringGadget(1, 50, 60, 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))
;################################################################
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)
;################################################################
ComboBoxGadget(17,160,100,100,100,#PB_ComboBox_Editable)
AddGadgetItem(17,-1,"Placidus")
AddGadgetItem(17,-1,"Koch")
AddGadgetItem(17,-1,"Regiomontanus")
AddGadgetItem(17,-1,"Porphyrius")
AddGadgetItem(17,-1,"Campanus")
AddGadgetItem(17,-1,"Equal")
AddGadgetItem(17,-1,"Vehlow equal")
AddGadgetItem(17,-1,"Rotation Axiale")
AddGadgetItem(17,-1,"azimutouhorizon")
AddGadgetItem(17,-1,"topocentric")
SetGadgetText(17,"Placidus")
SetGadgetState(17,0)
;################################################################
;########################### boutons ############################
ButtonGadget(18, 10, 230, 110, 25, "&Annuler")
ButtonGadget(19, 147, 230, 115, 25, "&Confirmer")
;########################### titres #############################
TextGadget(20, 10, 20, 60, 20, "Nom:")
TextGadget(21, 10, 60, 60, 20, "Lieu:")
TextGadget(22, 15, 125, 120, 20, "Jour Mois Année")
TextGadget(23, 185, 125, 120, 20, "Heures Minutes")
TextGadget(24, 155, 143, 30, 20, "GMT:")
TextGadget(25, 175, 85, 80, 20, "Domifications")
;########################cmd Clavier ############################
AddKeyboardShortcut(1,#PB_Shortcut_Return,19)
AddKeyboardShortcut(1,#PB_Shortcut_C,19)
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 18
CloseWindow(1)
If IsWindow(0)
CloseWindow(0)
EndIf
If IsWindow(2)
CloseWindow(2)
EndIf
End
Case 19
donnees()
Break
OpenWindow(2,400,150,350,270,"resultats",#PB_Window_SystemMenu)
;########################cmd Clavier ############################
AddKeyboardShortcut(2,#PB_Shortcut_Escape,18)
AddKeyboardShortcut(2,#PB_Shortcut_A,18)
;########################### 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
;################################################################
;############## URANIAN FICT ####################################
;CUPIDO = 40
;HADES = 41
;ZEUS = 42
;KRONOS = 43
;APOLLON = 44
;ADMETOS = 45
;VULKANUS = 46
;POSEIDON = 47
;################################################################
;############## ASTEROIDES ######################################
;CHIRON
;PHOLUS 5145
;CERES 1
;PALLAS 2
;JUNO 3
;VESTA 4
;#SE_AST_OFFSET=10000 + #SE_ACHILLES pour obtenir achilles
;ACHILLES (0) 588
;ADONIS (1) 2101
;AMOR (2) 1221
;APOLLO (3) 1862 (different from Witte's Apollon)
;ASCLEPIUS (4) 4581
;DAMOCLES (5) 5335 highly eccentric orbit betw. Mars And Uranus
;DEJANIRA (6) 157
;DIANA (7) 78
;DIONYSUS (8) 3671
;EPIMETHEUS (9) 1810
;EROS (10) 433
;FORTUNA (11) 19
;HARMONIA (12) 40
;HERACLES (13) 5143
;HIDALGO (14) 944
;ICARUS (15) 1566
;NESSUS (16) 7066 third named Centaur (beween Saturn And Pluto)
;PANDORA (17) 55
;PHAETHON (18) 3200
;PHOINIX (19) 4543
;PROMETHEUS (20) 1809
;PSYCHE (21) 16
;SAPPHO (22) 80
;SISYPHUS (23) 1866
;TORO (24) 1685
;URANIA (25) 30
;ZEUS (26) 5731 Greek Jupiter (different from Witte's Zeus)