asteroides (resolu)

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

asteroides (resolu)

Message par kernadec »

bonjour

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)

Good07
Messages : 308
Inscription : ven. 23/avr./2004 18:08
Localisation : Hérault 34190 Laroque

Message par Good07 »

Bonjour Kernadec,

Je vois que tu t'es bien débrouillé avec la Dll. J'ai testé ton programme, pas mal mais j'ai quelques erreurs. :(
Au début les astéroides ne s'affichaient pas, pourtant j'avais bien créé le dossier ast0. En fait j'ai trouvé la solution, il faut bien créé un dossier ast0 mais celui-ci doit ce trouver dans le dossier ephe... :D
A préciser dans ton programme.
Ensuite dans le dossier ast0, j'ai bien mis tous les fichiers que tu donnes (J'ai vérifié trois fois) pourtant je n'ai pas la position des astéroides suivant:
Adonis
Amor
Apollo
Asclepius
Damocles
Dionysus
Epimetus
Héracles
Icarus
Nessus
Phaethon
Prometheus
Sisiphus
Toro
Zeus
Pour le reste ça marche, mais j'ai quelques problèmes de gestion avec l'interface, peut-être a cause de ma version de PureBasic 4.20 Beta 5 ?
Impossible de modifier le prénom et le lieu, je suis limité à 4 caractères ?
Impossible aussi de fermer l'interface. L'appuie sur la croix rouge m'affiche la fenêtre des positions :(
Je suis obliger de quitter le programme par la tête de mort sur l'éditeur.
J'espère que d'autre personnes testeront pour confirmer car je n'ai pas une configuration courante. Je travaille sous Mac et j'utilise Boot Camp pour utiliser Windows, mais jusqu'a maintenant je n'avais pas eu de problèmes.

A+

André.
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

bonjour good07
il faut aller chercher sur le site "ftp://ftp.astro.com/pub/swisseph" dans le repertoire "\ephe\ast0\" le fichiers asteroides
et les copier dans le repertoire "ephe" cree dans le dossier purebasic exemple C:\purebasic\ephe
et aussi les 3 fichiers "sepl_18.se1 semo_18.se1 seas_18.se1" du repertoire "\ephe\" du site ftp

les problemes de l'interface sont due aux deux boucles normal, ce n'est qu'un exemple test
pour obtenir les resultats tout reste a faire a partir de ce moteur

quand on as obtenu la les resultats pour recommencer un calcul, il suffit de fermer la grande fenetre
si on pour quitter aussi fermer la grande fenetre et clic annuler ce n'est pas tres pratique mais pour le test c'est cool
chez moi ca fonctionne. pour les nons et prenoms je ne les ai pas fait afficher dans la grande fenetre
mais dans une fenetre test qui n'apparait pas dans dans l'exemple a cause du break vers l'autre fenetre lolllll
pour la earth 000000 je pense que la position ne s'obtient qu'un heliocentrisme

j'espere avoir repondu a ta demande
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

voila je remet le code avec quelques modifs en effect je n'avais pas ete clair ce programe test fonctionne sur windows en l'etat PB4.10
pour mac osx et linux ??
cela dit, voila les bases pour creer un programe d'astro

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/
;################################################################
;  adresse des fichiers "ftp://ftp.astro.com/pub/swisseph/ephe/"
;SEORBEL.TXT :cupido,hades,zeus,kronos,apollon,admetos,vulkanus,poseidon 
;sepl_18.se1
;semo_18.se1
;SEASNAM.TXT
;seas_18.se1
;       suite avec "ftp://ftp.astro.com/pub/swisseph/ephe/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
;                                    
;     ATTENTION ADAPTER LES CHEMINS DES LIGNES 83 ET 313   
;######################## 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 nom$              
Global lieu$
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:\program Files\Purebasic"  ;  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 
;################################################################
;######################## 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"
;################################################################
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 ############### Pour Recommencer Fermer Cette Fenetre->>>>>", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget) = 0 Or CreateGadgetList(WindowID(#ID)) = 0 
  End 
