PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Problem mit Dll

https://www.purebasic.fr/german/viewtopic.php?t=23744

Seite 1 von 2

Problem mit Dll

Verfasst: 16.01.2011 22:07
von -ALEX-
Hallo!
Habe schwierigkeiten mit swedll32.dll. So wie ich sehe wird ans Dll Array übergeben und dann von Dll gefüllt, Rückgabewert der Dll zeigt lediglich ob alles gut gelaufen ist. Hier ist Dll Beschreibung: http://www.astro.com/swisseph/swephprg.htm
In meinen Code kriege ich aber Syntax Fehler.

Code: Alles auswählen

a.d = 2455572.0;JulianischeDatum(9,1,2011,12,0,0)
planet.i=4
flag.l=4
Global Dim xxx.d(6)
serr${255} = ""
Prototype.d Protoswe_calc_ut(a.d,planet.i,flag.l,Array aassdd(6),serr$)
If OpenLibrary(0, "swedll32.dll")
    aaa.Protoswe_calc_ut = GetFunction(0, "_swe_calc_ut@24")
    aaa(a,planet,flag, Array xxx(0) ,serr$)
    CloseLibrary(0)
EndIf
MessageRequester("ASTRO","-1-" + StrD(xxx(1)) + "-2-" + StrD(xxx(2)) + "-3-" + StrD(xxx(3)) + "-4-" + StrD(xxx(4)) + "-5-" + StrD(xxx(5)) + "-6-" + StrD(xxx(6)))
End
Was mache ich falsch???

Re: Problem mit Dll

Verfasst: 16.01.2011 22:28
von DrShrek
wie wärs mit Array xxx(1) als Parameter also:

Code: Alles auswählen

...
Prototype.d Protoswe_calc_ut(a.d,planet.i,flag.l,Array aassdd(1),serr$)
..
    aaa(a,planet,flag, Array xxx(1) ,serr$)
...

Re: Problem mit Dll

Verfasst: 16.01.2011 22:35
von ts-soft
Ich bekomme nur zwei Werte zurück:

Code: Alles auswählen

a.d = 2455572.0;JulianischeDatum(9,1,2011,12,0,0)
planet.i=4
flag.l=4
Global Dim xxx.d(6)
serr${255} = ""
Prototype.d Protoswe_calc_ut(a.d,planet.i,flag.l,aassdd,serr$)
If OpenLibrary(0, "swedll32.dll")
    aaa.Protoswe_calc_ut = GetFunction(0, "_swe_calc_ut@24")
    aaa(a,planet,flag, @xxx(0) ,serr$)
    CloseLibrary(0)
EndIf
MessageRequester("ASTRO","-1-" + StrD(xxx(1)) + "-2-" + StrD(xxx(2)) + "-3-" + StrD(xxx(3)) + "-4-" + StrD(xxx(4)) + "-5-" + StrD(xxx(5)) + "-6-" + StrD(xxx(6)))
End
Kann und will aber nicht beurteilen ob das richtig ist :mrgreen:

Re: Problem mit Dll

Verfasst: 16.01.2011 22:44
von -ALEX-
ts-soft
Danke! Hab @ vergessen.
:praise:

Re: Problem mit Dll

Verfasst: 18.04.2015 18:02
von GerhardHoeberth
Hallo
ich will auch mit der DLL "swedll32.dll" arbeiten und habe daher im Forum gesucht, ob jamand anderer diese DLL schon mit PB verwendet hat.
Deshalb bin ich auf diesen Thread gestoßen.
Ich habe den Code kopiert und ausprobiert, aber es hat mir bei den 6 Werten immer "0" rausgeschrieben.
Also habe ich den MessageRequester IN die IF-Schleife hineinkopiert und siehe da, kein Fenster öffnet sich.
Also scheint das

Code: Alles auswählen