EndIf 
StartDrawing(WindowOutput(#ID)) 
DrawingMode(1) 
DrawText(10,30+pas,"PLANETES")
DrawText(140,290,"<-Lilith")
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))
DrawText(30,550,"Nom: "+GetGadgetText(0))
DrawText(30,570,"Lieu: "+GetGadgetText(1))
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()

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/Quitter")
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       ; sortie vers affichage des resultats
         OpenWindow(2,400,150,350,270,"combo test",#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)

Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

voila aussi pour ameliorer les tests

Code : Tout sélectionner

;################################################################
;modifications du code pour cette partie qui avait des entree avec moins un
;et aussi pour conserver la derniere saisie option gadjet
;si l'on veut faire plusieurs tests sans avoir a relancer le prg

;############################## 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))
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))
;############################ 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))
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))
;################################################################
Frame3DGadget(9, 10, 165, 110, 58, "Latitude en degrés")
OptionGadget(10, 19, 203, 45, 17, "&Nord")
OptionGadget(11, 69, 203, 45, 17, "&Sud")
If NS$="N"
SetGadgetState(10, 1)
Else
SetGadgetState(11, 1)
EndIf
;############################ 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))
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))
;########################### 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")
If EO$="E"
SetGadgetState(14, 1)
Else
SetGadgetState(15, 1)
EndIf


;##################   autre modifs ##############################

;################################################################
Debug DegNorm(375.33333) 
;################################################################
;ajouter un appel a la procedure donnees pour conserver la derniere saisie 
donnees()
Good07
Messages : 308
Inscription : ven. 23/avr./2004 18:08
Localisation : Hérault 34190 Laroque

Message par Good07 »

J'ai bien tous ce qu'il faut dans mes répertoires, ainsi que les trois fichiers que tu me donnes, mais cela ne résoud pas mon problème, puisqu'ils étaient déjà présent quand j'ai fais mes premier test. Les positions des astéroides que je te donnes précédement ne sont toujours pas affichées. :(
J'ai fait toutes les corrections que tu donnes par la suite mais c'est toujours pareil.
Je pense qu'il doit manquer quelque chose mais je ne vois pas où.
Peut-être que la version que tu postes et celle que tu utilises ne sont pas identique ?
je te donnes l'esquisse du programme que j'avais commencé avec cette DLL. C'est moins abouti que le tien, mais tu peux peut-être en tirer quelques astuces pour le formatage des données.

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
; 
;##############################################

#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(12)
Dim Planete.s(9)
Dim Signe.s(12)
Dim Maison.s(12)
serr.s=""
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
EndEnumeration

Enumeration
  #SPR_Terre
  #SPR_OmbreTerre
  #SPR_Lune
  #SPR_OmbreLune
EndEnumeration
 
Restore planetes
For n=0 To 9
  Read Planete.s(n)
Next n
Restore signes
For n=0 To 11
  Read Signe.s(n)
Next n
Restore Maisons
For n=0 To 11
  Read Maison.s(n)
Next n





;***************************programme principal****************************************

;##############################################

Import "swedll32.lib"
  JulDay.d(annee.l,mois.l,jour.l,heure.d,flag.l) As "_swe_julday@24"
  Day_Of_Week.l(juliandate.d) As "_swe_day_of_week@8"
  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. ????
  deltat.d(tjd.d) As "_swe_deltat@8"
  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 FNSI(x)
  Int(x/30)+1
EndMacro

Macro FNLAS(x)
  x-(FNSI(x)-1)*30
EndMacro

Macro FNDIV(A,B)
  -(A % B=0)
EndMacro

Macro FNBIS(A)
  FNDIV(A,4)*(1-FNDIV(A,100)+FNDIV(A,100)*FNDIV(A,400))
EndMacro

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

; annee.l=Year(Date())
; jour.l=Day(Date())
; mois.l=Month(Date())
; heure.d=Hour(Date())
; minut.d=Minute(Date())
;heure=heure+minut/60
annee.l=1953
jour.l=24
mois.l=1
heure.d=8
h.d=heure
minute.d=0
seconde.d=0
heure=heure+minute/60+seconde/3600
lat.d=48.17
lon.d=6.56
glon.d=DeciMinut(lon)
glat.d=DeciMinut(lat)
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)