If  OpenLibrary(0, "swedll32.dll")
"False" zurückzugeben :-(
Die DLL liegt aber im selben Verzeichnis wie die Test.pb, mit der ich das ausprobiert habe.

Wieso öffnet es mir die DLL nicht?

Code: Alles auswählen

a.d = 2455572.0;JulianischeDatum(9,1,2011,12,0,0)
planet.i=1
flag.l=4
Global Dim xxx.d(6)
serr${255} = ""
Prototype.d Protoswe_calc_ut(a.d,planet.i,flag.l,aassdd,serr$)
If  OpenLibrary(0, "swedll32.dll")
    aaa.Protoswe_calc_ut = GetFunction(0, "_swe_calc_ut@24")
    aaa(a, planet, flag, @xxx(0), serr$)
    CloseLibrary(0)
    MessageRequester("ASTRO","-1-" + StrD(xxx(1)) + "-2-" + StrD(xxx(2)) + "-3-" + StrD(xxx(3)) + "-4-" + StrD(xxx(4)) + "-5-" + StrD(xxx(5)) + "-6-" + StrD(xxx(6)))
EndIf
End
herzlichen Gruß
Gerhard

Re: Problem mit Dll

Verfasst: 18.04.2015 18:17
von ts-soft
@GerhardHoeberth

Entweder ist die DLL 32-Bit und das Programm 64-Bit oder umgekehrt. DAS KANN NICHT GEHEN!

Ansonsten anderes Verzeichnis für die DLL ausprobieren, z.B. "...\PureBasic\Compilers\" im Debugmodus oder "...\System32\".

PS: zum Testen bitte:

Code: Alles auswählen

dll = OpenLibrary(...
Debug dll
If dll
Gruß
Thomas

Re: Problem mit Dll

Verfasst: 18.04.2015 18:22
von GerhardHoeberth
ts-soft hat geschrieben:Entweder ist die DLL 32-Bit und das Programm 64-Bit oder umgekehrt. DAS KANN NICHT GEHEN!
Ja, das sieht so aus. Mein PB ist 64. Die DLL wohl 32 ... :cry:

Dann werde ich mich mal auf die Suche machen, ob es die Swissephe auch für 64 gibt.

Danke erstmal für diese Info!
:allright:

Re: Problem mit Dll

Verfasst: 18.04.2015 19:15
von Andreas21
Z.b.:

http://www.astro.com/ftp/swisseph/contrib/

Version vom 19-Nov-2014 10:52 größe 1.2M
http://www.astro.com/ftp/swisseph/contrib/swedll64.dll

Re: Problem mit Dll

Verfasst: 18.04.2015 21:51
von glomph
Hallo,
irgendwann hab ich mal dies hier (wars im englischen Forum?) gefunden:
Wohl für 32 Bit.
Nur den Dialog leicht geändert, weil die Comoboxen ziemlich wirr waren:

Code: Alles auswählen

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

; Diese  Zeile weiter unten anpassen:If OpenLibrary(1,"C:\tnp_pur\swedll32.dll")

; Swiss Ephemeris - swedll32.LIB
;
; Interface pour Purebasic 4.0.x
;
; ftp://ftp.astro.com/pub/sweph/
; http://www.astro.com/swisseph/swephprg.htm
;
; ;##############################################
Declare sgn(vo.d)
Declare.d dms(x.d)
Declare donnees()
Declare saisie()
Global StartTime 
Global jour
Global mois
Global annee
Global minut.d
Global heure.d
Global latitude
Global latminute
Global longitude
Global longminute
Global lat.d
Global lon.d
Global glat.d
Global glon.d
Global heuregmt.d
Global NS$
Global EO$

#SEFLG_JPLEPH=1
#SEFLG_SWIEPH=2
#SEFLG_MOSEPH=4
#SEFLG_SPEED=256
#SEFLG_HELCTR=8
#SEFLG_TRUEPOS=16
#SEFLG_J2000=32
#SEFLG_NONUT=64
#SEFLG_NOGDEFL=512
#SEFLG_NOABERR=1024
#SEFLG_EQUATORIAL=2048
#SEFLG_XYZ=4096
#SEFLG_RADIANS=8192
#SEFLG_BARYCTR=16384
#SEFLG_TOPOCTR=32768
#SEFLG_SIDERAL=65536
#SEFLG_HELCTR=8
#SEFLG_TRUEPOS=16
#SE_CALC_RISE=1
#SE_CALC_SET=2
#SE_CALC_MTRANSIT=4
#SE_CALC_ITRANSIT=8
#SE_ECL_NUT=-1
 

Dim x.d(6); déclaration du tableau x
Dim x2.d(6)
Dim cusp.d(13)
Dim ascmc.d(10)
Dim attr.d(20)
Dim tret.d(20)
Dim geopos.d(10)
Dim geoposx.d(10)
Dim xnasc.d(6)
Dim xndsc.d(6)
Dim xperi.d(6)
Dim xaphe.d(6)
Dim Position.d(50)
Dim NomPlanete.s(50)
Dim serr.s(255,0)
hcusps.d=0
pName.s=Space(256)

Enumeration 0 Step 1
  #SE_GREG_CAL
  #SE_JUL_CAL
  #ID
EndEnumeration

#SE_ECL_NUT=	-1      
#SE_SUN  =	0
#SE_MOON 	=1
#SE_MERCURY  =    	2
#SE_VENUS=	3
#SE_MARS= 	4
#SE_JUPITER =5
#SE_SATURN=	6
#SE_URANUS=	7
#SE_NEPTUNE=8
#SE_PLUTO=	9
#SE_MEAN_NODE  =  	10      
#SE_TRUE_NODE   = 	11
#SE_MEAN_APOG  =  	12      
#SE_OSCU_APOG  =  	13    
#SE_EARTH=	14 
#SE_CHIRON=	15 
#SE_PHOLUS=	16 
#SE_CERES=	17 
#SE_PALLAS=	18 
#SE_JUNO= 	19
#SE_VESTA=	20
#SE_INTP_APOG=	21
#SE_INTP_PERG=	22

#SE_NPLANETS=	23
#SE_FICT_OFFSET = 	40
#SE_NFICT_ELEM=   	15

;/* Hamburger Or Uranian "planets" */

#SE_CUPIDO=	40
#SE_HADES=	41
#SE_ZEUS= 	42
#SE_KRONOS=	43
#SE_APOLLON  =44
#SE_ADMETOS  =45
#SE_VULKANUS =46
#SE_POSEIDON   =47
;
;/* other fictitious bodies */
;
#SE_ISIS= 	48
#SE_NIBIRU=	49
#SE_HARRINGTON  =50
#SE_NEPTUNE_LEVERRIER =51
#SE_NEPTUNE_ADAMS =52
#SE_PLUTO_LOWELL =53
#SE_PLUTO_PICKERIN=54

#SE_AST_OFFSET=10000
Enumeration

  #SPR_Terre=0
  #SPR_OmbreTerre=1
  #SPR_Lune=2
  #SPR_OmbreLune=3
EndEnumeration
 Global Dim nomplanete$(50)
 Restore planetes
For n=0 To 22
  Read.S NomPlanete$(n)
Next n
;##############################################
Prototype.d SWE_JulDay(annee,mois,jour,heure.d,flag)
Prototype.i SWE_RevJul(juliandate.d,flag,*annee,*mois,*jour,*heure)
Prototype.i SWE_Day_Of_Week(juliandate.d)
Prototype.d SWE_DegNorm(Angle.d)
Prototype.d SWE_date_conversion(annee,mois,jour,heure.d,cal.b,tjd.d)
Prototype.i SWE_Calc_ut(tjd.d,ipl,Iflag,*x,serr.s)
Prototype.i SWE_get_planet_name(ipl,pName.s)
Prototype.d SWE_deltat(tjd.d)
Prototype.i SWE_pheno(tjd.d,ipl,Iflag,*attr,serr.s)
Prototype.i SWE_rise_trans(tjd.d,ipl,starname.s,epheflag,rsmi,*geopos,atpress.d,attemp.d,*tret,serr.s)
Prototype.i SWE_houses_ex(tjd.d,Iflag,geolat.d,geolon.d,ihsy,*cusp,*ascmc)
Prototype.d SWE_sidtime(tjd.d)
Prototype.i SWE_houses_armc(armc.d,geolat.d,eps.d,ihsy,*cusp,*ascmc)
;##############################################
;################### premier mode ###########
If OpenLibrary(1,"C:\tnp_pur\swedll32.dll")
   JulDay.SWE_JulDay = GetFunction(1,"_swe_julday@24")
   RevJul.SWE_RevJul = GetFunction(1,"_swe_revjul@28")
   Day_Of_Week.SWE_Day_Of_Week = GetFunction(1,"_swe_day_of_week@8")
   DegNorm.SWE_DegNorm = GetFunction(1,"_swe_degnorm@8")
   Date_conversion.SWE_date_conversion = GetFunction(1,"_swe_date_conversion@28")
   Calc_ut.SWE_Calc_ut= GetFunction(1,"_swe_calc_ut@24") 
   get_planet_name.SWE_get_planet_name= GetFunction(1,"_swe_get_planet_name@8")
   deltat.SWE_deltat= GetFunction(1,"_swe_deltat@8")
   pheno.SWE_pheno= GetFunction(1,"_swe_pheno@24")
   rise_trans.SWE_rise_trans= GetFunction(1,"_swe_rise_trans@52")
   houses_ex.SWE_houses_ex= GetFunction(1,"_swe_houses_ex@40")
   sidtime.SWE_sidtime= GetFunction(1,"_swe_sidtime@8")
   houses_armc.SWE_houses_armc= GetFunction(1,"_swe_houses_armc@36")
  Else
  MessageRequester("Error!","Can't open library!",#MB_ICONERROR)
  End
EndIf


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=Year(Date())
jour=Day(Date())
mois=Month(Date())
heure.d=Hour(Date())
minut.d=Minute(Date())

saisie()
Debug ElapsedMilliseconds()
 StartTime = ElapsedMilliseconds()    
heure.d=heuregmt.d
geopos(0)=glon
geopos(1)=glat
geopos(2)=0
;
Iflag=#SEFLG_SWIEPH +#SEFLG_SPEED
 
tjd_ut.d=JulDay(annee,mois,jour,heure,#SE_JUL_CAL)
For nplanete=#SE_SUN To    #SE_VESTA;#SE_PLUTO
  Calc_ut(tjd_ut,nplanete,Iflag,@x.d(0),serr.s); par contre là il faut mettre le tableau ????
   Position(nplanete)=x(0)
 Debug position(nplanete)  
 Next nplanete

Debug "zeit"
Debug ElapsedMilliseconds()
;starttime=   (ElapsedMilliseconds()-startime)/1000    

If ((Position(1)<Position(0) And Position(0)-Position(1)<180) Or (Position(1)>Position(0) And Position(1)-Position(0)>180))
  Elong.s=" Ouest"
Else
  Elong.s= " Est"
EndIf
tsid.d=sidtime(tjd_ut)
ecart.d=deltat(tjd_ut)
ecart.d=ecart.d*86400
tsid.d=tsid+glon/15
armc.d=tsid*15
pheno(tjd_ut,#SE_MOON,#SEFLG_HELCTR,@attr.d(0),serr.s)
Debug "Angle de Phase "+ StrD(attr(0),2)
Debug "Phase "+StrD(attr(1),2)
Debug "Elongation "+StrD(attr(2),2)+Elong
Debug "Diamètre Apparent "+StrD(attr(3),2)
Debug "Magnitude apparente "+StrD(attr(4),2)
rise_trans(tjd_ut,#SE_SUN,"",#SEFLG_SWIEPH,#SE_CALC_RISE,@geopos.d(0),1013,15,@tret.d(0),serr.s)
RevJul(tret(0), #SE_JUL_CAL,@annee,@mois,@jour,@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,@mois,@jour,@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,@mois,@jour,@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,@mois,@jour,@heure.d)
Debug "coucher de la lune "+myDEBUG(annee,mois,jour,DeciMinut(heure))
Calc_ut(tjd_ut,#SE_ECL_NUT,0,@x.d(0),serr.s)
eps_true.d= x(0)
houses_armc(armc.d,glat.d,eps_true.d,Asc("P"),@cusp.d(0),@ascmc.d(0))
;##############################################
If OpenWindow(#ID, 300, 50, 600, 1000, "Astrologie", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget) = 0 
;Or CreateGadgetList(WindowID(#ID)) = 0
  End
EndIf
StartDrawing(WindowOutput(#ID))
DrawingMode(1)
For n=0 To 48
FrontColor($E16941)
;If n<20 Or n >39
  DrawText(10,50+pas,NomPlanete$(n))
  DrawText(85,50+pas,RSet(StrD(dms(Position(n)),4),6," "))
  pas+19
;  EndIf
Next n
pas=0
For n=1 To 12
  DrawText(200,50+pas,"Häuser "+Str(n)+"  "+StrD(cusp.d(n),2))
  pas+20
Next n
DrawText(200,10,"Placidus")
DrawText(370,10,"jultag "+StrD(tjd_ut))
DrawText(20,20,"Date: "+GetGadgetText(2)+"/"+GetGadgetText(3)+"/"+GetGadgetText(4))
StopDrawing()
;##############################################
Debug "  "
jd1.d = JulDay(1988,1, 1,12.23,#SE_JUL_CAL)
Debug jd1
RevJul( jd1, #SE_JUL_CAL, @annee, @mois, @jour, @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, @mois, @jour, @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)
;##############################################
Debug "Zeit"
Debug ElapsedMilliseconds()    
done = #False
Repeat
  event = WaitWindowEvent()
  Select event
    Case #PB_Event_CloseWindow
      done = #True
    Case #PB_Event_MoveWindow
    Case #PB_Event_SizeWindow
    Default
  EndSelect
Until done = #True
CloseWindow(#ID)

DataSection
planetes:
Data.s "Soleil","Lune","Mercure","Venus","Mars","Jupiter","Saturne","Uranus","Neptune","Pluton","Meanod","truenode","Meanapog","Ostuapog","Earth","Chiron","Pholus","Ceres","Pallas","Juno","Vesta","Intpapog","Intperge"
EndDataSection

Procedure.d dms(x.d)
  x = SGN(x) * (Int(Abs(x)) + Int((Abs(x + 0.008333) - Int(Abs(x))) * 60) / 100)
  ProcedureReturn x
EndProcedure
Procedure sgn(vo.d)
  If vo=>0
    vo=1
  EndIf
  If vo<0
    vo=-1
  EndIf
  ProcedureReturn vo.d
EndProcedure
Procedure saisie()
;;######################## defaut ############################
nom$="b"
lieu$="w"
jour=28
mois=6
annee=1948
heure.d=7
minut.d=21
latitude=53
Latminute=29
longitude=8
longminute=27
NS$="N"             
EO$="O"
;############################################################
OpenWindow(1,20,150,500,500,"dialogue par (Kernadec)",#PB_Window_SystemMenu)
;CreateGadgetList(WindowID(1))
;######################## NOM ################################
StringGadget(0, 50, 40, 300, 20, nom$)
StringGadget(1, 50, 90, 300, 20, lieu$)
;#############################################################
;########### reste a traite les années bisextile #############
;########### sinon prendre une boite calendier   #############
;######################### DATE ##############################
ComboBoxGadget(2,10,140,50,20,#PB_ComboBox_Editable)
;StringGadget(2,10,140,37,20"");40,#PB_ComboBox_Editable)

For x = 1 To 31
  AddGadgetItem(2,-1,Str(x))     ;Jour
Next
SetGadgetState(2,jour-1)
ComboBoxGadget(3,60,140,50,20,#PB_ComboBox_Editable)
;StringGadget(3,50,140,37,20,#PB_ComboBox_Editable)
For x = 1 To 12
  AddGadgetItem(3,-1,Str(x))     ;mois
Next
SetGadgetState(3,mois-1)
ComboBoxGadget(4,120,140,70,20,#PB_ComboBox_Editable)
For x = 1 To 2300           
  AddGadgetItem(4,-1,Str(x))    ;année
Next
SetGadgetState(4, Abs(annee-1))
;########################## HEURE ############################
ComboBoxGadget(5,210,140,50,20,#PB_ComboBox_Editable)
For x = 0 To 23
  AddGadgetItem(5,-1,Str(x))     ;heure
Next
SetGadgetState(5,Abs(heure-1))
ComboBoxGadget(6,270,140,50,20,#PB_ComboBox_Editable)
For x = 0 To 59
  AddGadgetItem(6,-1,Str(x))     ;minute
Next
SetGadgetState(6,Abs(minut-1))
;######################## LATITUDE ###########################
ComboBoxGadget(7,3,180,70,20, #PB_ComboBox_Editable)
For x = 0 To 89
  AddGadgetItem(7,-1,Str(x))     ;latitude degrés
Next
SetGadgetState(7,Abs(latitude-1))
ComboBoxGadget(8,80,180,50,20,#PB_ComboBox_Editable)
For x = 0 To 59
  AddGadgetItem(8,-1,Str(x))     ;latitude minutes
Next
SetGadgetState(8,Abs(latminute-1))
;######################## radio boutons ######################
FrameGadget(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,140,180,70,20,#PB_ComboBox_Editable)
For x = 0 To 179
  AddGadgetItem(12,-1,Str(x))     ;longitude degrés
Next
SetGadgetState(12,Abs(longitude-1))
ComboBoxGadget(13,220,180,50,20,#PB_ComboBox_Editable)
;StringGadget(13,212,180,37,20,"")
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
;#############################################################
FrameGadget(16, 147, 165, 115, 58, "Longitude en degrés")
OptionGadget(14, 156, 203, 45, 17, "&Est")                 
OptionGadget(15, 204, 203, 45, 17, "&Ouest")
SetGadgetState(14, 1)
;#############################################################
;######################## boutons ############################
ButtonGadget(17, 10, 230, 110, 25, "&Annuler")
ButtonGadget(18, 147, 230, 115, 25, "&Confirmer")
;######################## titres #############################
TextGadget(19, 10, 40, 60, 20, "Nom:")
TextGadget(20, 10, 90, 60, 20, "Lieu:")
TextGadget(21, 15, 125, 120, 20, "Jour      Mois       Année")
TextGadget(22, 185, 125, 120, 20, "Heures  Minutes")
TextGadget(23, 155, 143, 30, 20, "GMT:")
;#####################cmd Clavier ############################
AddKeyboardShortcut(1,#PB_Shortcut_Return,18)
AddKeyboardShortcut(1,#PB_Shortcut_C,18)
AddKeyboardShortcut (1,#PB_Shortcut_N,10)
AddKeyboardShortcut(1,#PB_Shortcut_S,11)
AddKeyboardShortcut(1,#PB_Shortcut_E,14)
AddKeyboardShortcut(1,#PB_Shortcut_O,15)
;#############################################################
;#############################################################
  Repeat
    event=WaitWindowEvent()
  If Event = #PB_Event_Gadget Or Event = #PB_Event_Menu
        Select EventGadget()
        Case 10
         SetGadgetState(10, 1)
        Case 11
         SetGadgetState(11, 1)
        Case 14
         SetGadgetState(14, 1)
        Case 15
         SetGadgetState(15, 1)
        Case 17
         If IsWindow(2)
          CloseWindow(2)
         EndIf
        Case 18
         donnees()
         Break
         OpenWindow(2,400,150,350,270,"resultats",#PB_Window_SystemMenu)
         ;#####################cmd Clavier ############################
         AddKeyboardShortcut(2,#PB_Shortcut_Escape,17)
         AddKeyboardShortcut(2,#PB_Shortcut_A,17)
         ;######################## Affiche ############################
         StartDrawing(WindowOutput(2))
         DrawingMode(1)
         DrawText(2,20,"Nom: "+GetGadgetText(0))
         DrawText(2,50,"Lieu: "+GetGadgetText(1))
         DrawText(2,80,"Date: "+GetGadgetText(2)+"/"+GetGadgetText(3)+"/"+GetGadgetText(4))
         DrawText(2,110,"heure: "+GetGadgetText(5)+"h"+GetGadgetText(6)+"'  ")
         DrawText(2,140,"Latitude: "+GetGadgetText(7)+"°"+GetGadgetText(8)+"'  "+NS$)
         DrawText(2,170,"Longitude: "+GetGadgetText(12)+"°"+GetGadgetText(13)+"'  "+EO$)
         DrawText(2,200,"convers heure : "+StrD(heuregmt,4))
         DrawText(2,230,"convers lat: "+StrD(glat.d,4)+" <->  convers long: "+StrD(glon.d,4))
         StopDrawing()
        Case #PB_Event_CloseWindow
         CloseWindow(1) 
       EndSelect
      EndIf
  Until   Event = #PB_Event_CloseWindow
;######################################################################
EndProcedure

Procedure donnees()
         ; ermittelt den aktuellen Wert
                                     ; wartet 1000 Millisekunden
  
;############### Traitement des données ######################
nom$=GetGadgetText(0)
lieu$=GetGadgetText(1)
jour=ValD(GetGadgetText(2))
mois=ValD(GetGadgetText(3))
annee=ValD(GetGadgetText(4))
heure.d=ValD(GetGadgetText(5))
minut.d=ValD(GetGadgetText(6))
latitude=ValD(GetGadgetText(7))
latminute=ValD(GetGadgetText(8))
longitude=ValD(GetGadgetText(12))
longminute=ValD(GetGadgetText(13))
nom$="b"
lieu$="w"
jour=28
mois=6
annee=1948
heure.d=7
minut.d=21
latitude=53
Latminute=29
longitude=8
longminute=27
NS$="N"             
EO$="O"
lat=latitude+(latminute/100)
lon=longitude+(longminute/100)
Debug jour
Debug mois
Debug annee
Debug heure.d
Debug minut.d
If GetGadgetState(10)
NS$="N"
Else
NS$="S"
lat=0-lat
EndIf;
If GetGadgetState(14)
EO$="E"
Else
EO$="O"
lon=0-lon
EndIf
Debug "länge breite"
Debug lon
Debug lat

heuregmt=heure+minut/60+seconde/3600
Debug heuregmt
glon.d=Int(lon)+((lon-Int(lon))*100)/60
glat.d=Int(lat)+((lat-Int(lat))*100)/60
Debug glon.d
Debug glat.d
EndProcedure
Code rechnet richtig in 5.24 LTS 32 bit
Lg
glomph

Re: Problem mit Dll

Verfasst: 21.04.2015 11:32
von andi256
Hallo,

Danke für den Thread! Ist eine nette Library.

Sowas hab ich schon länger gesucht !

Hab mich ein wenig gespielt damit ......

@TS-soft
Ich bekomme nur zwei Werte zurück:
...
Kann und will aber nicht beurteilen ob das richtig ist
wenn man
StrD(xxx(0))
StrD(xxx(1))
StrD(xxx(2))
auswertet bekommt man 3 Werte :D

Ekliptische Länge
Breite
Entfernung in AE

wenn man das Flag #SEFLG_SPEED noch setzt erhält man aus dem 4 Parameter xxx(3) auch noch die Geschwindigkeit.

die hab ich mit http://www.cybervisuals.ch/moon/moon.html verglichen und passen soweit

Andi
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de