Select Day_Of_Week(tjd_ut)
  Case 0: Day$= "Lundi"
  Case 1: Day$= "Mardi"
  Case 2: Day$= "Mercredi"
  Case 3: Day$= "Jeudi"
  Case 4: Day$= "Vendredi"
  Case 5: Day$= "Samedi"
  Case 6: Day$= "Dimanche"
EndSelect

For nplanete=#SE_SUN To #SE_PLUTO
  Calc_ut(tjd_ut,nplanete,Iflag,@x.d(0),serr.s)
  Position(nplanete)=x(0)
  Position(nplanete)=DeciMinut(Position(nplanete))
Next nplanete

tsid.d=sidtime(tjd_ut)
ecart.d=deltat(tjd_ut)
ecart.d=ecart.d*86400
tsid.d=tsid+glon/15
armc.d=tsid*15
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, 0, 0, 800, 600, "Astrologie", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0 Or CreateGadgetList(WindowID(#ID)) = 0
  End
EndIf
StartDrawing(WindowOutput(#ID))
DrawingMode(1)
For n=0 To 9
  DrawText(10,50+pas,Planete(n))
  a$=StrD(FNLAS(Position(n)),2)
  If Len(a$)<5
    DrawText(80,50+pas,"  "+a$+"  "+Signe(FNSI(Position(n))-1))
  Else
    DrawText(80,50+pas,StrD(FNLAS(Position(n)),2)+"  "+Signe(FNSI(Position(n))-1))
  EndIf
  pas+20
Next n
pas=0
For n=1 To 12
  DrawText(300,50+pas,Maison(n-1))
  cusp.d(n)=DeciMinut(cusp.d(n))
  a$=StrD(FNLAS(cusp.d(n)),2)
  If Len(a$)<5
    DrawText(330,50+pas,"  "+a$+"  "+Signe(FNSI(cusp.d(n))-1))
  Else
    DrawText(330,50+pas,StrD(FNLAS(cusp.d(n)),2)+"  "+Signe(FNSI(cusp.d(n))-1))
  EndIf
  pas+20
Next n
DrawText(10,10,Day$+" "+Str(jour)+"/"+Str(mois)+"/"+Str(annee)+" "+"à"+" "+Str(h)+"h"+Str(minute))
DrawText(300,10,"Domification Placidus")
;DrawText(370,10,"Jour Julien "+StrD(tjd_ut),2))
StopDrawing()
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"
signes:
Data.s "Belier","Taureau","Gemeaux","Cancer","Lion","Vierge","Balance","Scorpion","Sagitaire","Capricorne","Verseau","Poisson"
Maisons:
Data.s "AS","II","III","FC","V","VI","DS","VIII","IX","MC","XI","XII"
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 = -
; IDE Options = PureBasic v4.02 (Windows - x86)
; CursorPosition = 147
; FirstLine = 115
A+

André
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

merci je vais regarder en attendant je suis en train de passer la DLL en revue pour voir ce que je peux en tirer biensur avec le doc qui est fournie sur le site suisse mais bon je suis vieux et pas tres bon en british mais je prend gougle tranlat et pour les textes techniques il se debrouille pas mal
et voila un bout de code

Code : Tout sélectionner

;##################################################
;##### quelques saisies de moins a faire ##########
;##################################################

;eclipse codes
#SE_ECL_CENTRAL = 1
#SE_ECL_NONCENTRAL = 2
#SE_ECL_TOTAL = 4
#SE_ECL_ANNULAR = 8
#SE_ECL_PARTIAL = 16
#SE_ECL_ANNULAR_TOTAL = 32
#SE_ECL_PENUMBRAL = 64
#SE_ECL_VISIBLE = 128
#SE_ECL_MAX_VISIBLE = 256
#SE_ECL_1ST_VISIBLE = 512
#SE_ECL_2ND_VISIBLE = 1024
#SE_ECL_3RD_VISIBLE = 2048
#SE_ECL_4TH_VISIBLE = 4096

;mode sidérale pour swe_set_sid_mode()
#SE_SIDM_FAGAN_BRADLEY = 0
#SE_SIDM_LAHIRI = 1
#SE_SIDM_DELUCE = 2
#SE_SIDM_RAMAN = 3
#SE_SIDM_USHASHASHI = 4
#SE_SIDM_KRISHNAMURTI = 5
#SE_SIDM_DJWHAL_KHUL = 6
#SE_SIDM_YUKTESHWAR = 7
#SE_SIDM_JN_BHASIN = 8
#SE_SIDM_BABYL_KUGLER1 = 9
#SE_SIDM_BABYL_KUGLER2 = 10
#SE_SIDM_BABYL_KUGLER3 = 11
#SE_SIDM_BABYL_HUBER = 12
#SE_SIDM_BABYL_ETPSC = 13
#SE_SIDM_ALDEBARAN_15TAU = 14
#SE_SIDM_HIPPARCHOS = 15
#SE_SIDM_SASSANIAN = 16
#SE_SIDM_GALCENT_0SAG = 17
#SE_SIDM_J2000 = 18
#SE_SIDM_J1900 = 19
#SE_SIDM_B1950 = 20
#SE_SIDM_USER = 255

#SE_NSIDM_PREDEF = 21

#SE_SIDBITS = 256
                            ;pour la projection sur écliptique de t0
#SE_SIDBIT_ECL_T0 = 256
                            ;pour la projection sur le plan du système solaire
#SE_SIDBIT_SSY_PLANE = 512

; modes de noeuds planétaires, swe_nod_aps(), swe_nod_aps_ut()
#SE_NODBIT_MEAN = 1
#SE_NODBIT_OSCU = 2
#SE_NODBIT_OSCU_BAR = 3
#SE_NODBIT_FOPOINT = 256

' indices for swe_rise_trans()
#SE_CALC_RISE = 1
#SE_CALC_SET = 2
#SE_CALC_MTRANSIT = 4
#SE_CALC_ITRANSIT = 8
#SE_BIT_DISC_CENTER = 256         ;/* à ajouter à SE_CALC_RISE/SET */
                                  ;/* lieu requis du centre commun des disques */
#SE_BIT_NO_REFRACTION = 512       ;/* à ajouter à SE_CALC_RISE/SET, */
                                  ;/* si la réfraction ne doit pas être considérée */

; bits pour la conversion des données avec swe_azalt() and swe_azalt_rev()
#SE_ECL2HOR = 0
#SE_EQU2HOR = 1
#SE_HOR2ECL = 0
#SE_HOR2EQU = 1

#TIME_ZONE_ID_DAYLIGHT = 2


; pour swe_refrac()
#SE_TRUE_TO_APP = 0
#SE_APP_TO_TRUE = 1


;###############################################################################
;##########################  STUCTURES  ########################################
;###############################################################################

Dim TIcon.NOTIFYICONDATA

Structure NOTIFYICONDATA
  cbSize.l
  hWnd.l
  uId.l
  uFlags.l
  ucallbackMessage.l
  hIcon.l
  szTip.s=Space(64)
EndStructure

Structure  SYSTEMTIME        
  wYear.d
  wMonth.d
  wDayOfWeek.d
  wDay.d
  wHour.d
  wMinute.d
  wSecond.d
  wMilliseconds.d
EndStructure 

Structure TIME_ZONE_INFORMATION
  Bias.l                     ; baser sur le temps de déplacement en minutes 
  StandardName.b             ; Nom de l'heure d'été du fuseau horaire 1to64 
  StandardDate.SYSTEMTIME    ; Début de l'heure par défaut 
  StandardBias.l             ; Décalage horaire supplémentaire par défaut du temps 
  DaylightName.b             ; Nom de l'heure d'été du fuseau horaire 1to64 
  DaylightDate.SYSTEMTIME    ; Début de l'heure d'été 
  DaylightBias.l             ; Décalage horaire supplémentaire de l'heure d'été
EndStructure 

Structure orient
    i.l
    s.s=Space(16)
EndStructure


;########################################################################

Dim iday%
Dim imonth%
Dim iyear%
Dim ihour%
Dim imin
Dim starname.s
Dim lon
Dim lat
Dim tjd_ut
Dim tdj_et
Dim fract
Dim Min
Dim Sec
Dim i
Dim x.d(6)
;########################################################################
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 cal.b
Dim o.orient
Dim ss.s=Space(16)
Dim h
Dim olen
Dim RetVal
Dim tjd_et
Dim t2
Dim ut$
Dim planet
Dim iflag
Dim serr$
Dim plnam$
Dim ret_flag
Dim A
Dim armc.d
Dim eps.d
Dim hsys
Dim xpin.d(2)


;####################################################################################"
Prototype.l SWE_azalt(tjd_ut.d,calc_flag.l,*geopos,atpress.d,attemp.d,*xin,*xaz)
Prototype.l SWE_azalt_rev(tjd_ut.d,calc_flag.l,*geopos,*xin,*xout)
Prototype.l SWE_Calc(tjd.d,ipl.l,Iflag.l,*x,serr.s)
Prototype.l SWE_Calc_ut(tjd.d,ipl.l,Iflag.l,*x,serr.s)
Prototype.l SWE_close(ivoid.l)
Prototype.d SWE_cotrans(*xpo,*xpn,eps)
Prototype.d SWE_cotrans_sp(*xpo,*xpn,eps)
Prototype.l SWE_cs2degstr(t,s)
Prototype.l SWE_cs2lonlatstr(t,pchar,mchar,s)
Prototype.l SWE_cs2timestr(t,sep,supzero,s)
Prototype.l SWE_ccsnorm(p)
Prototype.l SWE_csroundsec(p)
Prototype.l SWE_d2l()
Prototype.d SWE_date_conversion(annee.l,mois.l,jour.l,heure.d,cal.b,tjd.d)
Prototype.l SWE_Day_Of_Week(juliandate.d)
 ;SWE_Degmidp
Prototype.d SWE_DegNorm(juliandate.d) 
Prototype.d SWE_deltat(juliandate.d) 
Prototype.l SWE_difcs2n(p1,p2) 
Prototype.l SWE_difcsn(p1,p2) 
Prototype.d SWE_difdeg2n(p1,p2) 
Prototype.d SWE_difdegn(p1,p2)
;SWE_difrad2n 
Prototype.l SWE_fixstar(star.s,tjd.d,Iflag.l,*x,serr.s)
Prototype.l SWE_fixstar_ut(star.s,tjd.d,Iflag.l,*x,serr.s)
;SWE_gauguelin_sector
Prototype.d SWE_get_ayanamsa(tjd_et) 
;SWE_get_ayanamsa_name
Prototype.d SWE_get_ayanamsa_ut(tjd_ut) 
Prototype.l SWE_get_planet_name(ipl.l,pName.s)
Prototype.d SWE_get_tid_acc()
Prototype.l SWE_houses_pos(armc.d,geolat.d,eps.d,ihsy.l,*xpin,serr.s)
Prototype.l SWE_houses(tjd_ut.d,geolat.d,geolon.d,ihsy.l,*hcusps,*ascmc)
Prototype.l SWE_houses_armc(armc.d,geolat.d,eps.d,ihsy.l,*hcusps,*ascmc)
Prototype.l SWE_houses_ex(tjd_ut.d,iflag.l,geolat.d,geolon.d,ihsy.l,*hcusps,*ascmc)
Prototype.d SWE_JulDay(annee.l,mois.l,jour.l,heure.d,flag.l) 
Prototype.l SWE_lun_eclipse_how(tjd_ut.d,ifl.l,*geopos,*attr,serr.s)
Prototype.l SWE_lun_eclipse_when(tjd_start.d,ifl.l,ifltype.l,*tret,backward.l,serr.s)
;SWE_lun_occult_when_glob
;SWE_lun_occult_when_loc
;SWE_lun_occult_where
Prototype.l SWE_nod_aps(tjd_et.d,ipl.l,iflag.l,method.l,*xnasc,*xndsc,*xperi,*xaphe,serr.s)
Prototype.l SWE_nod_aps_ut(tjd_ut.d,ipl.l,iflag.l,method.l,*xnasc,*xndsc,*xperi,*xaphe,serr.s)
Prototype.l SWE_pheno(tjd.d,ipl.l,Iflag.l,*attr,serr.s)
Prototype.l SWE_pheno_ut(tjd.d,ipl.l,Iflag.l,*attr,serr.s)
;SWE_rad_midp
;SWE_rad_norm
Prototype.l SWE_refrac(inalt.d,atpress.d,attemp.d,calc_flag.l)
Prototype.l SWE_RevJul(juliandate.d,flag.l,*annee.l,*mois.l,*jour.l,*heure.l) 
Prototype.l SWE_rise_trans(tjd_ut.d,ipl.l,starname.s,epheflag.l,rsmi.l,*geopos,atpress.d,attemp.d,*tret,serr.s)
Prototype.s SWE_set_ephe_path(path.s)
Prototype.s SWE_set_jpl_file(file.s)
Prototype.l SWE_set_sid_mode(sid_mode.d,t0.d,ayan_t0.d)
Prototype.d SWE_set_tid_acc(x.d)
Prototype.d SWE_set_topo(geolon.d,geolat.d,altitude.d)
Prototype.d SWE_sidtime0(tjd_ut.d,ecl.d,nut.d)
Prototype.d SWE_sidtime(tjd_ut.d)
Prototype.l SWE_sol_eclipse_how(tjd_ut.d,ifl.l,*geopos,*attr,serr.s)
Prototype.l SWE_sol_eclipse_when_glob(tjd_start.d,ifl.l,ifltype.l,*tret,backward.d,serr.s)
Prototype.l SWE_sol_eclipse_when_loc(tjd_start.d,ifl.l,*tret,*attr,backward.d,serr.s)
Prototype.l SWE_sol_eclipse_where(tjd_ut.d,ifl.l,*geopos,*attr,serr.s)
;SWE_split_deg
Prototype.l SWE_time_equ(tjd_ut.d,*e,serr.s)
;###############################################################################
;########################## APPELL DLL  ########################################
;###############################################################################
azalt.SWE_azalt= GetFunction(1,"_swe_azalt@40")
azalt_rev.SWE_azalt_rev= GetFunction(1,"_swe_azalt_rev@24") 
Calc.SWE_Calc= GetFunction(1,"_swe_calc_ut@24") 
Calc_ut.SWE_Calc_ut= GetFunction(1,"_swe_calc_ut@24") 
close.SWE_close= GetFunction(1,"_swe_close_d@0")
cotrans.SWE_cotrans= GetFunction(1,"_swe_calc_ut@16")
cotrans_sp.SWE_cotrans_sp= GetFunction(1,"_swe_calc_ut@16")
cs2degstr.SWE_cs2degstr= GetFunction(1,"_swe_cs2degstr@8")
cs2lonlatstr.SWE_cs2lonlatstr= GetFunction(1,"_swe_cs2lonlatstr@16")
cs2timestr.SWE_cs2timestr= GetFunction(1,"_swe_cs2timestr@16")
ccsnorm.SWE_ccsnorm= GetFunction(1,"_swe_csnorm@4")
csroundsec.SWE_csroundsec= GetFunction(1,"_swe_csroundsec@4")
d2l.SWE_d2l= GetFunction(1,"_swe_d2l@8")
Date_conversion.SWE_date_conversion = GetFunction(1,"_swe_date_conversion@28") 
Day_Of_Week.SWE_Day_Of_Week = GetFunction(1,"_swe_day_of_week@8")
;SWE_Degmidp@16
DegNorm.SWE_DegNorm = GetFunction(1,"_swe_degnorm@8")
deltat.SWE_deltat= GetFunction(1,"_swe_deltat@8")
difcs2n.SWE_difcs2n= GetFunction(1,"_swe_difcs2n@8")
difcsn.SWE_difcsn= GetFunction(1,"_swe_difcsn@8")
difdeg2n.SWE_difdeg2n= GetFunction(1,"_swe_difdeg2n@16")
difdegn.SWE_difdegn= GetFunction(1,"_swe_difdegn@16")
;SWE_difrad2n@16
fixstar.SWE_fixstar= GetFunction(1,"_swe_fixstar@24") 
fixstar_ut.SWE_fixstar_ut= GetFunction(1,"_swe_fixstar_ut@24")
;SWE_gauguelin_sector@52 
get_ayanamsa.SWE_get_ayanamsa= GetFunction(1,"_swe_get_ayanamsa@8")
;SWE_get_ayanamsa_name@4
get_ayanamsa_ut.SWE_get_ayanamsa_ut= GetFunction(1,"_swe_get_ayanamsa_ut@8")
get_planet_name.SWE_get_planet_name= GetFunction(1,"_swe_get_planet_name@8")
get_tid_acc.SWE_get_tid_acc= GetFunction(1,"_swe_get_tid_acc@0")
houses_pos.SWE_houses_pos= GetFunction(1,"_swe_houses_pos@36")
houses.SWE_houses= GetFunction(1,"_swe_houses@36") 
houses_armc.SWE_houses_armc= GetFunction(1,"_swe_houses_armc@36")
houses_ex.SWE_houses_ex= GetFunction(1,"_swe_houses_ex@40") 
JulDay.SWE_JulDay = GetFunction(1,"_swe_julday@24")
lun_eclipse_how.SWE_lun_eclipse_how= GetFunction(1,"_swe_lun_eclipse_how@24") 
lun_eclipse_when.SWE_lun_eclipse_when= GetFunction(1,"_swe_lun_eclipse_when@28")
;SWE_lun_occult_when_glob@36
;SWE_lun_occult_when_loc@40
;SWE_lun_occult_where@32 
nod_aps.SWE_nod_aps= GetFunction(1,"_swe_nod_aps@40")
nod_aps_ut.SWE_nod_aps_ut= GetFunction(1,"_swe_nod_aps@40") 
pheno.SWE_pheno= GetFunction(1,"_swe_pheno@24") 
pheno_ut.SWE_pheno_ut= GetFunction(1,"_swe_pheno_ut@24")
;SWE_rad_midp@16
;SWE_rad_norm@8
refrac.SWE_refrac= GetFunction(1,"_swe_refrac@28") 
RevJul.SWE_RevJul = GetFunction(1,"_swe_revjul@28")
rise_trans.SWE_rise_trans= GetFunction(1,"_swe_rise_trans@52")
set_ephe_path.SWE_set_ephe_path= GetFunction(1,"_swe_set_ephe_path@4")
set_jpl_file.SWE_set_jpl_file= GetFunction(1,"_swe_set_jpl_file@4")
set_sid_mode.SWE_set_sid_mode= GetFunction(1,"_swe_set_sid_mode@20")
set_topo.SWE_set_topo= GetFunction(1,"_swe_set_topo@24")
set_tid_acc.SWE_set_tid_acc= GetFunction(1,"_swe_set_tid_acc@8")
sidtime0.SWE_sidtime0= GetFunction(1,"_swe_sidtime0@24")
sidtime.SWE_sidtime= GetFunction(1,"_swe_sidtime@8")
sol_eclipse_how.SWE_sol_eclipse_how= GetFunction(1,"_swe_sol_eclipse_how@24") 
sol_eclipse_when_glob.SWE_sol_eclipse_when_glob= GetFunction(1,"_swe_sol_eclipse_when_glob@28") 
sol_eclipse_when_loc.SWE_sol_eclipse_when_loc= GetFunction(1,"_swe_sol_eclipse_when_loc@32") 
sol_eclipse_where.SWE_sol_eclipse_where= GetFunction(1,"_swe_sol_eclipse_where@24")
;SWE_split_deg@32
time_equ.SWE_time_equ= GetFunction(1,"_swe_time_equ@16")
;###################################################################################
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

ton programme fonctionne avec le mode import swedll32.LIB
il faut prendre les librairie du 29/11/2007 car j'en une swedll32.LIB de 2005 et ton code fonctionne pas avec celle ci
tu as remarquer que le code mis sur le site fonctionne avec swedll32.dll
je n'ai pas essayer avec la swedll.lib
le code test fonctionne sur mon pc ensuite j'ai effectuer copier coller sur le site

sinon tu peut faire fonctionner le code sans les combobox
tu vas a la ligne 320 envron un simple " ; " et la il devrait fonctionner comme le tient !

Code : Tout sélectionner

;################################################################
debut:
saisie()    ; tu annule l'appelle " saisie()"   et voila

Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

suite ...
je viens de tester avec la swedll32.LIB ca fonctionne aussi
j'ai simplement ajouter la commande path
voila le code pour que tu le remplace essaye en mode import lib
et te suffit de mettre l'aure partie du code en ; et le tour est jouer

Code : Tout sélectionner

;################### 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. ???? 
 set_ephe_path(path.s) As "_swe_set_ephe_path@4"
 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 
;################################################################
Anonyme

Message par Anonyme »

Date_conversion.l(
annee.l, 4
mois.l, 4
jour.l, 4
heure.d, 8
cal.b, 1
tjd.d 8
) As "_swe_date_conversion@28"
y a un problème dans les paramètres , ca devrais être @29 au lieu de 28.
j'ai pas tout vérifier.
Good07
Messages : 308
Inscription : ven. 23/avr./2004 18:08
Localisation : Hérault 34190 Laroque

Message par Good07 »

En fait ce que j'essaye de t'expliquer c'est que tout ou presque fonctionne. Ce n'est pas une question d'interface ou autre. Le problème ce situe au niveau des asteroides simplement. Voila ce que j'obtiens en utilisant les données affichées sur la boite de dialogue de départ et en validant simplement par "Confirmer".
ASTEROIDES
Achilles 68,335
Adonis 0,0000
Amor 0,0000
Apollo 0,0000
Asclepius 0,0000
Damocles 0,0000
Dejaminas 84,215
Dionysos 0,0000
ETC...
Ce qui me gène c'est que la position de certains astéroides soit à zéro. Pour le reste je n'ai pas de problèmes.
Est-ce que pour toi c'est pareil ?

A+

André.
Anonyme

Message par Anonyme »

Fait une archive si tu veut que je teste , j'ai la flemme de cherché le bon code.
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

dit moi comment on procede pour que je te la transmette
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

reponse pour good07
je suis desoler je comprend pas comment cela ce fait mais chez moi la dll ou la lib fonctionne avec le code j'obtient la position des planetes maisons sous tous les modes de calculs et les 32 asteroides et 8 uranians fict ????
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Message par kernadec »

bonjour cpl.bator
dans les appelle de la dll il n'y a que de des nombre pair
ou tu as vu @29 si tu met @29 et que ca marche les donnees seront erronees
d'ailleur si tu utlise le prg pour visialiser les fonction de la dll tu veras qu'il ny a pas de @29 si c'est dans la lib c'est elle qui a ete recompilee avec une erreur
merci
Répondre